mdw@git.distorted.org.uk Git - profile/blob - dot-emacs.el

   1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
   2 ;;;
   3 ;;; $Id$
   4 ;;;
   5 ;;; Functions and macros for .emacs
   6 ;;;
   7 ;;; (c) 2004 Mark Wooding
   8 ;;;
   9
  10 ;;;----- Licensing notice ---------------------------------------------------
  11 ;;;
  12 ;;; This program is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; This program is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with this program; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 ;;;----- Check command-line -------------------------------------------------
  27
  28 (defvar mdw-fast-startup nil
  29   "Whether .emacs should optimize for rapid startup.
  30 This may be at the expense of cool features.")
  31 (let ((probe nil) (next command-line-args))
  32   (while next
  33     (cond ((string= (car next) "--mdw-fast-startup")
  34            (setq mdw-fast-startup t)
  35            (if probe
  36                (rplacd probe (cdr next))
  37              (setq command-line-args (cdr next))))
  38           (t
  39            (setq probe next)))
  40     (setq next (cdr next))))
  41
  42 ;;;----- Some general utilities ---------------------------------------------
  43
  44 (eval-when-compile
  45   (unless (fboundp 'make-regexp)
  46     (load "make-regexp"))
  47   (require 'cl))
  48
  49 (defmacro mdw-regexps (&rest list)
  50   "Turn a LIST of strings into a single regular expression at compile-time."
  51   `',(make-regexp list))
  52
  53 ;; --- Some error trapping ---
  54 ;;
  55 ;; If individual bits of this file go tits-up, we don't particularly want
  56 ;; the whole lot to stop right there and then, because it's bloody annoying.
  57
  58 (defmacro trap (&rest forms)
  59   "Execute FORMS without allowing errors to propagate outside."
  60   `(condition-case err
  61        ,(if (cdr forms) (cons 'progn forms) (car forms))
  62      (error (message "Error (trapped): %s in %s"
  63                      (error-message-string err)
  64                      ',forms))))
  65
  66 ;; --- Configuration reading ---
  67
  68 (defvar mdw-config nil)
  69 (defun mdw-config (sym)
  70   "Read the configuration variable named SYM."
  71   (unless mdw-config
  72     (setq mdw-config
  73           (flet ((replace (what with)
  74                    (goto-char (point-min))
  75                    (while (re-search-forward what nil t)
  76                      (replace-match with t))))
  77             (with-temp-buffer
  78               (insert-file-contents "~/.mdw.conf")
  79               (replace  "^[ \t]*\\(#.*\\|\\)\n" "")
  80               (replace (concat "^[ \t]*"
  81                                "\\([-a-zA-Z0-9_.]*\\)"
  82                                "[ \t]*=[ \t]*"
  83                                "\\(.*[^ \t\n]\\|\\)"
  84                                "[ \t]**\\(\n\\|$\\)")
  85                        "(\\1 . \"\\2\")\n")
  86               (car (read-from-string
  87                     (concat "(" (buffer-string) ")")))))))
  88   (cdr (assq sym mdw-config)))
  89
  90 ;; --- Is an Emacs library available? ---
  91
  92 (defun library-exists-p (name)
  93   "Return non-nil if NAME.el (or NAME.elc) is somewhere on the Emacs load
  94 path.  The non-nil value is the filename we found for the library."
  95   (let ((path load-path) elt (foundp nil))
  96     (while (and path (not foundp))
  97       (setq elt (car path))
  98       (setq path (cdr path))
  99       (setq foundp (or (let ((file (concat elt "/" name ".elc")))
 100                          (and (file-exists-p file) file))
 101                        (let ((file (concat elt "/" name ".el")))
 102                          (and (file-exists-p file) file)))))
 103     foundp))
 104
 105 (defun maybe-autoload (symbol file &optional docstring interactivep type)
 106   "Set an autoload if the file actually exists."
 107   (and (library-exists-p file)
 108        (autoload symbol file docstring interactivep type)))
 109
 110 ;; --- Splitting windows ---
 111
 112 (unless (fboundp 'scroll-bar-columns)
 113   (defun scroll-bar-columns (side)
 114     (cond ((eq side 'left) 0)
 115           (window-system 3)
 116           (t 1))))
 117 (unless (fboundp 'fringe-columns)
 118   (defun fringe-columns (side)
 119     (cond ((not window-system) 0)
 120           ((eq side 'left) 1)
 121           (t 2))))
 122
 123 (defun mdw-divvy-window (&optional width)
 124   "Split a wide window into appropriate widths."
 125   (interactive "P")
 126   (setq width (cond (width (prefix-numeric-value width))
 127                     ((and window-system
 128                           (>= emacs-major-version 22))
 129                      77)
 130                     (t 78)))
 131   (let* ((win (selected-window))
 132          (sb-width (if (not window-system)
 133                        1
 134                      (let ((tot 0))
 135                        (dolist (what '(scroll-bar fringe))
 136                          (dolist (side '(left right))
 137                            (incf tot
 138                                  (funcall (intern (concat (symbol-name what)
 139                                                           "-columns"))
 140                                           side))))
 141                        tot)))
 142          (c (/ (+ (window-width) sb-width)
 143                (+ width sb-width))))
 144     (while (> c 1)
 145       (setq c (1- c))
 146       (split-window-horizontally (+ width sb-width))
 147       (other-window 1))
 148     (select-window win)))
 149
 150 ;; --- Functions for sexp diary entries ---
 151
 152 (defun mdw-weekday (l)
 153   "Return non-nil if `date' falls on one of the days of the week in L.
 154
 155 L is a list of day numbers (from 0 to 6 for Sunday through to Saturday) or
 156 symbols `sunday', `monday', etc. (or a mixture).  If the date stored in
 157 `date' falls on a listed day, then the function returns non-nil."
 158   (let ((d (calendar-day-of-week date)))
 159     (or (memq d l)
 160         (memq (nth d '(sunday monday tuesday wednesday
 161                               thursday friday saturday)) l))))
 162
 163 (defun mdw-todo (&optional when)
 164   "Return non-nil today, or on WHEN, whichever is later."
 165   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
 166         (d (calendar-absolute-from-gregorian date)))
 167     (if when
 168         (setq w (max w (calendar-absolute-from-gregorian
 169                         (cond
 170                          ((not european-calendar-style)
 171                           when)
 172                          ((> (car when) 100)
 173                           (list (nth 1 when)
 174                                 (nth 2 when)
 175                                 (nth 0 when)))
 176                          (t
 177                           (list (nth 1 when)
 178                                 (nth 0 when)
 179                                 (nth 2 when))))))))
 180     (eq w d)))
 181
 182 ;;;----- Utility functions --------------------------------------------------
 183
 184 (or (fboundp 'line-number-at-pos)
 185     (defun line-number-at-pos (&optional pos)
 186       (let ((opoint (or pos (point))) start)
 187         (save-excursion
 188           (save-restriction
 189             (goto-char (point-min))
 190             (widen)
 191             (forward-line 0)
 192             (setq start (point))
 193             (goto-char opoint)
 194             (forward-line 0)
 195             (1+ (count-lines 1 (point))))))))
 196
 197 ;; --- mdw-uniquify-alist ---
 198
 199 (defun mdw-uniquify-alist (&rest alists)
 200
 201   "Return the concatenation of the ALISTS with duplicate elements removed.
 202
 203 The first association with a given key prevails; others are ignored.  The
 204 input lists are not modified, although they'll probably become garbage."
 205
 206   (and alists
 207        (let ((start-list (cons nil nil)))
 208          (mdw-do-uniquify start-list
 209                           start-list
 210                           (car alists)
 211                           (cdr alists)))))
 212
 213 ;; --- mdw-do-uniquify ---
 214 ;;
 215 ;; The DONE argument is a list whose first element is `nil'.  It contains the
 216 ;; uniquified alist built so far.  The leading `nil' is stripped off at the
 217 ;; end of the operation; it's only there so that DONE always references a
 218 ;; cons cell.  END refers to the final cons cell in the DONE list; it is
 219 ;; modified in place each time to avoid the overheads of `append'ing all the
 220 ;; time.  The L argument is the alist we're currently processing; the
 221 ;; remaining alists are given in REST.
 222
 223 (defun mdw-do-uniquify (done end l rest)
 224   "A helper function for mdw-uniquify-alist."
 225
 226   ;; --- There are several different cases to deal with here ---
 227
 228   (cond
 229
 230    ;; --- Current list isn't empty ---
 231    ;;
 232    ;; Add the first item to the DONE list if there's not an item with the
 233    ;; same KEY already there.
 234
 235    (l (or (assoc (car (car l)) done)
 236           (progn
 237             (setcdr end (cons (car l) nil))
 238             (setq end (cdr end))))
 239       (mdw-do-uniquify done end (cdr l) rest))
 240
 241    ;; --- The list we were working on is empty ---
 242    ;;
 243    ;; Shunt the next list into the current list position and go round again.
 244
 245    (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
 246
 247    ;; --- Everything's done ---
 248    ;;
 249    ;; Remove the leading `nil' from the DONE list and return it.  Finished!
 250
 251    (t (cdr done))))
 252
 253 ;; --- Insert a date ---
 254
 255 (defun date ()
 256   "Insert the current date in a pleasing way."
 257   (interactive)
 258   (insert (save-excursion
 259             (let ((buffer (get-buffer-create "*tmp*")))
 260               (unwind-protect (progn (set-buffer buffer)
 261                                      (erase-buffer)
 262                                      (shell-command "date +%Y-%m-%d" t)
 263                                      (goto-char (mark))
 264                                      (delete-backward-char 1)
 265                                      (buffer-string))
 266                 (kill-buffer buffer))))))
 267
 268 ;; --- UUencoding ---
 269
 270 (defun uuencode (file &optional name)
 271   "UUencodes a file, maybe calling it NAME, into the current buffer."
 272   (interactive "fInput file name: ")
 273
 274   ;; --- If NAME isn't specified, then guess from the filename ---
 275
 276   (if (not name)
 277       (setq name
 278             (substring file
 279                        (or (string-match "[^/]*$" file) 0))))
 280
 281   (print (format "uuencode `%s' `%s'" file name))
 282
 283   ;; --- Now actually do the thing ---
 284
 285   (call-process "uuencode" file t nil name))
 286
 287 (defvar np-file "~/.np"
 288   "*Where the `now-playing' file is.")
 289
 290 (defun np (&optional arg)
 291   "Grabs a `now-playing' string."
 292   (interactive)
 293   (save-excursion
 294     (or arg (progn
 295               (goto-char (point-max))
 296               (insert "\nNP: ")
 297               (insert-file-contents np-file)))))
 298
 299 (defun mdw-check-autorevert ()
 300   "Sets global-auto-revert-ignore-buffer appropriately for this buffer,
 301 taking into consideration whether it's been found using tramp, which seems to
 302 get itself into a twist."
 303   (cond ((not (boundp 'global-auto-revert-ignore-buffer))
 304          nil)
 305         ((and (buffer-file-name)
 306               (fboundp 'tramp-tramp-file-p)
 307               (tramp-tramp-file-p (buffer-file-name)))
 308          (unless global-auto-revert-ignore-buffer
 309            (setq global-auto-revert-ignore-buffer 'tramp)))
 310         ((eq global-auto-revert-ignore-buffer 'tramp)
 311          (setq global-auto-revert-ignore-buffer nil))))
 312
 313 (defadvice find-file (after mdw-autorevert activate)
 314   (mdw-check-autorevert))
 315 (defadvice write-file (after mdw-autorevert activate)
 316   (mdw-check-autorevert))
 317
 318 (defun mdwmail-mode ()
 319   "Major mode for editing news and mail messages from external programs
 320 Not much right now.  Just support for doing MailCrypt stuff."
 321   (interactive)
 322   (kill-all-local-variables)
 323   (use-local-map text-mode-map)
 324   (setq local-abbrev-table text-mode-abbrev-table)
 325   (setq major-mode 'mdwmail-mode)
 326   (setq mode-name "[mdw] mail")
 327   (set-buffer-file-coding-system 'utf-8)
 328   (make-local-variable 'paragraph-separate)
 329   (make-local-variable 'paragraph-start)
 330   (setq paragraph-start (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 331                                 paragraph-start))
 332   (setq paragraph-separate (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 333                                    paragraph-separate))
 334   (run-hooks 'text-mode-hook 'mdwmail-mode-hook 'mail-setup-hook))
 335
 336 ;; --- How to encrypt in mdwmail ---
 337
 338 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
 339   (or start
 340       (setq start (save-excursion
 341                     (goto-char (point-min))
 342                     (or (search-forward "\n\n" nil t) (point-min)))))
 343   (or end
 344       (setq end (point-max)))
 345   (mc-encrypt-generic recip scm start end from sign))
 346
 347 ;; --- How to sign in mdwmail ---
 348
 349 (defun mdwmail-mc-sign (key scm start end uclr)
 350   (or start
 351       (setq start (save-excursion
 352                     (goto-char (point-min))
 353                     (or (search-forward "\n\n" nil t) (point-min)))))
 354   (or end
 355       (setq end (point-max)))
 356   (mc-sign-generic key scm start end uclr))
 357
 358 ;; --- Some signature mangling ---
 359
 360 (defun mdwmail-mangle-signature ()
 361   (save-excursion
 362     (goto-char (point-min))
 363     (perform-replace "\n-- \n" "\n-- " nil nil nil)))
 364 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
 365
 366 ;;;----- Dired hacking ------------------------------------------------------
 367
 368 (defadvice dired-maybe-insert-subdir
 369     (around mdw-marked-insertion first activate)
 370   "The DIRNAME may be a list of directory names to insert.  Interactively, if
 371 files are marked, then insert all of them.  With a numeric prefix argument,
 372 select that many entries near point; with a non-numeric prefix argument,
 373 prompt for listing options."
 374   (interactive
 375    (list (dired-get-marked-files nil
 376                                  (and (integerp current-prefix-arg)
 377                                       current-prefix-arg)
 378                                  #'file-directory-p)
 379          (and current-prefix-arg
 380               (not (integerp current-prefix-arg))
 381               (read-string "Switches for listing: "
 382                            (or dired-subdir-switches
 383                                dired-actual-switches)))))
 384   (let ((dirs (ad-get-arg 0)))
 385     (dolist (dir (if (listp dirs) dirs (list dirs)))
 386       (ad-set-arg 0 dir)
 387       ad-do-it)))
 388
 389 ;;;----- URL viewing --------------------------------------------------------
 390
 391 (defun mdw-w3m-browse-url (url &optional new-session-p)
 392   "Invoke w3m on the URL in its current window, or at least a different one.
 393 If NEW-SESSION-P, start a new session."
 394   (interactive "sURL: \nP")
 395   (save-excursion
 396     (let ((window (selected-window)))
 397       (unwind-protect
 398           (progn
 399             (select-window (or (and (not new-session-p)
 400                                     (get-buffer-window "*w3m*"))
 401                                (progn
 402                                  (if (one-window-p t) (split-window))
 403                                  (get-lru-window))))
 404             (w3m-browse-url url new-session-p))
 405         (select-window window)))))
 406
 407 (defvar mdw-good-url-browsers
 408   '((w3m . mdw-w3m-browse-url)
 409     browse-url-w3
 410     browse-url-mozilla)
 411   "List of good browsers for mdw-good-url-browsers; each item is a browser
 412 function name, or a cons (CHECK . FUNC).  A symbol FOO stands for (FOO
 413 . FOO).")
 414
 415 (defun mdw-good-url-browser ()
 416   "Return a good URL browser.  Trundle the list of such things, finding the
 417 first item for which CHECK is fboundp, and returning the correponding FUNC."
 418   (let ((bs mdw-good-url-browsers) b check func answer)
 419     (while (and bs (not answer))
 420       (setq b (car bs)
 421             bs (cdr bs))
 422       (if (consp b)
 423           (setq check (car b) func (cdr b))
 424         (setq check b func b))
 425       (if (fboundp check)
 426           (setq answer func)))
 427     answer))
 428
 429 ;;;----- Paragraph filling --------------------------------------------------
 430
 431 ;; --- Useful variables ---
 432
 433 (defvar mdw-fill-prefix nil
 434   "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.  If there's
 435 no fill prefix currently set (by the `fill-prefix' variable) and there's
 436 a match from one of the regexps here, it gets used to set the fill-prefix
 437 for the current operation.
 438
 439 The variable is a list of items of the form `REGEXP . PREFIX'; if the
 440 REGEXP matches, the PREFIX is used to set the fill prefix.  It in turn is
 441 a list of things:
 442
 443   STRING -- insert a literal string
 444   (match . N) -- insert the thing matched by bracketed subexpression N
 445   (pad . N) -- a string of whitespace the same width as subexpression N
 446   (expr . FORM) -- the result of evaluating FORM")
 447
 448 (make-variable-buffer-local 'mdw-fill-prefix)
 449
 450 (defvar mdw-hanging-indents
 451   "\\(\\(\\([*o]\\|--\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)[ \t]+\\)?\\)"
 452   "*Standard regular expression matching things which might be part of a
 453 hanging indent.  This is mainly useful in `auto-fill-mode'.")
 454
 455 ;; --- Setting things up ---
 456
 457 (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
 458
 459 ;; --- Utility functions ---
 460
 461 (defun mdw-tabify (s)
 462   "Tabify the string S.  This is a horrid hack."
 463   (save-excursion
 464     (save-match-data
 465       (let (start end)
 466         (beginning-of-line)
 467         (setq start (point-marker))
 468         (insert s "\n")
 469         (setq end (point-marker))
 470         (tabify start end)
 471         (setq s (buffer-substring start (1- end)))
 472         (delete-region start end)
 473         (set-marker start nil)
 474         (set-marker end nil)
 475         s))))
 476
 477 (defun mdw-examine-fill-prefixes (l)
 478   "Given a list of dynamic fill prefixes, pick one which matches context and
 479 return the static fill prefix to use.  Point must be at the start of a line,
 480 and match data must be saved."
 481   (cond ((not l) nil)
 482                ((looking-at (car (car l)))
 483                 (mdw-tabify (apply (function concat)
 484                                    (mapcar (function mdw-do-prefix-match)
 485                                            (cdr (car l))))))
 486                (t (mdw-examine-fill-prefixes (cdr l)))))
 487
 488 (defun mdw-maybe-car (p)
 489   "If P is a pair, return (car P), otherwise just return P."
 490   (if (consp p) (car p) p))
 491
 492 (defun mdw-padding (s)
 493   "Return a string the same width as S but made entirely from whitespace."
 494   (let* ((l (length s)) (i 0) (n (make-string l ? )))
 495     (while (< i l)
 496       (if (= 9 (aref s i))
 497           (aset n i 9))
 498       (setq i (1+ i)))
 499     n))
 500
 501 (defun mdw-do-prefix-match (m)
 502   "Expand a dynamic prefix match element.  See `mdw-fill-prefix' for
 503 details."
 504   (cond ((not (consp m)) (format "%s" m))
 505            ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
 506            ((eq (car m) 'pad) (mdw-padding (match-string
 507                                             (mdw-maybe-car (cdr m)))))
 508            ((eq (car m) 'eval) (eval (cdr m)))
 509            (t "")))
 510
 511 (defun mdw-choose-dynamic-fill-prefix ()
 512   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
 513   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
 514            ((not mdw-fill-prefix) fill-prefix)
 515            (t (save-excursion
 516                 (beginning-of-line)
 517                 (save-match-data
 518                   (mdw-examine-fill-prefixes mdw-fill-prefix))))))
 519
 520 (defun do-auto-fill ()
 521   "Handle auto-filling, working out a dynamic fill prefix in the case where
 522 there isn't a sensible static one."
 523   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 524     (mdw-do-auto-fill)))
 525
 526 (defun mdw-fill-paragraph ()
 527   "Fill paragraph, getting a dynamic fill prefix."
 528   (interactive)
 529   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 530     (fill-paragraph nil)))
 531
 532 (defun mdw-standard-fill-prefix (rx &optional mat)
 533   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
 534 This is just a short-cut for setting the thing by hand, and by design it
 535 doesn't cope with anything approximating a complicated case."
 536   (setq mdw-fill-prefix
 537            `((,(concat rx mdw-hanging-indents)
 538               (match . 1)
 539               (pad . ,(or mat 2))))))
 540
 541 ;;;----- Other common declarations ------------------------------------------
 542
 543 (defun mdw-set-frame-transparency (&optional n)
 544   (interactive "P")
 545   (let* ((alist (frame-parameters))
 546          (trans (assq 'transparency alist)))
 547     (if trans
 548         (rplacd trans (not (if n (zerop n) (cdr trans))))
 549       (setq trans (cons 'transparency (not (equal 0 n)))))
 550     (modify-frame-parameters (selected-frame) (list trans))))
 551
 552 ;; --- Mouse wheel support ---
 553
 554 (defconst mdw-wheel-scroll-amount 15)
 555 (defun mdw-wheel-up (click)
 556   (interactive "@e")
 557   (mdw-wheel-scroll click (function scroll-down)))
 558 (defun mdw-wheel-down (click)
 559   (interactive "@e")
 560   (mdw-wheel-scroll click (function scroll-up)))
 561
 562 (defun mdw-wheel-scroll (click func)
 563   (let ((win (selected-window)))
 564     (unwind-protect
 565         (progn
 566           (select-window (posn-window (event-start click)))
 567           (let ((arg 2))
 568             (funcall func (/ (window-height) 2))))
 569       (select-window win))))
 570
 571 ;; --- Going backwards ---
 572
 573 (defun other-window-backwards (arg)
 574   (interactive "p")
 575   (other-window (- arg)))
 576
 577 ;; --- Common mode settings ---
 578
 579 (defvar mdw-auto-indent t
 580   "Whether to indent automatically after a newline.")
 581
 582 (defun mdw-misc-mode-config ()
 583   (and mdw-auto-indent
 584        (cond ((eq major-mode 'lisp-mode)
 585               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
 586              ((or (eq major-mode 'slime-repl-mode)
 587                   (eq major-mode 'asm-mode))
 588               nil)
 589              (t
 590               (local-set-key "\C-m" 'newline-and-indent))))
 591   (local-set-key [C-return] 'newline)
 592   (or (eq major-mode 'asm-mode)
 593       (local-set-key [?\;] 'self-insert-command))
 594   (local-set-key [?\#] 'self-insert-command)
 595   (local-set-key [?\"] 'self-insert-command)
 596   (setq comment-column 40)
 597   (auto-fill-mode 1)
 598   (setq fill-column 77)
 599   (setq show-trailing-whitespace t)
 600   (mdw-set-font))
 601
 602 ;; --- Set up all sorts of faces ---
 603
 604 (defvar mdw-set-font nil)
 605
 606 (defvar mdw-punct-face 'mdw-punct-face "Face to use for punctuation")
 607 (make-face 'mdw-punct-face)
 608 (defvar mdw-number-face 'mdw-number-face "Face to use for numbers")
 609 (make-face 'mdw-number-face)
 610
 611 ;;;----- General fontification ----------------------------------------------
 612
 613 (defun mdw-set-fonts (frame faces)
 614   (while faces
 615     (let ((face (caar faces)))
 616       (or (facep face) (make-face face))
 617       (set-face-attribute face frame
 618                           :family 'unspecified
 619                           :width 'unspecified
 620                           :height 'unspecified
 621                           :weight 'unspecified
 622                           :slant 'unspecified
 623                           :foreground 'unspecified
 624                           :background 'unspecified
 625                           :underline 'unspecified
 626                           :overline 'unspecified
 627                           :strike-through 'unspecified
 628                           :box 'unspecified
 629                           :inverse-video 'unspecified
 630                           :stipple 'unspecified
 631                           ;:font 'unspecified
 632                           :inherit 'unspecified)
 633       (apply 'set-face-attribute face frame (cdar faces))
 634       (setq faces (cdr faces)))))
 635
 636 (defun mdw-do-set-font (&optional frame)
 637   (interactive)
 638   (mdw-set-fonts (and (boundp 'frame) frame)  `(
 639     (default :foreground "white" :background "black"
 640       ,@(cond ((eq window-system 'w32)
 641                '(:family "courier new" :height 85))
 642               ((eq window-system 'x)
 643                '(:family "misc-fixed" :height 130 :width semi-condensed))))
 644     (fixed-pitch)
 645     (minibuffer-prompt)
 646     (mode-line :foreground "blue" :background "yellow"
 647                :box (:line-width 1 :style released-button))
 648     (mode-line-inactive :foreground "yellow" :background "blue"
 649                         :box (:line-width 1 :style released-button))
 650     (scroll-bar :foreground "black" :background "lightgrey")
 651     (fringe :foreground "yellow" :background "black")
 652     (show-paren-match-face :background "darkgreen")
 653     (show-paren-mismatch-face :background "red")
 654     (font-lock-warning-face :background "red" :weight bold)
 655     (highlight :background "DarkSeaGreen4")
 656     (holiday-face :background "red")
 657     (calendar-today-face :foreground "yellow" :weight bold)
 658     (comint-highlight-prompt :weight bold)
 659     (comint-highlight-input)
 660     (font-lock-builtin-face :weight bold)
 661     (font-lock-type-face :weight bold)
 662     (region :background "grey30")
 663     (isearch :background "palevioletred2")
 664     (mdw-punct-face :foreground ,(if window-system "burlywood2" "yellow"))
 665     (mdw-number-face :foreground "yellow")
 666     (font-lock-function-name-face :weight bold)
 667     (font-lock-variable-name-face :slant italic)
 668     (font-lock-comment-delimiter-face
 669        :foreground ,(if window-system "SeaGreen1" "green")
 670        :slant italic)
 671     (font-lock-comment-face
 672        :foreground ,(if window-system "SeaGreen1" "green")
 673        :slant italic)
 674     (font-lock-string-face :foreground ,(if window-system "SkyBlue1" "cyan"))
 675     (font-lock-keyword-face :weight bold)
 676     (font-lock-constant-face :weight bold)
 677     (font-lock-reference-face :weight bold)
 678     (woman-bold :weight bold)
 679     (woman-italic :slant italic)
 680     (diff-index :weight bold)
 681     (diff-file-header :weight bold)
 682     (diff-hunk-header :foreground "SkyBlue1")
 683     (diff-function :foreground "SkyBlue1" :weight bold)
 684     (diff-header :background "grey10")
 685     (diff-added :foreground "green")
 686     (diff-removed :foreground "red")
 687     (diff-context)
 688     (whizzy-slice-face :background "grey10")
 689     (whizzy-error-face :background "darkred")
 690     (trailing-whitespace :background "red")
 691 )))
 692
 693 (defun mdw-set-font ()
 694   (trap
 695     (turn-on-font-lock)
 696     (if (not mdw-set-font)
 697         (progn
 698           (setq mdw-set-font t)
 699           (mdw-do-set-font nil)))))
 700
 701 ;;;----- C programming configuration ----------------------------------------
 702
 703 ;; --- Linux kernel hacking ---
 704
 705 (defvar linux-c-mode-hook)
 706
 707 (defun linux-c-mode ()
 708   (interactive)
 709   (c-mode)
 710   (setq major-mode 'linux-c-mode)
 711   (setq mode-name "Linux C")
 712   (run-hooks 'linux-c-mode-hook))
 713
 714 ;; --- Make C indentation nice ---
 715
 716 (defun mdw-c-style ()
 717   (c-add-style "[mdw] C and C++ style"
 718                '((c-basic-offset . 2)
 719                  (c-tab-always-indent . nil)
 720                  (comment-column . 40)
 721                  (c-class-key . "class")
 722                  (c-offsets-alist (substatement-open . 0)
 723                                   (label . 0)
 724                                   (case-label . +)
 725                                   (access-label . -)
 726                                   (inclass . +)
 727                                   (inline-open . ++)
 728                                   (statement-cont . 0)
 729                                   (statement-case-intro . +)))
 730                t))
 731
 732 (defun mdw-fontify-c-and-c++ ()
 733
 734   ;; --- Fiddle with some syntax codes ---
 735
 736   (modify-syntax-entry ?_ "w")
 737   (modify-syntax-entry ?* ". 23")
 738   (modify-syntax-entry ?/ ". 124b")
 739   (modify-syntax-entry ?\n "> b")
 740
 741   ;; --- Other stuff ---
 742
 743   (mdw-c-style)
 744   (setq c-hanging-comment-ender-p nil)
 745   (setq c-backslash-column 72)
 746   (setq c-label-minimum-indentation 0)
 747   (setq mdw-fill-prefix
 748         `((,(concat "\\([ \t]*/?\\)"
 749                     "\\([\*/][ \t]*\\)"
 750                     "\\([A-Za-z]+:[ \t]*\\)?"
 751                     mdw-hanging-indents)
 752            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
 753
 754   ;; --- Now define things to be fontified ---
 755
 756   (make-local-variable 'font-lock-keywords)
 757   (let ((c-keywords
 758          (mdw-regexps "and"             ;C++
 759                       "and_eq"          ;C++
 760                       "asm"             ;K&R, GCC
 761                       "auto"            ;K&R, C89
 762                       "bitand"          ;C++
 763                       "bitor"           ;C++
 764                       "bool"            ;C++, C9X macro
 765                       "break"           ;K&R, C89
 766                       "case"            ;K&R, C89
 767                       "catch"           ;C++
 768                       "char"            ;K&R, C89
 769                       "class"           ;C++
 770                       "complex"         ;C9X macro, C++ template type
 771                       "compl"           ;C++
 772                       "const"           ;C89
 773                       "const_cast"      ;C++
 774                       "continue"        ;K&R, C89
 775                       "defined"         ;C89 preprocessor
 776                       "default"         ;K&R, C89
 777                       "delete"          ;C++
 778                       "do"              ;K&R, C89
 779                       "double"          ;K&R, C89
 780                       "dynamic_cast"    ;C++
 781                       "else"            ;K&R, C89
 782                       ;; "entry"        ;K&R -- never used
 783                       "enum"            ;C89
 784                       "explicit"        ;C++
 785                       "export"          ;C++
 786                       "extern"          ;K&R, C89
 787                       "false"           ;C++, C9X macro
 788                       "float"           ;K&R, C89
 789                       "for"             ;K&R, C89
 790                       ;; "fortran"      ;K&R
 791                       "friend"          ;C++
 792                       "goto"            ;K&R, C89
 793                       "if"              ;K&R, C89
 794                       "imaginary"       ;C9X macro
 795                       "inline"          ;C++, C9X, GCC
 796                       "int"             ;K&R, C89
 797                       "long"            ;K&R, C89
 798                       "mutable"         ;C++
 799                       "namespace"       ;C++
 800                       "new"             ;C++
 801                       "operator"        ;C++
 802                       "or"              ;C++
 803                       "or_eq"           ;C++
 804                       "private"         ;C++
 805                       "protected"       ;C++
 806                       "public"          ;C++
 807                       "register"        ;K&R, C89
 808                       "reinterpret_cast" ;C++
 809                       "restrict"         ;C9X
 810                       "return"           ;K&R, C89
 811                       "short"            ;K&R, C89
 812                       "signed"           ;C89
 813                       "sizeof"           ;K&R, C89
 814                       "static"           ;K&R, C89
 815                       "static_cast"      ;C++
 816                       "struct"           ;K&R, C89
 817                       "switch"           ;K&R, C89
 818                       "template"         ;C++
 819                       "this"             ;C++
 820                       "throw"            ;C++
 821                       "true"             ;C++, C9X macro
 822                       "try"              ;C++
 823                       "this"             ;C++
 824                       "typedef"          ;C89
 825                       "typeid"           ;C++
 826                       "typeof"           ;GCC
 827                       "typename"         ;C++
 828                       "union"            ;K&R, C89
 829                       "unsigned"         ;K&R, C89
 830                       "using"            ;C++
 831                       "virtual"          ;C++
 832                       "void"             ;C89
 833                       "volatile"         ;C89
 834                       "wchar_t"          ;C++, C89 library type
 835                       "while"            ;K&R, C89
 836                       "xor"              ;C++
 837                       "xor_eq"           ;C++
 838                       "_Bool"            ;C9X
 839                       "_Complex"         ;C9X
 840                       "_Imaginary"       ;C9X
 841                       "_Pragma"          ;C9X preprocessor
 842                       "__alignof__"      ;GCC
 843                       "__asm__"          ;GCC
 844                       "__attribute__"    ;GCC
 845                       "__complex__"      ;GCC
 846                       "__const__"        ;GCC
 847                       "__extension__"    ;GCC
 848                       "__imag__"         ;GCC
 849                       "__inline__"       ;GCC
 850                       "__label__"        ;GCC
 851                       "__real__"         ;GCC
 852                       "__signed__"       ;GCC
 853                       "__typeof__"       ;GCC
 854                       "__volatile__"     ;GCC
 855                       ))
 856         (preprocessor-keywords
 857          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
 858                       "ident" "if" "ifdef" "ifndef" "import" "include"
 859                       "line" "pragma" "unassert" "undef" "warning"))
 860         (objc-keywords
 861          (mdw-regexps "class" "defs" "encode" "end" "implementation"
 862                       "interface" "private" "protected" "protocol" "public"
 863                       "selector")))
 864
 865     (setq font-lock-keywords
 866           (list
 867
 868            ;; --- Fontify include files as strings ---
 869
 870            (list (concat "^[ \t]*\\#[ \t]*"
 871                          "\\(include\\|import\\)"
 872                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
 873                  '(2 font-lock-string-face))
 874
 875            ;; --- Preprocessor directives are `references'? ---
 876
 877            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
 878                          preprocessor-keywords
 879                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
 880                  '(1 font-lock-keyword-face))
 881
 882            ;; --- Handle the keywords defined above ---
 883
 884            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
 885                  '(0 font-lock-keyword-face))
 886
 887            (list (concat "\\<\\(" c-keywords "\\)\\>")
 888                  '(0 font-lock-keyword-face))
 889
 890            ;; --- Handle numbers too ---
 891            ;;
 892            ;; This looks strange, I know.  It corresponds to the
 893            ;; preprocessor's idea of what a number looks like, rather than
 894            ;; anything sensible.
 895
 896            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
 897                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
 898                  '(0 mdw-number-face))
 899
 900            ;; --- And anything else is punctuation ---
 901
 902            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
 903                  '(0 mdw-punct-face))))))
 904
 905 ;;;----- AP calc mode -------------------------------------------------------
 906
 907 (defun apcalc-mode ()
 908   (interactive)
 909   (c-mode)
 910   (setq major-mode 'apcalc-mode)
 911   (setq mode-name "AP Calc")
 912   (run-hooks 'apcalc-mode-hook))
 913
 914 (defun mdw-fontify-apcalc ()
 915
 916   ;; --- Fiddle with some syntax codes ---
 917
 918   (modify-syntax-entry ?_ "w")
 919   (modify-syntax-entry ?* ". 23")
 920   (modify-syntax-entry ?/ ". 14")
 921
 922   ;; --- Other stuff ---
 923
 924   (mdw-c-style)
 925   (setq c-hanging-comment-ender-p nil)
 926   (setq c-backslash-column 72)
 927   (setq comment-start "/* ")
 928   (setq comment-end " */")
 929   (setq mdw-fill-prefix
 930         `((,(concat "\\([ \t]*/?\\)"
 931                     "\\([\*/][ \t]*\\)"
 932                     "\\([A-Za-z]+:[ \t]*\\)?"
 933                     mdw-hanging-indents)
 934            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
 935
 936   ;; --- Now define things to be fontified ---
 937
 938   (make-local-variable 'font-lock-keywords)
 939   (let ((c-keywords
 940          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
 941                       "do" "else" "exit" "for" "global" "goto" "help" "if"
 942                       "local" "mat" "obj" "print" "quit" "read" "return"
 943                       "show" "static" "switch" "while" "write")))
 944
 945     (setq font-lock-keywords
 946           (list
 947
 948            ;; --- Handle the keywords defined above ---
 949
 950            (list (concat "\\<\\(" c-keywords "\\)\\>")
 951                  '(0 font-lock-keyword-face))
 952
 953            ;; --- Handle numbers too ---
 954            ;;
 955            ;; This looks strange, I know.  It corresponds to the
 956            ;; preprocessor's idea of what a number looks like, rather than
 957            ;; anything sensible.
 958
 959            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
 960                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
 961                  '(0 mdw-number-face))
 962
 963            ;; --- And anything else is punctuation ---
 964
 965            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
 966                  '(0 mdw-punct-face))))))
 967
 968 ;;;----- Java programming configuration -------------------------------------
 969
 970 ;; --- Make indentation nice ---
 971
 972 (defun mdw-java-style ()
 973   (c-add-style "[mdw] Java style"
 974                '((c-basic-offset . 2)
 975                  (c-tab-always-indent . nil)
 976                  (c-offsets-alist (substatement-open . 0)
 977                                   (label . +)
 978                                   (case-label . +)
 979                                   (access-label . 0)
 980                                   (inclass . +)
 981                                   (statement-case-intro . +)))
 982                t))
 983
 984 ;; --- Declare Java fontification style ---
 985
 986 (defun mdw-fontify-java ()
 987
 988   ;; --- Other stuff ---
 989
 990   (mdw-java-style)
 991   (modify-syntax-entry ?_ "w")
 992   (setq c-hanging-comment-ender-p nil)
 993   (setq c-backslash-column 72)
 994   (setq comment-start "/* ")
 995   (setq comment-end " */")
 996   (setq mdw-fill-prefix
 997         `((,(concat "\\([ \t]*/?\\)"
 998                     "\\([\*/][ \t]*\\)"
 999                     "\\([A-Za-z]+:[ \t]*\\)?"
1000                     mdw-hanging-indents)
1001            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1002
1003   ;; --- Now define things to be fontified ---
1004
1005   (make-local-variable 'font-lock-keywords)
1006   (let ((java-keywords
1007          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1008                       "char" "class" "const" "continue" "default" "do"
1009                       "double" "else" "extends" "final" "finally" "float"
1010                       "for" "goto" "if" "implements" "import" "instanceof"
1011                       "int" "interface" "long" "native" "new" "package"
1012                       "private" "protected" "public" "return" "short"
1013                       "static" "super" "switch" "synchronized" "this"
1014                       "throw" "throws" "transient" "try" "void" "volatile"
1015                       "while"
1016
1017                       "false" "null" "true")))
1018
1019     (setq font-lock-keywords
1020           (list
1021
1022            ;; --- Handle the keywords defined above ---
1023
1024            (list (concat "\\<\\(" java-keywords "\\)\\>")
1025                  '(0 font-lock-keyword-face))
1026
1027            ;; --- Handle numbers too ---
1028            ;;
1029            ;; The following isn't quite right, but it's close enough.
1030
1031            (list (concat "\\<\\("
1032                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1033                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1034                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1035                          "[lLfFdD]?")
1036                  '(0 mdw-number-face))
1037
1038            ;; --- And anything else is punctuation ---
1039
1040            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1041                  '(0 mdw-punct-face))))))
1042
1043 ;;;----- C# programming configuration ---------------------------------------
1044
1045 ;; --- Make indentation nice ---
1046
1047 (defun mdw-csharp-style ()
1048   (c-add-style "[mdw] C# style"
1049                '((c-basic-offset . 2)
1050                  (c-tab-always-indent . nil)
1051                  (c-offsets-alist (substatement-open . 0)
1052                                   (label . 0)
1053                                   (case-label . +)
1054                                   (access-label . 0)
1055                                   (inclass . +)
1056                                   (statement-case-intro . +)))
1057                t))
1058
1059 ;; --- Declare C# fontification style ---
1060
1061 (defun mdw-fontify-csharp ()
1062
1063   ;; --- Other stuff ---
1064
1065   (mdw-csharp-style)
1066   (modify-syntax-entry ?_ "w")
1067   (setq c-hanging-comment-ender-p nil)
1068   (setq c-backslash-column 72)
1069   (setq comment-start "/* ")
1070   (setq comment-end " */")
1071   (setq mdw-fill-prefix
1072         `((,(concat "\\([ \t]*/?\\)"
1073                     "\\([\*/][ \t]*\\)"
1074                     "\\([A-Za-z]+:[ \t]*\\)?"
1075                     mdw-hanging-indents)
1076            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1077
1078   ;; --- Now define things to be fontified ---
1079
1080   (make-local-variable 'font-lock-keywords)
1081   (let ((csharp-keywords
1082          (mdw-regexps "abstract" "as" "base" "bool" "break"
1083                       "byte" "case" "catch" "char" "checked"
1084                       "class" "const" "continue" "decimal" "default"
1085                       "delegate" "do" "double" "else" "enum"
1086                       "event" "explicit" "extern" "false" "finally"
1087                       "fixed" "float" "for" "foreach" "goto"
1088                       "if" "implicit" "in" "int" "interface"
1089                       "internal" "is" "lock" "long" "namespace"
1090                       "new" "null" "object" "operator" "out"
1091                       "override" "params" "private" "protected" "public"
1092                       "readonly" "ref" "return" "sbyte" "sealed"
1093                       "short" "sizeof" "stackalloc" "static" "string"
1094                       "struct" "switch" "this" "throw" "true"
1095                       "try" "typeof" "uint" "ulong" "unchecked"
1096                       "unsafe" "ushort" "using" "virtual" "void"
1097                       "volatile" "while" "yield")))
1098
1099     (setq font-lock-keywords
1100           (list
1101
1102            ;; --- Handle the keywords defined above ---
1103
1104            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1105                  '(0 font-lock-keyword-face))
1106
1107            ;; --- Handle numbers too ---
1108            ;;
1109            ;; The following isn't quite right, but it's close enough.
1110
1111            (list (concat "\\<\\("
1112                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1113                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1114                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1115                          "[lLfFdD]?")
1116                  '(0 mdw-number-face))
1117
1118            ;; --- And anything else is punctuation ---
1119
1120            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1121                  '(0 mdw-punct-face))))))
1122
1123 (defun csharp-mode ()
1124   (interactive)
1125   (java-mode)
1126   (setq major-mode 'csharp-mode)
1127   (setq mode-name "C#")
1128   (mdw-fontify-csharp)
1129   (run-hooks 'csharp-mode-hook))
1130
1131 ;;;----- Awk programming configuration --------------------------------------
1132
1133 ;; --- Make Awk indentation nice ---
1134
1135 (defun mdw-awk-style ()
1136   (c-add-style "[mdw] Awk style"
1137                '((c-basic-offset . 2)
1138                  (c-tab-always-indent . nil)
1139                  (c-offsets-alist (substatement-open . 0)
1140                                   (statement-cont . 0)
1141                                   (statement-case-intro . +)))
1142                t))
1143
1144 ;; --- Declare Awk fontification style ---
1145
1146 (defun mdw-fontify-awk ()
1147
1148   ;; --- Miscellaneous fiddling ---
1149
1150   (modify-syntax-entry ?_ "w")
1151   (mdw-awk-style)
1152   (setq c-backslash-column 72)
1153   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1154
1155   ;; --- Now define things to be fontified ---
1156
1157   (make-local-variable 'font-lock-keywords)
1158   (let ((c-keywords
1159          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1160                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1161                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1162                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1163                       "atan2" "break" "close" "continue" "cos" "delete"
1164                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1165                       "function" "gensub" "getline" "gsub" "if" "in"
1166                       "index" "int" "length" "log" "match" "next" "rand"
1167                       "return" "print" "printf" "sin" "split" "sprintf"
1168                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1169                       "systime" "tolower" "toupper" "while")))
1170
1171     (setq font-lock-keywords
1172           (list
1173
1174            ;; --- Handle the keywords defined above ---
1175
1176            (list (concat "\\<\\(" c-keywords "\\)\\>")
1177                  '(0 font-lock-keyword-face))
1178
1179            ;; --- Handle numbers too ---
1180            ;;
1181            ;; The following isn't quite right, but it's close enough.
1182
1183            (list (concat "\\<\\("
1184                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1185                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1186                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1187                          "[uUlL]*")
1188                  '(0 mdw-number-face))
1189
1190            ;; --- And anything else is punctuation ---
1191
1192            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1193                  '(0 mdw-punct-face))))))
1194
1195 ;;;----- Perl programming style ---------------------------------------------
1196
1197 ;; --- Perl indentation style ---
1198
1199 (setq cperl-tab-always-indent nil)
1200
1201 (setq cperl-indent-level 2)
1202 (setq cperl-continued-statement-offset 2)
1203 (setq cperl-continued-brace-offset 0)
1204 (setq cperl-brace-offset -2)
1205 (setq cperl-brace-imaginary-offset 0)
1206 (setq cperl-label-offset 0)
1207
1208 ;; --- Define perl fontification style ---
1209
1210 (defun mdw-fontify-perl ()
1211
1212   ;; --- Miscellaneous fiddling ---
1213
1214   (modify-syntax-entry ?_ "w")
1215   (modify-syntax-entry ?$ "\\")
1216   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1217   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1218
1219   ;; --- Now define fontification things ---
1220
1221   (make-local-variable 'font-lock-keywords)
1222   (let ((perl-keywords
1223          (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1224                       "for" "foreach" "ge" "gt" "goto" "if"
1225                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1226                       "package" "redo" "require" "return" "sub"
1227                       "undef" "unless" "until" "use" "while")))
1228
1229     (setq font-lock-keywords
1230           (list
1231
1232            ;; --- Set up the keywords defined above ---
1233
1234            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1235                  '(0 font-lock-keyword-face))
1236
1237            ;; --- At least numbers are simpler than C ---
1238
1239            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1240                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1241                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1242                  '(0 mdw-number-face))
1243
1244            ;; --- And anything else is punctuation ---
1245
1246            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1247                  '(0 mdw-punct-face))))))
1248
1249 (defun perl-number-tests (&optional arg)
1250   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1251 strip numbers instead."
1252   (interactive "P")
1253   (save-excursion
1254     (goto-char (point-min))
1255     (let ((i 0) (fmt (if arg "" " %4d")))
1256       (while (search-forward "#t" nil t)
1257         (delete-region (point) (line-end-position))
1258         (setq i (1+ i))
1259         (insert (format fmt i)))
1260       (goto-char (point-min))
1261       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1262           (replace-match (format "\\1%d" i))))))
1263
1264 ;;;----- Python programming style -------------------------------------------
1265
1266 ;; --- Define Python fontification style ---
1267
1268 (defun mdw-fontify-python ()
1269
1270   ;; --- Miscellaneous fiddling ---
1271
1272   (modify-syntax-entry ?_ "w")
1273   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1274
1275   ;; --- Now define fontification things ---
1276
1277   (make-local-variable 'font-lock-keywords)
1278   (let ((python-keywords
1279          (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1280                       "del" "elif" "else" "except" "exec" "finally" "for"
1281                       "from" "global" "if" "import" "in" "is" "lambda"
1282                       "not" "or" "pass" "print" "raise" "return" "try"
1283                       "while" "yield")))
1284     (setq font-lock-keywords
1285           (list
1286
1287            ;; --- Set up the keywords defined above ---
1288
1289            (list (concat "\\<\\(" python-keywords "\\)\\>")
1290                  '(0 font-lock-keyword-face))
1291
1292            ;; --- At least numbers are simpler than C ---
1293
1294            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1295                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1296                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1297                  '(0 mdw-number-face))
1298
1299            ;; --- And anything else is punctuation ---
1300
1301            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1302                  '(0 mdw-punct-face))))))
1303
1304 ;;;----- ARM assembler programming configuration ----------------------------
1305
1306 ;; --- There doesn't appear to be an Emacs mode for this yet ---
1307 ;;
1308 ;; Better do something about that, I suppose.
1309
1310 (defvar arm-assembler-mode-map nil)
1311 (defvar arm-assembler-abbrev-table nil)
1312 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1313
1314 (or arm-assembler-mode-map
1315     (progn
1316       (setq arm-assembler-mode-map (make-sparse-keymap))
1317       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1318       (define-key arm-assembler-mode-map [C-return] 'newline)
1319       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1320
1321 (defun arm-assembler-mode ()
1322   "Major mode for ARM assembler programs"
1323   (interactive)
1324
1325   ;; --- Do standard major mode things ---
1326
1327   (kill-all-local-variables)
1328   (use-local-map arm-assembler-mode-map)
1329   (setq local-abbrev-table arm-assembler-abbrev-table)
1330   (setq major-mode 'arm-assembler-mode)
1331   (setq mode-name "ARM assembler")
1332
1333   ;; --- Set up syntax table ---
1334
1335   (set-syntax-table arm-assembler-mode-syntax-table)
1336   (modify-syntax-entry ?;   ; Nasty hack
1337                        "<" arm-assembler-mode-syntax-table)
1338   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1339   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1340
1341   (make-local-variable 'comment-start)
1342   (setq comment-start ";")
1343   (make-local-variable 'comment-end)
1344   (setq comment-end "")
1345   (make-local-variable 'comment-column)
1346   (setq comment-column 48)
1347   (make-local-variable 'comment-start-skip)
1348   (setq comment-start-skip ";+[ \t]*")
1349
1350   ;; --- Play with indentation ---
1351
1352   (make-local-variable 'indent-line-function)
1353   (setq indent-line-function 'indent-relative-maybe)
1354
1355   ;; --- Set fill prefix ---
1356
1357   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1358
1359   ;; --- Fiddle with fontification ---
1360
1361   (make-local-variable 'font-lock-keywords)
1362   (setq font-lock-keywords
1363         (list
1364
1365          ;; --- Handle numbers too ---
1366          ;;
1367          ;; The following isn't quite right, but it's close enough.
1368
1369          (list (concat "\\("
1370                        "&[0-9a-fA-F]+\\|"
1371                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1372                        "\\)")
1373                '(0 mdw-number-face))
1374
1375          ;; --- Do something about operators ---
1376
1377          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1378                '(1 font-lock-keyword-face)
1379                '(2 font-lock-string-face))
1380          (list ":[a-zA-Z]+:"
1381                '(0 font-lock-keyword-face))
1382
1383          ;; --- Do menemonics and directives ---
1384
1385          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1386                '(1 font-lock-keyword-face))
1387
1388          ;; --- And anything else is punctuation ---
1389
1390          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1391                '(0 mdw-punct-face))))
1392
1393   (run-hooks 'arm-assembler-mode-hook))
1394
1395 ;;;----- Assembler mode -----------------------------------------------------
1396
1397 (defun mdw-fontify-asm ()
1398   (modify-syntax-entry ?' "\"")
1399   (modify-syntax-entry ?. "w")
1400   (setf fill-prefix nil)
1401   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1402
1403 ;;;----- TCL configuration --------------------------------------------------
1404
1405 (defun mdw-fontify-tcl ()
1406   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1407   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1408   (make-local-variable 'font-lock-keywords)
1409   (setq font-lock-keywords
1410         (list
1411          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1412                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1413                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1414                '(0 mdw-number-face))
1415          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1416                '(0 mdw-punct-face)))))
1417
1418 ;;;----- REXX configuration -------------------------------------------------
1419
1420 (defun mdw-rexx-electric-* ()
1421   (interactive)
1422   (insert ?*)
1423   (rexx-indent-line))
1424
1425 (defun mdw-rexx-indent-newline-indent ()
1426   (interactive)
1427   (rexx-indent-line)
1428   (if abbrev-mode (expand-abbrev))
1429   (newline-and-indent))
1430
1431 (defun mdw-fontify-rexx ()
1432
1433   ;; --- Various bits of fiddling ---
1434
1435   (setq mdw-auto-indent nil)
1436   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1437   (local-set-key [?*] 'mdw-rexx-electric-*)
1438   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1439           '(?. ?! ?? ?_ ?# ?@ ?$))
1440   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1441
1442   ;; --- Set up keywords and things for fontification ---
1443
1444   (make-local-variable 'font-lock-keywords-case-fold-search)
1445   (setq font-lock-keywords-case-fold-search t)
1446
1447   (setq rexx-indent 2)
1448   (setq rexx-end-indent rexx-indent)
1449   (setq rexx-tab-always-indent nil)
1450   (setq rexx-cont-indent rexx-indent)
1451
1452   (make-local-variable 'font-lock-keywords)
1453   (let ((rexx-keywords
1454          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1455                       "else" "end" "engineering" "exit" "expose" "for"
1456                       "forever" "form" "fuzz" "if" "interpret" "iterate"
1457                       "leave" "linein" "name" "nop" "numeric" "off" "on"
1458                       "options" "otherwise" "parse" "procedure" "pull"
1459                       "push" "queue" "return" "say" "select" "signal"
1460                       "scientific" "source" "then" "trace" "to" "until"
1461                       "upper" "value" "var" "version" "when" "while"
1462                       "with"
1463
1464                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1465                       "center" "center" "charin" "charout" "chars"
1466                       "compare" "condition" "copies" "c2d" "c2x"
1467                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
1468                       "errortext" "format" "fuzz" "insert" "lastpos"
1469                       "left" "length" "lineout" "lines" "max" "min"
1470                       "overlay" "pos" "queued" "random" "reverse" "right"
1471                       "sign" "sourceline" "space" "stream" "strip"
1472                       "substr" "subword" "symbol" "time" "translate"
1473                       "trunc" "value" "verify" "word" "wordindex"
1474                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1475                       "x2d")))
1476
1477     (setq font-lock-keywords
1478           (list
1479
1480            ;; --- Set up the keywords defined above ---
1481
1482            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1483                  '(0 font-lock-keyword-face))
1484
1485            ;; --- Fontify all symbols the same way ---
1486
1487            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1488                          "[A-Za-z0-9.!?_#@$]+\\)")
1489                  '(0 font-lock-variable-name-face))
1490
1491            ;; --- And everything else is punctuation ---
1492
1493            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1494                  '(0 mdw-punct-face))))))
1495
1496 ;;;----- Standard ML programming style --------------------------------------
1497
1498 (defun mdw-fontify-sml ()
1499
1500   ;; --- Make underscore an honorary letter ---
1501
1502   (modify-syntax-entry ?_ "w")
1503   (modify-syntax-entry ?' "w")
1504
1505   ;; --- Set fill prefix ---
1506
1507   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1508
1509   ;; --- Now define fontification things ---
1510
1511   (make-local-variable 'font-lock-keywords)
1512   (let ((sml-keywords
1513          (mdw-regexps "abstype" "and" "andalso" "as"
1514                       "case"
1515                       "datatype" "do"
1516                       "else" "end" "eqtype" "exception"
1517                       "fn" "fun" "functor"
1518                       "handle"
1519                       "if" "in" "include" "infix" "infixr"
1520                       "let" "local"
1521                       "nonfix"
1522                       "of" "op" "open" "orelse"
1523                       "raise" "rec"
1524                       "sharing" "sig" "signature" "struct" "structure"
1525                       "then" "type"
1526                       "val"
1527                       "where" "while" "with" "withtype")))
1528
1529     (setq font-lock-keywords
1530           (list
1531
1532            ;; --- Set up the keywords defined above ---
1533
1534            (list (concat "\\<\\(" sml-keywords "\\)\\>")
1535                  '(0 font-lock-keyword-face))
1536
1537            ;; --- At least numbers are simpler than C ---
1538
1539            (list (concat "\\<\\(\\~\\|\\)"
1540                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
1541                                    "[wW][0-9]+\\)\\|"
1542                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1543                                          "\\([eE]\\(\\~\\|\\)"
1544                                                 "[0-9]+\\|\\)\\)\\)")
1545                  '(0 mdw-number-face))
1546
1547            ;; --- And anything else is punctuation ---
1548
1549            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1550                  '(0 mdw-punct-face))))))
1551
1552 ;;;----- Haskell configuration ----------------------------------------------
1553
1554 (defun mdw-fontify-haskell ()
1555
1556   ;; --- Fiddle with syntax table to get comments right ---
1557
1558   (modify-syntax-entry ?_ "w")
1559   (modify-syntax-entry ?' "\"")
1560   (modify-syntax-entry ?- ". 123")
1561   (modify-syntax-entry ?{ ". 1b")
1562   (modify-syntax-entry ?} ". 4b")
1563   (modify-syntax-entry ?\n ">")
1564
1565   ;; --- Set fill prefix ---
1566
1567   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1568
1569   ;; --- Fiddle with fontification ---
1570
1571   (make-local-variable 'font-lock-keywords)
1572   (let ((haskell-keywords
1573          (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1574                       "deriving" "do" "else" "foreign" "hiding" "if"
1575                       "import" "in" "infix" "infixl" "infixr" "instance"
1576                       "let" "module" "newtype" "of" "qualified" "safe"
1577                       "stdcall" "then" "type" "unsafe" "where")))
1578
1579     (setq font-lock-keywords
1580           (list
1581            (list "--.*$"
1582                  '(0 font-lock-comment-face))
1583            (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1584                  '(0 font-lock-keyword-face))
1585            (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1586                          "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1587                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1588                  '(0 mdw-number-face))
1589            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1590                  '(0 mdw-punct-face))))))
1591
1592 ;;;----- Texinfo configuration ----------------------------------------------
1593
1594 (defun mdw-fontify-texinfo ()
1595
1596   ;; --- Set fill prefix ---
1597
1598   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1599
1600   ;; --- Real fontification things ---
1601
1602   (make-local-variable 'font-lock-keywords)
1603   (setq font-lock-keywords
1604         (list
1605
1606          ;; --- Environment names are keywords ---
1607
1608          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
1609                '(2 font-lock-keyword-face))
1610
1611          ;; --- Unmark escaped magic characters ---
1612
1613          (list "\\(@\\)\\([@{}]\\)"
1614                '(1 font-lock-keyword-face)
1615                '(2 font-lock-variable-name-face))
1616
1617          ;; --- Make sure we get comments properly ---
1618
1619          (list "@c\\(\\|omment\\)\\( .*\\)?$"
1620                '(0 font-lock-comment-face))
1621
1622          ;; --- Command names are keywords ---
1623
1624          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1625                '(0 font-lock-keyword-face))
1626
1627          ;; --- Fontify TeX special characters as punctuation ---
1628
1629          (list "[{}]+"
1630                '(0 mdw-punct-face)))))
1631
1632 ;;;----- TeX and LaTeX configuration ----------------------------------------
1633
1634 (defun mdw-fontify-tex ()
1635   (setq ispell-parser 'tex)
1636
1637   ;; --- Don't make maths into a string ---
1638
1639   (modify-syntax-entry ?$ ".")
1640   (modify-syntax-entry ?$ "." font-lock-syntax-table)
1641   (local-set-key [?$] 'self-insert-command)
1642
1643   ;; --- Set fill prefix ---
1644
1645   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1646
1647   ;; --- Real fontification things ---
1648
1649   (make-local-variable 'font-lock-keywords)
1650   (setq font-lock-keywords
1651         (list
1652
1653          ;; --- Environment names are keywords ---
1654
1655          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1656                        "{\\([^}\n]*\\)}")
1657                '(2 font-lock-keyword-face))
1658
1659          ;; --- Suspended environment names are keywords too ---
1660
1661          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1662                        "{\\([^}\n]*\\)}")
1663                '(3 font-lock-keyword-face))
1664
1665          ;; --- Command names are keywords ---
1666
1667          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1668                '(0 font-lock-keyword-face))
1669
1670          ;; --- Handle @/.../ for italics ---
1671
1672          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
1673          ;;       '(1 font-lock-keyword-face)
1674          ;;       '(3 font-lock-keyword-face))
1675
1676          ;; --- Handle @*...* for boldness ---
1677
1678          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
1679          ;;       '(1 font-lock-keyword-face)
1680          ;;       '(3 font-lock-keyword-face))
1681
1682          ;; --- Handle @`...' for literal syntax things ---
1683
1684          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
1685          ;;       '(1 font-lock-keyword-face)
1686          ;;       '(3 font-lock-keyword-face))
1687
1688          ;; --- Handle @<...> for nonterminals ---
1689
1690          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
1691          ;;       '(1 font-lock-keyword-face)
1692          ;;       '(3 font-lock-keyword-face))
1693
1694          ;; --- Handle other @-commands ---
1695
1696          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
1697          ;;       '(0 font-lock-keyword-face))
1698
1699          ;; --- Make sure we get comments properly ---
1700
1701          (list "%.*"
1702                '(0 font-lock-comment-face))
1703
1704          ;; --- Fontify TeX special characters as punctuation ---
1705
1706          (list "[$^_{}#&]"
1707                '(0 mdw-punct-face)))))
1708
1709 ;;;----- SGML hacking -------------------------------------------------------
1710
1711 (defun mdw-sgml-mode ()
1712   (interactive)
1713   (sgml-mode)
1714   (mdw-standard-fill-prefix "")
1715   (make-variable-buffer-local 'sgml-delimiters)
1716   (setq sgml-delimiters
1717         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
1718           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
1719           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
1720           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
1721           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
1722           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
1723           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
1724           "NULL" ""))
1725   (setq major-mode 'mdw-sgml-mode)
1726   (setq mode-name "[mdw] SGML")
1727   (run-hooks 'mdw-sgml-mode-hook))
1728
1729 ;;;----- Shell scripts ------------------------------------------------------
1730
1731 (defun mdw-setup-sh-script-mode ()
1732
1733   ;; --- Fetch the shell interpreter's name ---
1734
1735   (let ((shell-name sh-shell-file))
1736
1737     ;; --- Try reading the hash-bang line ---
1738
1739     (save-excursion
1740       (goto-char (point-min))
1741       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
1742           (setq shell-name (match-string 1))))
1743
1744     ;; --- Now try to set the shell ---
1745     ;;
1746     ;; Don't let `sh-set-shell' bugger up my script.
1747
1748     (let ((executable-set-magic #'(lambda (s &rest r) s)))
1749       (sh-set-shell shell-name)))
1750
1751   ;; --- Now enable my keys and the fontification ---
1752
1753   (mdw-misc-mode-config)
1754
1755   ;; --- Set the indentation level correctly ---
1756
1757   (setq sh-indentation 2)
1758   (setq sh-basic-offset 2))
1759
1760 ;;;----- Messages-file mode -------------------------------------------------
1761
1762 (defun message-mode-guts ()
1763   (setq messages-mode-syntax-table (make-syntax-table))
1764   (set-syntax-table messages-mode-syntax-table)
1765   (modify-syntax-entry ?_ "w" messages-mode-syntax-table)
1766   (modify-syntax-entry ?- "w" messages-mode-syntax-table)
1767   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
1768   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
1769   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
1770   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
1771   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
1772   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
1773   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
1774   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
1775   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
1776   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
1777   (make-local-variable 'comment-start)
1778   (make-local-variable 'comment-end)
1779   (make-local-variable 'indent-line-function)
1780   (setq indent-line-function 'indent-relative)
1781   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1782   (make-local-variable 'font-lock-defaults)
1783   (make-local-variable 'message-mode-keywords)
1784   (let ((keywords
1785          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
1786                       "export" "enum" "fixed-octetstring" "flags"
1787                       "harmless" "map" "nested" "optional"
1788                       "optional-tagged" "package" "primitive"
1789                       "primitive-nullfree" "relaxed[ \t]+enum"
1790                       "set" "table" "tagged-optional"   "union"
1791                       "variadic" "vector" "version" "version-tag")))
1792     (setq message-mode-keywords
1793           (list
1794            (list (concat "\\<\\(" keywords "\\)\\>:")
1795                  '(0 font-lock-keyword-face))
1796            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
1797            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
1798              (0 font-lock-variable-name-face))
1799            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
1800            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1801              (0 mdw-punct-face)))))
1802   (setq font-lock-defaults
1803         '(message-mode-keywords nil nil nil nil))
1804   (run-hooks 'messages-file-hook))
1805
1806 (defun messages-mode ()
1807   (interactive)
1808   (fundamental-mode)
1809   (setq major-mode 'messages-mode)
1810   (setq mode-name "Messages")
1811   (message-mode-guts)
1812   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
1813   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
1814   (setq comment-start "# ")
1815   (setq comment-end "")
1816   (turn-on-font-lock-if-enabled)
1817   (run-hooks 'messages-mode-hook))
1818
1819 (defun cpp-messages-mode ()
1820   (interactive)
1821   (fundamental-mode)
1822   (setq major-mode 'cpp-messages-mode)
1823   (setq mode-name "CPP Messages")
1824   (message-mode-guts)
1825   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
1826   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
1827   (setq comment-start "/* ")
1828   (setq comment-end " */")
1829   (let ((preprocessor-keywords
1830          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1831                       "ident" "if" "ifdef" "ifndef" "import" "include"
1832                       "line" "pragma" "unassert" "undef" "warning")))
1833     (setq message-mode-keywords
1834           (append (list (list (concat "^[ \t]*\\#[ \t]*"
1835                                       "\\(include\\|import\\)"
1836                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1837                               '(2 font-lock-string-face))
1838                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1839                                       preprocessor-keywords
1840                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
1841                               '(1 font-lock-keyword-face)))
1842                   message-mode-keywords)))
1843   (turn-on-font-lock-if-enabled)
1844   (run-hooks 'cpp-messages-mode-hook))
1845
1846 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
1847 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
1848 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
1849
1850 ;;;----- Messages-file mode -------------------------------------------------
1851
1852 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
1853   "Face to use for subsittution directives.")
1854 (make-face 'mallow-driver-substitution-face)
1855 (defvar mallow-driver-text-face 'mallow-driver-text-face
1856   "Face to use for body text.")
1857 (make-face 'mallow-driver-text-face)
1858
1859 (defun mallow-driver-mode ()
1860   (interactive)
1861   (fundamental-mode)
1862   (setq major-mode 'mallow-driver-mode)
1863   (setq mode-name "Mallow driver")
1864   (setq mallow-driver-mode-syntax-table (make-syntax-table))
1865   (set-syntax-table mallow-driver-mode-syntax-table)
1866   (make-local-variable 'comment-start)
1867   (make-local-variable 'comment-end)
1868   (make-local-variable 'indent-line-function)
1869   (setq indent-line-function 'indent-relative)
1870   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1871   (make-local-variable 'font-lock-defaults)
1872   (make-local-variable 'mallow-driver-mode-keywords)
1873   (let ((keywords
1874          (mdw-regexps "each" "divert" "file" "if"
1875                       "perl" "set" "string" "type" "write")))
1876     (setq mallow-driver-mode-keywords
1877           (list
1878            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
1879                  '(0 font-lock-keyword-face))
1880            (list "^%\\s *\\(#.*\\|\\)$"
1881                  '(0 font-lock-comment-face))
1882            (list "^%"
1883                  '(0 font-lock-keyword-face))
1884            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
1885            (list "\\${[^}]*}"
1886                  '(0 mallow-driver-substitution-face t)))))
1887   (setq font-lock-defaults
1888         '(mallow-driver-mode-keywords nil nil nil nil))
1889   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
1890   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
1891   (setq comment-start "%# ")
1892   (setq comment-end "")
1893   (turn-on-font-lock-if-enabled)
1894   (run-hooks 'mallow-driver-mode-hook))
1895
1896 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
1897
1898 ;;;----- NFast debugs -------------------------------------------------------
1899
1900 (defun nfast-debug-mode ()
1901   (interactive)
1902   (fundamental-mode)
1903   (setq major-mode 'nfast-debug-mode)
1904   (setq mode-name "NFast debug")
1905   (setq messages-mode-syntax-table (make-syntax-table))
1906   (set-syntax-table messages-mode-syntax-table)
1907   (make-local-variable 'font-lock-defaults)
1908   (make-local-variable 'nfast-debug-mode-keywords)
1909   (setq truncate-lines t)
1910   (setq nfast-debug-mode-keywords
1911         (list
1912          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
1913            (0 font-lock-keyword-face))
1914          (list (concat "^[ \t]+\\(\\("
1915                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
1916                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
1917                        "[ \t]+\\)*"
1918                        "[0-9a-fA-F]+\\)[ \t]*$")
1919            '(0 mdw-number-face))
1920          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
1921            (1 font-lock-keyword-face))
1922          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
1923            (1 font-lock-warning-face))
1924          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
1925            (1 nil))
1926          (list (concat "^[ \t]+\\.cmd=[ \t]+"
1927                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
1928            '(1 font-lock-keyword-face))
1929          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
1930          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
1931          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
1932          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
1933   (setq font-lock-defaults
1934         '(nfast-debug-mode-keywords nil nil nil nil))
1935   (turn-on-font-lock-if-enabled)
1936   (run-hooks 'nfast-debug-mode-hook))
1937
1938 ;;;----- Other languages ----------------------------------------------------
1939
1940 ;; --- Smalltalk ---
1941
1942 (defun mdw-setup-smalltalk ()
1943   (and mdw-auto-indent
1944        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
1945   (make-variable-buffer-local 'mdw-auto-indent)
1946   (setq mdw-auto-indent nil)
1947   (local-set-key "\C-i" 'smalltalk-reindent))
1948
1949 (defun mdw-fontify-smalltalk ()
1950   (make-local-variable 'font-lock-keywords)
1951   (setq font-lock-keywords
1952         (list
1953          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
1954                '(0 font-lock-keyword-face))
1955          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1956                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1957                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1958                '(0 mdw-number-face))
1959          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1960                '(0 mdw-punct-face)))))
1961
1962 ;; --- Lispy languages ---
1963
1964 (defun mdw-indent-newline-and-indent ()
1965   (interactive)
1966   (indent-for-tab-command)
1967   (newline-and-indent))
1968
1969 (eval-after-load "cl-indent"
1970   '(progn
1971      (mapc #'(lambda (pair)
1972                (put (car pair)
1973                     'common-lisp-indent-function
1974                     (cdr pair)))
1975       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
1976         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
1977
1978 (defun mdw-common-lisp-indent ()
1979   (make-variable-buffer-local 'lisp-indent-function)
1980   (setq lisp-indent-function 'common-lisp-indent-function))
1981
1982 (defun mdw-fontify-lispy ()
1983
1984   ;; --- Set fill prefix ---
1985
1986   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1987
1988   ;; --- Not much fontification needed ---
1989
1990   (make-local-variable 'font-lock-keywords)
1991   (setq font-lock-keywords
1992         (list
1993          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1994                '(0 mdw-punct-face)))))
1995
1996 (defun comint-send-and-indent ()
1997   (interactive)
1998   (comint-send-input)
1999   (and mdw-auto-indent
2000        (indent-for-tab-command)))
2001
2002 (defun mdw-setup-m4 ()
2003   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2004
2005 ;;;----- Text mode ----------------------------------------------------------
2006
2007 (defun mdw-text-mode ()
2008   (setq fill-column 72)
2009   (flyspell-mode t)
2010   (mdw-standard-fill-prefix
2011    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2012   (auto-fill-mode 1))
2013
2014 ;;;----- Shell mode ---------------------------------------------------------
2015
2016 (defun mdw-sh-mode-setup ()
2017   (local-set-key [?\C-a] 'comint-bol)
2018   (add-hook 'comint-output-filter-functions
2019             'comint-watch-for-password-prompt))
2020
2021 (defun mdw-term-mode-setup ()
2022   (setq term-prompt-regexp "^[^]#$%>»}\n]*[]#$%>»}] *")
2023   (make-local-variable 'mouse-yank-at-point)
2024   (make-local-variable 'transient-mark-mode)
2025   (setq mouse-yank-at-point t)
2026   (setq transient-mark-mode nil)
2027   (auto-fill-mode -1)
2028   (setq tab-width 8))
2029
2030 ;;;----- That's all, folks --------------------------------------------------
2031
2032 (provide 'dot-emacs)