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