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