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