chiark - git - mdw - profile/blob - dot-emacs.el

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