chiark - git - mdw - profile/blob - el/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 ;;;--------------------------------------------------------------------------
  25 ;;; Check command-line.
  26
  27 (defvar mdw-fast-startup nil
  28   "Whether .emacs should optimize for rapid startup.
  29 This may be at the expense of cool features.")
  30 (let ((probe nil) (next command-line-args))
  31   (while next
  32     (cond ((string= (car next) "--mdw-fast-startup")
  33            (setq mdw-fast-startup t)
  34            (if probe
  35                (rplacd probe (cdr next))
  36              (setq command-line-args (cdr next))))
  37           (t
  38            (setq probe next)))
  39     (setq next (cdr next))))
  40
  41 ;;;--------------------------------------------------------------------------
  42 ;;; Some general utilities.
  43
  44 (eval-when-compile
  45   (unless (fboundp 'make-regexp)
  46     (load "make-regexp"))
  47   (require 'cl))
  48
  49 (defmacro mdw-regexps (&rest list)
  50   "Turn a LIST of strings into a single regular expression at compile-time."
  51   (declare (indent nil)
  52            (debug 0))
  53   `',(make-regexp list))
  54
  55 ;; Some error trapping.
  56 ;;
  57 ;; If individual bits of this file go tits-up, we don't particularly want
  58 ;; the whole lot to stop right there and then, because it's bloody annoying.
  59
  60 (defmacro trap (&rest forms)
  61   "Execute FORMS without allowing errors to propagate outside."
  62   (declare (indent 0)
  63            (debug t))
  64   `(condition-case err
  65        ,(if (cdr forms) (cons 'progn forms) (car forms))
  66      (error (message "Error (trapped): %s in %s"
  67                      (error-message-string err)
  68                      ',forms))))
  69
  70 ;; Configuration reading.
  71
  72 (defvar mdw-config nil)
  73 (defun mdw-config (sym)
  74   "Read the configuration variable named SYM."
  75   (unless mdw-config
  76     (setq mdw-config
  77           (flet ((replace (what with)
  78                    (goto-char (point-min))
  79                    (while (re-search-forward what nil t)
  80                      (replace-match with t))))
  81             (with-temp-buffer
  82               (insert-file-contents "~/.mdw.conf")
  83               (replace  "^[ \t]*\\(#.*\\|\\)\n" "")
  84               (replace (concat "^[ \t]*"
  85                                "\\([-a-zA-Z0-9_.]*\\)"
  86                                "[ \t]*=[ \t]*"
  87                                "\\(.*[^ \t\n]\\|\\)"
  88                                "[ \t]**\\(\n\\|$\\)")
  89                        "(\\1 . \"\\2\")\n")
  90               (car (read-from-string
  91                     (concat "(" (buffer-string) ")")))))))
  92   (cdr (assq sym mdw-config)))
  93
  94 ;; Set up the load path convincingly.
  95
  96 (dolist (dir (append (and (boundp 'debian-emacs-flavor)
  97                           (list (concat "/usr/share/"
  98                                         (symbol-name debian-emacs-flavor)
  99                                         "/site-lisp")))))
 100   (dolist (sub (directory-files dir t))
 101     (when (and (file-accessible-directory-p sub)
 102                (not (member sub load-path)))
 103       (setq load-path (nconc load-path (list sub))))))
 104
 105 ;; Is an Emacs library available?
 106
 107 (defun library-exists-p (name)
 108   "Return non-nil if NAME is an available library.
 109 Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
 110 load path.  The non-nil value is the filename we found for the
 111 library."
 112   (let ((path load-path) elt (foundp nil))
 113     (while (and path (not foundp))
 114       (setq elt (car path))
 115       (setq path (cdr path))
 116       (setq foundp (or (let ((file (concat elt "/" name ".elc")))
 117                          (and (file-exists-p file) file))
 118                        (let ((file (concat elt "/" name ".el")))
 119                          (and (file-exists-p file) file)))))
 120     foundp))
 121
 122 (defun maybe-autoload (symbol file &optional docstring interactivep type)
 123   "Set an autoload if the file actually exists."
 124   (and (library-exists-p file)
 125        (autoload symbol file docstring interactivep type)))
 126
 127 (defun mdw-kick-menu-bar (&optional frame)
 128   "Regenerate FRAME's menu bar so it doesn't have empty menus."
 129   (interactive)
 130   (unless frame (setq frame (selected-frame)))
 131   (let ((old (frame-parameter frame 'menu-bar-lines)))
 132     (set-frame-parameter frame 'menu-bar-lines 0)
 133     (set-frame-parameter frame 'menu-bar-lines old)))
 134
 135 ;; Splitting windows.
 136
 137 (unless (fboundp 'scroll-bar-columns)
 138   (defun scroll-bar-columns (side)
 139     (cond ((eq side 'left) 0)
 140           (window-system 3)
 141           (t 1))))
 142 (unless (fboundp 'fringe-columns)
 143   (defun fringe-columns (side)
 144     (cond ((not window-system) 0)
 145           ((eq side 'left) 1)
 146           (t 2))))
 147
 148 (defun mdw-horizontal-window-overhead ()
 149   "Computes the horizontal window overhead.
 150 This is the number of columns used by fringes, scroll bars and other such
 151 cruft."
 152   (if (not window-system)
 153       1
 154     (let ((tot 0))
 155       (dolist (what '(scroll-bar fringe))
 156         (dolist (side '(left right))
 157           (incf tot (funcall (intern (concat (symbol-name what) "-columns"))
 158                              side))))
 159       tot)))
 160
 161 (defun mdw-split-window-horizontally (&optional width)
 162   "Split a window horizontally.
 163 Without a numeric argument, split the window approximately in
 164 half.  With a numeric argument WIDTH, allocate WIDTH columns to
 165 the left-hand window (if positive) or -WIDTH columns to the
 166 right-hand window (if negative).  Space for scroll bars and
 167 fringes is not taken out of the allowance for WIDTH, unlike
 168 \\[split-window-horizontally]."
 169   (interactive "P")
 170   (split-window-horizontally
 171    (cond ((null width) nil)
 172          ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
 173          ((< width 0) width))))
 174
 175 (defun mdw-divvy-window (&optional width)
 176   "Split a wide window into appropriate widths."
 177   (interactive "P")
 178   (setq width (cond (width (prefix-numeric-value width))
 179                     ((and window-system
 180                           (>= emacs-major-version 22))
 181                      77)
 182                     (t 78)))
 183   (let* ((win (selected-window))
 184          (sb-width (mdw-horizontal-window-overhead))
 185          (c (/ (+ (window-width) sb-width)
 186                (+ width sb-width))))
 187     (while (> c 1)
 188       (setq c (1- c))
 189       (split-window-horizontally (+ width sb-width))
 190       (other-window 1))
 191     (select-window win)))
 192
 193 ;; Transient mark mode hacks.
 194
 195 (defadvice exchange-point-and-mark
 196     (around mdw-highlight (&optional arg) activate compile)
 197   "Maybe don't actually exchange point and mark.
 198 If `transient-mark-mode' is on and the mark is inactive, then
 199 just activate it.  A non-trivial prefix argument will force the
 200 usual behaviour.  A trivial prefix argument (i.e., just C-u) will
 201 activate the mark and temporarily enable `transient-mark-mode' if
 202 it's currently off."
 203   (cond ((or mark-active
 204              (and (not transient-mark-mode) (not arg))
 205              (and arg (or (not (consp arg))
 206                           (not (= (car arg) 4)))))
 207          ad-do-it)
 208         (t
 209          (or transient-mark-mode (setq transient-mark-mode 'only))
 210          (set-mark (mark t)))))
 211
 212 ;; Functions for sexp diary entries.
 213
 214 (defun mdw-weekday (l)
 215   "Return non-nil if `date' falls on one of the days of the week in L.
 216 L is a list of day numbers (from 0 to 6 for Sunday through to
 217 Saturday) or symbols `sunday', `monday', etc. (or a mixture).  If
 218 the date stored in `date' falls on a listed day, then the
 219 function returns non-nil."
 220   (let ((d (calendar-day-of-week date)))
 221     (or (memq d l)
 222         (memq (nth d '(sunday monday tuesday wednesday
 223                               thursday friday saturday)) l))))
 224
 225 (defun mdw-todo (&optional when)
 226   "Return non-nil today, or on WHEN, whichever is later."
 227   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
 228         (d (calendar-absolute-from-gregorian date)))
 229     (if when
 230         (setq w (max w (calendar-absolute-from-gregorian
 231                         (cond
 232                          ((not european-calendar-style)
 233                           when)
 234                          ((> (car when) 100)
 235                           (list (nth 1 when)
 236                                 (nth 2 when)
 237                                 (nth 0 when)))
 238                          (t
 239                           (list (nth 1 when)
 240                                 (nth 0 when)
 241                                 (nth 2 when))))))))
 242     (eq w d)))
 243
 244 ;; Fighting with Org-mode's evil key maps.
 245
 246 (defvar mdw-evil-keymap-keys
 247   '(([S-up] . [?\C-c up])
 248     ([S-down] . [?\C-c down])
 249     ([S-left] . [?\C-c left])
 250     ([S-right] . [?\C-c right])
 251     (([M-up] [?\e up]) . [C-up])
 252     (([M-down] [?\e down]) . [C-down])
 253     (([M-left] [?\e left]) . [C-left])
 254     (([M-right] [?\e right]) . [C-right]))
 255   "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
 256 The value is an alist mapping evil keys (as a list, or singleton)
 257 to good keys (in the same form).")
 258
 259 (defun mdw-clobber-evil-keymap (keymap)
 260   "Replace evil key bindings in the KEYMAP.
 261 Evil key bindings are defined in `mdw-evil-keymap-keys'."
 262   (dolist (entry mdw-evil-keymap-keys)
 263     (let ((binding nil)
 264           (keys (if (listp (car entry))
 265                     (car entry)
 266                   (list (car entry))))
 267           (replacements (if (listp (cdr entry))
 268                             (cdr entry)
 269                           (list (cdr entry)))))
 270       (catch 'found
 271         (dolist (key keys)
 272           (setq binding (lookup-key keymap key))
 273           (when binding
 274             (throw 'found nil))))
 275       (when binding
 276         (dolist (key keys)
 277           (define-key keymap key nil))
 278         (dolist (key replacements)
 279           (define-key keymap key binding))))))
 280
 281 (eval-after-load "org-latex"
 282   '(progn
 283      (push '("strayman"
 284              "\\documentclass{strayman}
 285 \\usepackage[utf8]{inputenc}
 286 \\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
 287 \\usepackage[T1]{fontenc}
 288 \\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
 289              ("\\section{%s}" . "\\section*{%s}")
 290              ("\\subsection{%s}" . "\\subsection*{%s}")
 291              ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
 292              ("\\paragraph{%s}" . "\\paragraph*{%s}")
 293              ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
 294            org-export-latex-classes)))
 295
 296 (setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i"
 297       org-export-docbook-xsl-fo-proc-command "fop %i.safe %o"
 298       org-export-docbook-xslt-stylesheet
 299       "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl")
 300
 301 ;;;--------------------------------------------------------------------------
 302 ;;; Mail and news hacking.
 303
 304 (define-derived-mode  mdwmail-mode mail-mode "[mdw] mail"
 305   "Major mode for editing news and mail messages from external programs.
 306 Not much right now.  Just support for doing MailCrypt stuff."
 307   :syntax-table nil
 308   :abbrev-table nil
 309   (run-hooks 'mail-setup-hook))
 310
 311 (define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
 312
 313 (add-hook 'mdwail-mode-hook
 314           (lambda ()
 315             (set-buffer-file-coding-system 'utf-8)
 316             (make-local-variable 'paragraph-separate)
 317             (make-local-variable 'paragraph-start)
 318             (setq paragraph-start
 319                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 320                           paragraph-start))
 321             (setq paragraph-separate
 322                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 323                           paragraph-separate))))
 324
 325 ;; How to encrypt in mdwmail.
 326
 327 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
 328   (or start
 329       (setq start (save-excursion
 330                     (goto-char (point-min))
 331                     (or (search-forward "\n\n" nil t) (point-min)))))
 332   (or end
 333       (setq end (point-max)))
 334   (mc-encrypt-generic recip scm start end from sign))
 335
 336 ;; How to sign in mdwmail.
 337
 338 (defun mdwmail-mc-sign (key scm start end uclr)
 339   (or start
 340       (setq start (save-excursion
 341                     (goto-char (point-min))
 342                     (or (search-forward "\n\n" nil t) (point-min)))))
 343   (or end
 344       (setq end (point-max)))
 345   (mc-sign-generic key scm start end uclr))
 346
 347 ;; Some signature mangling.
 348
 349 (defun mdwmail-mangle-signature ()
 350   (save-excursion
 351     (goto-char (point-min))
 352     (perform-replace "\n-- \n" "\n-- " nil nil nil)))
 353 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
 354 (add-hook 'message-setup-hook 'mdwmail-mangle-signature)
 355
 356 ;; Insert my login name into message-ids, so I can score replies.
 357
 358 (defadvice message-unique-id (after mdw-user-name last activate compile)
 359   "Ensure that the user's name appears at the end of the message-id string,
 360 so that it can be used for convenient filtering."
 361   (setq ad-return-value (concat ad-return-value "." (user-login-name))))
 362
 363 ;; Tell my movemail hack where movemail is.
 364 ;;
 365 ;; This is needed to shup up warnings about LD_PRELOAD.
 366
 367 (let ((path exec-path))
 368   (while path
 369     (let ((try (expand-file-name "movemail" (car path))))
 370       (if (file-executable-p try)
 371           (setenv "REAL_MOVEMAIL" try))
 372       (setq path (cdr path)))))
 373
 374 (eval-after-load "erc"
 375     '(load "~/.ercrc.el"))
 376
 377 ;;;--------------------------------------------------------------------------
 378 ;;; Utility functions.
 379
 380 (or (fboundp 'line-number-at-pos)
 381     (defun line-number-at-pos (&optional pos)
 382       (let ((opoint (or pos (point))) start)
 383         (save-excursion
 384           (save-restriction
 385             (goto-char (point-min))
 386             (widen)
 387             (forward-line 0)
 388             (setq start (point))
 389             (goto-char opoint)
 390             (forward-line 0)
 391             (1+ (count-lines 1 (point))))))))
 392
 393 (defun mdw-uniquify-alist (&rest alists)
 394   "Return the concatenation of the ALISTS with duplicate elements removed.
 395 The first association with a given key prevails; others are
 396 ignored.  The input lists are not modified, although they'll
 397 probably become garbage."
 398   (and alists
 399        (let ((start-list (cons nil nil)))
 400          (mdw-do-uniquify start-list
 401                           start-list
 402                           (car alists)
 403                           (cdr alists)))))
 404
 405 (defun mdw-do-uniquify (done end l rest)
 406   "A helper function for mdw-uniquify-alist.
 407 The DONE argument is a list whose first element is `nil'.  It
 408 contains the uniquified alist built so far.  The leading `nil' is
 409 stripped off at the end of the operation; it's only there so that
 410 DONE always references a cons cell.  END refers to the final cons
 411 cell in the DONE list; it is modified in place each time to avoid
 412 the overheads of `append'ing all the time.  The L argument is the
 413 alist we're currently processing; the remaining alists are given
 414 in REST."
 415
 416   ;; There are several different cases to deal with here.
 417   (cond
 418
 419    ;; Current list isn't empty.  Add the first item to the DONE list if
 420    ;; there's not an item with the same KEY already there.
 421    (l (or (assoc (car (car l)) done)
 422           (progn
 423             (setcdr end (cons (car l) nil))
 424             (setq end (cdr end))))
 425       (mdw-do-uniquify done end (cdr l) rest))
 426
 427    ;; The list we were working on is empty.  Shunt the next list into the
 428    ;; current list position and go round again.
 429    (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
 430
 431    ;; Everything's done.  Remove the leading `nil' from the DONE list and
 432    ;; return it.  Finished!
 433    (t (cdr done))))
 434
 435 (defun date ()
 436   "Insert the current date in a pleasing way."
 437   (interactive)
 438   (insert (save-excursion
 439             (let ((buffer (get-buffer-create "*tmp*")))
 440               (unwind-protect (progn (set-buffer buffer)
 441                                      (erase-buffer)
 442                                      (shell-command "date +%Y-%m-%d" t)
 443                                      (goto-char (mark))
 444                                      (delete-backward-char 1)
 445                                      (buffer-string))
 446                 (kill-buffer buffer))))))
 447
 448 (defun uuencode (file &optional name)
 449   "UUencodes a file, maybe calling it NAME, into the current buffer."
 450   (interactive "fInput file name: ")
 451
 452   ;; If NAME isn't specified, then guess from the filename.
 453   (if (not name)
 454       (setq name
 455             (substring file
 456                        (or (string-match "[^/]*$" file) 0))))
 457   (print (format "uuencode `%s' `%s'" file name))
 458
 459   ;; Now actually do the thing.
 460   (call-process "uuencode" file t nil name))
 461
 462 (defvar np-file "~/.np"
 463   "*Where the `now-playing' file is.")
 464
 465 (defun np (&optional arg)
 466   "Grabs a `now-playing' string."
 467   (interactive)
 468   (save-excursion
 469     (or arg (progn
 470               (goto-char (point-max))
 471               (insert "\nNP: ")
 472               (insert-file-contents np-file)))))
 473
 474 (defun mdw-version-< (ver-a ver-b)
 475   "Answer whether VER-A is strictly earlier than VER-B.
 476 VER-A and VER-B are version numbers, which are strings containing digit
 477 sequences separated by `.'."
 478   (let* ((la (mapcar (lambda (x) (car (read-from-string x)))
 479                      (split-string ver-a "\\.")))
 480          (lb (mapcar (lambda (x) (car (read-from-string x)))
 481                      (split-string ver-b "\\."))))
 482     (catch 'done
 483       (while t
 484         (cond ((null la) (throw 'done lb))
 485               ((null lb) (throw 'done nil))
 486               ((< (car la) (car lb)) (throw 'done t))
 487               ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb))))))))
 488
 489 (defun mdw-check-autorevert ()
 490   "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
 491 This takes into consideration whether it's been found using
 492 tramp, which seems to get itself into a twist."
 493   (cond ((not (boundp 'global-auto-revert-ignore-buffer))
 494          nil)
 495         ((and (buffer-file-name)
 496               (fboundp 'tramp-tramp-file-p)
 497               (tramp-tramp-file-p (buffer-file-name)))
 498          (unless global-auto-revert-ignore-buffer
 499            (setq global-auto-revert-ignore-buffer 'tramp)))
 500         ((eq global-auto-revert-ignore-buffer 'tramp)
 501          (setq global-auto-revert-ignore-buffer nil))))
 502
 503 (defadvice find-file (after mdw-autorevert activate)
 504   (mdw-check-autorevert))
 505 (defadvice write-file (after mdw-autorevert activate)
 506   (mdw-check-autorevert))
 507
 508 ;;;--------------------------------------------------------------------------
 509 ;;; Dired hacking.
 510
 511 (defadvice dired-maybe-insert-subdir
 512     (around mdw-marked-insertion first activate)
 513   "The DIRNAME may be a list of directory names to insert.
 514 Interactively, if files are marked, then insert all of them.
 515 With a numeric prefix argument, select that many entries near
 516 point; with a non-numeric prefix argument, prompt for listing
 517 options."
 518   (interactive
 519    (list (dired-get-marked-files nil
 520                                  (and (integerp current-prefix-arg)
 521                                       current-prefix-arg)
 522                                  #'file-directory-p)
 523          (and current-prefix-arg
 524               (not (integerp current-prefix-arg))
 525               (read-string "Switches for listing: "
 526                            (or dired-subdir-switches
 527                                dired-actual-switches)))))
 528   (let ((dirs (ad-get-arg 0)))
 529     (dolist (dir (if (listp dirs) dirs (list dirs)))
 530       (ad-set-arg 0 dir)
 531       ad-do-it)))
 532
 533 ;;;--------------------------------------------------------------------------
 534 ;;; URL viewing.
 535
 536 (defun mdw-w3m-browse-url (url &optional new-session-p)
 537   "Invoke w3m on the URL in its current window, or at least a different one.
 538 If NEW-SESSION-P, start a new session."
 539   (interactive "sURL: \nP")
 540   (save-excursion
 541     (let ((window (selected-window)))
 542       (unwind-protect
 543           (progn
 544             (select-window (or (and (not new-session-p)
 545                                     (get-buffer-window "*w3m*"))
 546                                (progn
 547                                  (if (one-window-p t) (split-window))
 548                                  (get-lru-window))))
 549             (w3m-browse-url url new-session-p))
 550         (select-window window)))))
 551
 552 (defvar mdw-good-url-browsers
 553   '(browse-url-generic
 554     (w3m . mdw-w3m-browse-url)
 555     browse-url-w3
 556     browse-url-mozilla)
 557   "List of good browsers for mdw-good-url-browsers.
 558 Each item is a browser function name, or a cons (CHECK . FUNC).
 559 A symbol FOO stands for (FOO . FOO).")
 560
 561 (defun mdw-good-url-browser ()
 562   "Return a good URL browser.
 563 Trundle the list of such things, finding the first item for which
 564 CHECK is fboundp, and returning the correponding FUNC."
 565   (let ((bs mdw-good-url-browsers) b check func answer)
 566     (while (and bs (not answer))
 567       (setq b (car bs)
 568             bs (cdr bs))
 569       (if (consp b)
 570           (setq check (car b) func (cdr b))
 571         (setq check b func b))
 572       (if (fboundp check)
 573           (setq answer func)))
 574     answer))
 575
 576 (eval-after-load "w3m-search"
 577   '(progn
 578      (dolist
 579          (item
 580           '(("g" "Google" "http://www.google.co.uk/search?q=%s")
 581             ("gd" "Google Directory"
 582              "http://www.google.com/search?cat=gwd/Top&q=%s")
 583             ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
 584             ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
 585             ("gi" "Images" "http://images.google.com/images?q=%s")
 586             ("rfc" "RFC"
 587              "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
 588             ("wp" "Wikipedia"
 589              "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
 590             ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
 591             ("nc-wiki" "nCipher wiki"
 592              "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
 593             ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
 594             ("lp" "Launchpad bug by number"
 595              "https://bugs.launchpad.net/bugs/%s")
 596             ("lppkg" "Launchpad bugs by package"
 597              "https://bugs.launchpad.net/%s")
 598             ("msdn" "MSDN"
 599              "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
 600             ("debbug" "Debian bug by number"
 601              "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
 602             ("debbugpkg" "Debian bugs by package"
 603              "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
 604             ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
 605        (add-to-list 'w3m-search-engine-alist
 606                     (list (cadr item) (caddr item) nil))
 607        (add-to-list 'w3m-uri-replace-alist
 608                     (list (concat "\\`" (car item) ":")
 609                           'w3m-search-uri-replace
 610                           (cadr item))))))
 611
 612 ;;;--------------------------------------------------------------------------
 613 ;;; Paragraph filling.
 614
 615 ;; Useful variables.
 616
 617 (defvar mdw-fill-prefix nil
 618   "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
 619 If there's no fill prefix currently set (by the `fill-prefix'
 620 variable) and there's a match from one of the regexps here, it
 621 gets used to set the fill-prefix for the current operation.
 622
 623 The variable is a list of items of the form `REGEXP . PREFIX'; if
 624 the REGEXP matches, the PREFIX is used to set the fill prefix.
 625 It in turn is a list of things:
 626
 627   STRING -- insert a literal string
 628   (match . N) -- insert the thing matched by bracketed subexpression N
 629   (pad . N) -- a string of whitespace the same width as subexpression N
 630   (expr . FORM) -- the result of evaluating FORM")
 631
 632 (make-variable-buffer-local 'mdw-fill-prefix)
 633
 634 (defvar mdw-hanging-indents
 635   (concat "\\(\\("
 636             "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
 637             "[ \t]+"
 638           "\\)?\\)")
 639   "*Standard regexp matching parts of a hanging indent.
 640 This is mainly useful in `auto-fill-mode'.")
 641
 642 ;; Setting things up.
 643
 644 (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
 645
 646 ;; Utility functions.
 647
 648 (defun mdw-tabify (s)
 649   "Tabify the string S.  This is a horrid hack."
 650   (save-excursion
 651     (save-match-data
 652       (let (start end)
 653         (beginning-of-line)
 654         (setq start (point-marker))
 655         (insert s "\n")
 656         (setq end (point-marker))
 657         (tabify start end)
 658         (setq s (buffer-substring start (1- end)))
 659         (delete-region start end)
 660         (set-marker start nil)
 661         (set-marker end nil)
 662         s))))
 663
 664 (defun mdw-examine-fill-prefixes (l)
 665   "Given a list of dynamic fill prefixes, pick one which matches
 666 context and return the static fill prefix to use.  Point must be
 667 at the start of a line, and match data must be saved."
 668   (cond ((not l) nil)
 669                ((looking-at (car (car l)))
 670                 (mdw-tabify (apply (function concat)
 671                                    (mapcar (function mdw-do-prefix-match)
 672                                            (cdr (car l))))))
 673                (t (mdw-examine-fill-prefixes (cdr l)))))
 674
 675 (defun mdw-maybe-car (p)
 676   "If P is a pair, return (car P), otherwise just return P."
 677   (if (consp p) (car p) p))
 678
 679 (defun mdw-padding (s)
 680   "Return a string the same width as S but made entirely from whitespace."
 681   (let* ((l (length s)) (i 0) (n (make-string l ? )))
 682     (while (< i l)
 683       (if (= 9 (aref s i))
 684           (aset n i 9))
 685       (setq i (1+ i)))
 686     n))
 687
 688 (defun mdw-do-prefix-match (m)
 689   "Expand a dynamic prefix match element.
 690 See `mdw-fill-prefix' for details."
 691   (cond ((not (consp m)) (format "%s" m))
 692            ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
 693            ((eq (car m) 'pad) (mdw-padding (match-string
 694                                             (mdw-maybe-car (cdr m)))))
 695            ((eq (car m) 'eval) (eval (cdr m)))
 696            (t "")))
 697
 698 (defun mdw-choose-dynamic-fill-prefix ()
 699   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
 700   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
 701            ((not mdw-fill-prefix) fill-prefix)
 702            (t (save-excursion
 703                 (beginning-of-line)
 704                 (save-match-data
 705                   (mdw-examine-fill-prefixes mdw-fill-prefix))))))
 706
 707 (defun do-auto-fill ()
 708   "Handle auto-filling, working out a dynamic fill prefix in the
 709 case where there isn't a sensible static one."
 710   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 711     (mdw-do-auto-fill)))
 712
 713 (defun mdw-fill-paragraph ()
 714   "Fill paragraph, getting a dynamic fill prefix."
 715   (interactive)
 716   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 717     (fill-paragraph nil)))
 718
 719 (defun mdw-standard-fill-prefix (rx &optional mat)
 720   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
 721 This is just a short-cut for setting the thing by hand, and by
 722 design it doesn't cope with anything approximating a complicated
 723 case."
 724   (setq mdw-fill-prefix
 725            `((,(concat rx mdw-hanging-indents)
 726               (match . 1)
 727               (pad . ,(or mat 2))))))
 728
 729 ;;;--------------------------------------------------------------------------
 730 ;;; Other common declarations.
 731
 732 ;; Common mode settings.
 733
 734 (defvar mdw-auto-indent t
 735   "Whether to indent automatically after a newline.")
 736
 737 (defun mdw-whitespace-mode (&optional arg)
 738   "Turn on/off whitespace mode, but don't highlight trailing space."
 739   (interactive "P")
 740   (when (and (boundp 'whitespace-style)
 741              (fboundp 'whitespace-mode))
 742     (let ((whitespace-style (remove 'trailing whitespace-style)))
 743       (whitespace-mode arg))
 744     (setq show-trailing-whitespace whitespace-mode)))
 745
 746 (defun mdw-misc-mode-config ()
 747   (and mdw-auto-indent
 748        (cond ((eq major-mode 'lisp-mode)
 749               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
 750              ((or (eq major-mode 'slime-repl-mode)
 751                   (eq major-mode 'asm-mode))
 752               nil)
 753              (t
 754               (local-set-key "\C-m" 'newline-and-indent))))
 755   (local-set-key [C-return] 'newline)
 756   (make-local-variable 'page-delimiter)
 757   (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
 758   (setq comment-column 40)
 759   (auto-fill-mode 1)
 760   (setq fill-column 77)
 761   (setq show-trailing-whitespace t)
 762   (mdw-whitespace-mode 1)
 763   (and (fboundp 'gtags-mode)
 764        (gtags-mode))
 765   (if (fboundp 'hs-minor-mode)
 766       (hs-minor-mode t)
 767     (outline-minor-mode t))
 768   (reveal-mode t)
 769   (trap (turn-on-font-lock)))
 770
 771 (defun mdw-post-config-mode-hack ()
 772   (mdw-whitespace-mode 1))
 773
 774 (eval-after-load 'gtags
 775   '(progn
 776      (dolist (key '([mouse-2] [mouse-3]))
 777        (define-key gtags-mode-map key nil))
 778      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
 779      (define-key gtags-select-mode-map [C-S-mouse-2]
 780        'gtags-select-tag-by-event)
 781      (dolist (map (list gtags-mode-map gtags-select-mode-map))
 782        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
 783
 784 ;; Backup file handling.
 785
 786 (defvar mdw-backup-disable-regexps nil
 787   "*List of regular expressions: if a file name matches any of
 788 these then the file is not backed up.")
 789
 790 (defun mdw-backup-enable-predicate (name)
 791   "[mdw]'s default backup predicate.
 792 Allows a backup if the standard predicate would allow it, and it
 793 doesn't match any of the regular expressions in
 794 `mdw-backup-disable-regexps'."
 795   (and (normal-backup-enable-predicate name)
 796        (let ((answer t) (list mdw-backup-disable-regexps))
 797          (save-match-data
 798            (while list
 799              (if (string-match (car list) name)
 800                  (setq answer nil))
 801              (setq list (cdr list)))
 802            answer))))
 803 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
 804
 805 ;; Frame cleanup.
 806
 807 (defun mdw-last-one-out-turn-off-the-lights (frame)
 808   "Disconnect from an X display if this was the last frame on that display."
 809   (let ((frame-display (frame-parameter frame 'display)))
 810     (when (and frame-display
 811                (eq window-system 'x)
 812                (not (some (lambda (fr)
 813                             (and (not (eq fr frame))
 814                                  (string= (frame-parameter fr 'display)
 815                                           frame-display)))
 816                           (frame-list))))
 817       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
 818 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
 819
 820 ;;;--------------------------------------------------------------------------
 821 ;;; General fontification.
 822
 823 (defmacro mdw-define-face (name &rest body)
 824   "Define a face, and make sure it's actually set as the definition."
 825   (declare (indent 1)
 826            (debug 0))
 827   `(progn
 828      (make-face ',name)
 829      (defvar ,name ',name)
 830      (put ',name 'face-defface-spec ',body)
 831      (face-spec-set ',name ',body nil)))
 832
 833 (mdw-define-face default
 834   (((type w32)) :family "courier new" :height 85)
 835   (((type x)) :family "6x13" :foundry "trad" :height 130)
 836   (((type color)) :foreground "white" :background "black")
 837   (t nil))
 838 (mdw-define-face fixed-pitch
 839   (((type w32)) :family "courier new" :height 85)
 840   (((type x)) :family "6x13" :foundry "trad" :height 130)
 841   (t :foreground "white" :background "black"))
 842 (if (>= emacs-major-version 23)
 843     (mdw-define-face variable-pitch
 844       (((type x)) :family "sans" :height 100))
 845   (mdw-define-face variable-pitch
 846     (((type x)) :family "helvetica" :height 90)))
 847 (mdw-define-face region
 848   (((type tty) (class color)) :background "blue")
 849   (((type tty) (class mono)) :inverse-video t)
 850   (t :background "grey30"))
 851 (mdw-define-face minibuffer-prompt
 852   (t :weight bold))
 853 (mdw-define-face mode-line
 854   (((class color)) :foreground "blue" :background "yellow"
 855                    :box (:line-width 1 :style released-button))
 856   (t :inverse-video t))
 857 (mdw-define-face mode-line-inactive
 858   (((class color)) :foreground "yellow" :background "blue"
 859                    :box (:line-width 1 :style released-button))
 860   (t :inverse-video t))
 861 (mdw-define-face scroll-bar
 862   (t :foreground "black" :background "lightgrey"))
 863 (mdw-define-face fringe
 864   (t :foreground "yellow"))
 865 (mdw-define-face show-paren-match
 866   (((class color)) :background "darkgreen")
 867   (t :underline t))
 868 (mdw-define-face show-paren-mismatch
 869   (((class color)) :background "red")
 870   (t :inverse-video t))
 871 (mdw-define-face highlight
 872   (((type x) (class color)) :background "DarkSeaGreen4")
 873   (((type tty) (class color)) :background "cyan")
 874   (t :inverse-video t))
 875
 876 (mdw-define-face holiday-face
 877   (t :background "red"))
 878 (mdw-define-face calendar-today-face
 879   (t :foreground "yellow" :weight bold))
 880
 881 (mdw-define-face comint-highlight-prompt
 882   (t :weight bold))
 883 (mdw-define-face comint-highlight-input
 884   (t nil))
 885
 886 (mdw-define-face dired-directory
 887   (t :foreground "cyan" :weight bold))
 888 (mdw-define-face dired-symlink
 889   (t :foreground "cyan"))
 890 (mdw-define-face dired-perm-write
 891   (t nil))
 892
 893 (mdw-define-face trailing-whitespace
 894   (((class color)) :background "red")
 895   (t :inverse-video t))
 896 (mdw-define-face mdw-punct-face
 897   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
 898 (mdw-define-face mdw-number-face
 899   (t :foreground "yellow"))
 900 (mdw-define-face font-lock-function-name-face
 901   (t :slant italic))
 902 (mdw-define-face font-lock-keyword-face
 903   (t :weight bold))
 904 (mdw-define-face font-lock-constant-face
 905   (t :slant italic))
 906 (mdw-define-face font-lock-builtin-face
 907   (t :weight bold))
 908 (mdw-define-face font-lock-type-face
 909   (t :weight bold :slant italic))
 910 (mdw-define-face font-lock-reference-face
 911   (t :weight bold))
 912 (mdw-define-face font-lock-variable-name-face
 913   (t :slant italic))
 914 (mdw-define-face font-lock-comment-delimiter-face
 915   (((class mono)) :weight bold)
 916   (((type tty) (class color)) :foreground "green")
 917   (t :slant italic :foreground "SeaGreen1"))
 918 (mdw-define-face font-lock-comment-face
 919   (((class mono)) :weight bold)
 920   (((type tty) (class color)) :foreground "green")
 921   (t :slant italic :foreground "SeaGreen1"))
 922 (mdw-define-face font-lock-string-face
 923   (((class mono)) :weight bold)
 924   (((class color)) :foreground "SkyBlue1"))
 925 (mdw-define-face message-separator
 926   (t :background "red" :foreground "white" :weight bold))
 927 (mdw-define-face message-cited-text
 928   (default :slant italic)
 929   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 930 (mdw-define-face message-header-cc
 931   (default :weight bold)
 932   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 933 (mdw-define-face message-header-newsgroups
 934   (default :weight bold)
 935   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 936 (mdw-define-face message-header-subject
 937   (default :weight bold)
 938   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 939 (mdw-define-face message-header-to
 940   (default :weight bold)
 941   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 942 (mdw-define-face message-header-xheader
 943   (default :weight bold)
 944   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 945 (mdw-define-face message-header-other
 946   (default :weight bold)
 947   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 948 (mdw-define-face message-header-name
 949   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 950 (mdw-define-face which-func
 951   (t nil))
 952
 953 (mdw-define-face diff-header
 954   (t nil))
 955 (mdw-define-face diff-index
 956   (t :weight bold))
 957 (mdw-define-face diff-file-header
 958   (t :weight bold))
 959 (mdw-define-face diff-hunk-header
 960   (t :foreground "SkyBlue1"))
 961 (mdw-define-face diff-function
 962   (t :foreground "SkyBlue1" :weight bold))
 963 (mdw-define-face diff-header
 964   (t :background "grey10"))
 965 (mdw-define-face diff-added
 966   (t :foreground "green"))
 967 (mdw-define-face diff-removed
 968   (t :foreground "red"))
 969 (mdw-define-face diff-context
 970   (t nil))
 971 (mdw-define-face diff-refine-change
 972   (((class color) (type x)) :background "RoyalBlue4")
 973   (t :underline t))
 974
 975 (mdw-define-face erc-input-face
 976   (t :foreground "red"))
 977
 978 (mdw-define-face woman-bold
 979   (t :weight bold))
 980 (mdw-define-face woman-italic
 981   (t :slant italic))
 982
 983 (mdw-define-face rst-level-1-face
 984   (t :foreground "SkyBlue1" :weight bold))
 985 (mdw-define-face rst-level-2-face
 986   (t :foreground "SeaGreen1" :weight bold))
 987 (mdw-define-face rst-level-3-face
 988   (t :weight bold))
 989 (mdw-define-face rst-level-4-face
 990   (t :slant italic))
 991 (mdw-define-face rst-level-5-face
 992   (t :underline t))
 993 (mdw-define-face rst-level-6-face
 994   ())
 995
 996 (mdw-define-face p4-depot-added-face
 997   (t :foreground "green"))
 998 (mdw-define-face p4-depot-branch-op-face
 999   (t :foreground "yellow"))
1000 (mdw-define-face p4-depot-deleted-face
1001   (t :foreground "red"))
1002 (mdw-define-face p4-depot-unmapped-face
1003   (t :foreground "SkyBlue1"))
1004 (mdw-define-face p4-diff-change-face
1005   (t :foreground "yellow"))
1006 (mdw-define-face p4-diff-del-face
1007   (t :foreground "red"))
1008 (mdw-define-face p4-diff-file-face
1009   (t :foreground "SkyBlue1"))
1010 (mdw-define-face p4-diff-head-face
1011   (t :background "grey10"))
1012 (mdw-define-face p4-diff-ins-face
1013   (t :foreground "green"))
1014
1015 (mdw-define-face whizzy-slice-face
1016   (t :background "grey10"))
1017 (mdw-define-face whizzy-error-face
1018   (t :background "darkred"))
1019
1020 ;; Ellipses used to indicate hidden text (and similar).
1021 (mdw-define-face mdw-ellipsis-face
1022   (((type tty)) :foreground "blue") (t :foreground "grey60"))
1023 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1024       (backslash (make-glyph-code ?\ 'mdw-ellipsis-face))
1025       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1026       (bar (make-glyph-code ?| mdw-ellipsis-face)))
1027   (set-display-table-slot standard-display-table 0 dollar)
1028   (set-display-table-slot standard-display-table 1 backslash)
1029   (set-display-table-slot standard-display-table 4
1030                           (vector dot dot dot))
1031   (set-display-table-slot standard-display-table 5 bar))
1032
1033 ;;;--------------------------------------------------------------------------
1034 ;;; C programming configuration.
1035
1036 ;; Linux kernel hacking.
1037
1038 (defvar linux-c-mode-hook)
1039
1040 (defun linux-c-mode ()
1041   (interactive)
1042   (c-mode)
1043   (setq major-mode 'linux-c-mode)
1044   (setq mode-name "Linux C")
1045   (run-hooks 'linux-c-mode-hook))
1046
1047 ;; Make C indentation nice.
1048
1049 (defun mdw-c-lineup-arglist (langelem)
1050   "Hack for DWIMmery in c-lineup-arglist."
1051   (if (save-excursion
1052         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1053       0
1054     (c-lineup-arglist langelem)))
1055
1056 (defun mdw-c-indent-extern-mumble (langelem)
1057   "Indent `extern \"...\" {' lines."
1058   (save-excursion
1059     (back-to-indentation)
1060     (if (looking-at
1061          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1062         c-basic-offset
1063       nil)))
1064
1065 (defun mdw-c-style ()
1066   (c-add-style "[mdw] C and C++ style"
1067                '((c-basic-offset . 2)
1068                  (comment-column . 40)
1069                  (c-class-key . "class")
1070                  (c-backslash-column . 72)
1071                  (c-offsets-alist
1072                   (substatement-open . (add 0 c-indent-one-line-block))
1073                   (defun-open . (add 0 c-indent-one-line-block))
1074                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
1075                   (topmost-intro . mdw-c-indent-extern-mumble)
1076                   (cpp-define-intro . 0)
1077                   (knr-argdecl . 0)
1078                   (inextern-lang . [0])
1079                   (label . 0)
1080                   (case-label . +)
1081                   (access-label . -)
1082                   (inclass . +)
1083                   (inline-open . ++)
1084                   (statement-cont . +)
1085                   (statement-case-intro . +)))
1086                t))
1087
1088 (defvar mdw-c-comment-fill-prefix
1089   `((,(concat "\\([ \t]*/?\\)"
1090               "\\(\*\\|//]\\)"
1091               "\\([ \t]*\\)"
1092               "\\([A-Za-z]+:[ \t]*\\)?"
1093               mdw-hanging-indents)
1094      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1095   "Fill prefix matching C comments (both kinds).")
1096
1097 (defun mdw-fontify-c-and-c++ ()
1098
1099   ;; Fiddle with some syntax codes.
1100   (modify-syntax-entry ?* ". 23")
1101   (modify-syntax-entry ?/ ". 124b")
1102   (modify-syntax-entry ?\n "> b")
1103
1104   ;; Other stuff.
1105   (mdw-c-style)
1106   (setq c-hanging-comment-ender-p nil)
1107   (setq c-backslash-column 72)
1108   (setq c-label-minimum-indentation 0)
1109   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1110
1111   ;; Now define things to be fontified.
1112   (make-local-variable 'font-lock-keywords)
1113   (let ((c-keywords
1114          (mdw-regexps "and"             ;C++
1115                       "and_eq"          ;C++
1116                       "asm"             ;K&R, GCC
1117                       "auto"            ;K&R, C89
1118                       "bitand"          ;C++
1119                       "bitor"           ;C++
1120                       "bool"            ;C++, C9X macro
1121                       "break"           ;K&R, C89
1122                       "case"            ;K&R, C89
1123                       "catch"           ;C++
1124                       "char"            ;K&R, C89
1125                       "class"           ;C++
1126                       "complex"         ;C9X macro, C++ template type
1127                       "compl"           ;C++
1128                       "const"           ;C89
1129                       "const_cast"      ;C++
1130                       "continue"        ;K&R, C89
1131                       "defined"         ;C89 preprocessor
1132                       "default"         ;K&R, C89
1133                       "delete"          ;C++
1134                       "do"              ;K&R, C89
1135                       "double"          ;K&R, C89
1136                       "dynamic_cast"    ;C++
1137                       "else"            ;K&R, C89
1138                       ;; "entry"        ;K&R -- never used
1139                       "enum"            ;C89
1140                       "explicit"        ;C++
1141                       "export"          ;C++
1142                       "extern"          ;K&R, C89
1143                       "false"           ;C++, C9X macro
1144                       "float"           ;K&R, C89
1145                       "for"             ;K&R, C89
1146                       ;; "fortran"      ;K&R
1147                       "friend"          ;C++
1148                       "goto"            ;K&R, C89
1149                       "if"              ;K&R, C89
1150                       "imaginary"       ;C9X macro
1151                       "inline"          ;C++, C9X, GCC
1152                       "int"             ;K&R, C89
1153                       "long"            ;K&R, C89
1154                       "mutable"         ;C++
1155                       "namespace"       ;C++
1156                       "new"             ;C++
1157                       "operator"        ;C++
1158                       "or"              ;C++
1159                       "or_eq"           ;C++
1160                       "private"         ;C++
1161                       "protected"       ;C++
1162                       "public"          ;C++
1163                       "register"        ;K&R, C89
1164                       "reinterpret_cast" ;C++
1165                       "restrict"         ;C9X
1166                       "return"           ;K&R, C89
1167                       "short"            ;K&R, C89
1168                       "signed"           ;C89
1169                       "sizeof"           ;K&R, C89
1170                       "static"           ;K&R, C89
1171                       "static_cast"      ;C++
1172                       "struct"           ;K&R, C89
1173                       "switch"           ;K&R, C89
1174                       "template"         ;C++
1175                       "this"             ;C++
1176                       "throw"            ;C++
1177                       "true"             ;C++, C9X macro
1178                       "try"              ;C++
1179                       "this"             ;C++
1180                       "typedef"          ;C89
1181                       "typeid"           ;C++
1182                       "typeof"           ;GCC
1183                       "typename"         ;C++
1184                       "union"            ;K&R, C89
1185                       "unsigned"         ;K&R, C89
1186                       "using"            ;C++
1187                       "virtual"          ;C++
1188                       "void"             ;C89
1189                       "volatile"         ;C89
1190                       "wchar_t"          ;C++, C89 library type
1191                       "while"            ;K&R, C89
1192                       "xor"              ;C++
1193                       "xor_eq"           ;C++
1194                       "_Bool"            ;C9X
1195                       "_Complex"         ;C9X
1196                       "_Imaginary"       ;C9X
1197                       "_Pragma"          ;C9X preprocessor
1198                       "__alignof__"      ;GCC
1199                       "__asm__"          ;GCC
1200                       "__attribute__"    ;GCC
1201                       "__complex__"      ;GCC
1202                       "__const__"        ;GCC
1203                       "__extension__"    ;GCC
1204                       "__imag__"         ;GCC
1205                       "__inline__"       ;GCC
1206                       "__label__"        ;GCC
1207                       "__real__"         ;GCC
1208                       "__signed__"       ;GCC
1209                       "__typeof__"       ;GCC
1210                       "__volatile__"     ;GCC
1211                       ))
1212         (preprocessor-keywords
1213          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1214                       "ident" "if" "ifdef" "ifndef" "import" "include"
1215                       "line" "pragma" "unassert" "undef" "warning"))
1216         (objc-keywords
1217          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1218                       "interface" "private" "protected" "protocol" "public"
1219                       "selector")))
1220
1221     (setq font-lock-keywords
1222           (list
1223
1224            ;; Fontify include files as strings.
1225            (list (concat "^[ \t]*\\#[ \t]*"
1226                          "\\(include\\|import\\)"
1227                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1228                  '(2 font-lock-string-face))
1229
1230            ;; Preprocessor directives are `references'?.
1231            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1232                          preprocessor-keywords
1233                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1234                  '(1 font-lock-keyword-face))
1235
1236            ;; Handle the keywords defined above.
1237            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1238                  '(0 font-lock-keyword-face))
1239
1240            (list (concat "\\<\\(" c-keywords "\\)\\>")
1241                  '(0 font-lock-keyword-face))
1242
1243            ;; Handle numbers too.
1244            ;;
1245            ;; This looks strange, I know.  It corresponds to the
1246            ;; preprocessor's idea of what a number looks like, rather than
1247            ;; anything sensible.
1248            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1249                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1250                  '(0 mdw-number-face))
1251
1252            ;; And anything else is punctuation.
1253            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1254                  '(0 mdw-punct-face))))
1255
1256     (mdw-post-config-mode-hack)))
1257
1258 ;;;--------------------------------------------------------------------------
1259 ;;; AP calc mode.
1260
1261 (defun apcalc-mode ()
1262   (interactive)
1263   (c-mode)
1264   (setq major-mode 'apcalc-mode)
1265   (setq mode-name "AP Calc")
1266   (run-hooks 'apcalc-mode-hook))
1267
1268 (defun mdw-fontify-apcalc ()
1269
1270   ;; Fiddle with some syntax codes.
1271   (modify-syntax-entry ?* ". 23")
1272   (modify-syntax-entry ?/ ". 14")
1273
1274   ;; Other stuff.
1275   (mdw-c-style)
1276   (setq c-hanging-comment-ender-p nil)
1277   (setq c-backslash-column 72)
1278   (setq comment-start "/* ")
1279   (setq comment-end " */")
1280   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1281
1282   ;; Now define things to be fontified.
1283   (make-local-variable 'font-lock-keywords)
1284   (let ((c-keywords
1285          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1286                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1287                       "local" "mat" "obj" "print" "quit" "read" "return"
1288                       "show" "static" "switch" "while" "write")))
1289
1290     (setq font-lock-keywords
1291           (list
1292
1293            ;; Handle the keywords defined above.
1294            (list (concat "\\<\\(" c-keywords "\\)\\>")
1295                  '(0 font-lock-keyword-face))
1296
1297            ;; Handle numbers too.
1298            ;;
1299            ;; This looks strange, I know.  It corresponds to the
1300            ;; preprocessor's idea of what a number looks like, rather than
1301            ;; anything sensible.
1302            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1303                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1304                  '(0 mdw-number-face))
1305
1306            ;; And anything else is punctuation.
1307            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1308                  '(0 mdw-punct-face)))))
1309
1310   (mdw-post-config-mode-hack))
1311
1312 ;;;--------------------------------------------------------------------------
1313 ;;; Java programming configuration.
1314
1315 ;; Make indentation nice.
1316
1317 (defun mdw-java-style ()
1318   (c-add-style "[mdw] Java style"
1319                '((c-basic-offset . 2)
1320                  (c-offsets-alist (substatement-open . 0)
1321                                   (label . +)
1322                                   (case-label . +)
1323                                   (access-label . 0)
1324                                   (inclass . +)
1325                                   (statement-case-intro . +)))
1326                t))
1327
1328 ;; Declare Java fontification style.
1329
1330 (defun mdw-fontify-java ()
1331
1332   ;; Other stuff.
1333   (mdw-java-style)
1334   (setq c-hanging-comment-ender-p nil)
1335   (setq c-backslash-column 72)
1336   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1337
1338   ;; Now define things to be fontified.
1339   (make-local-variable 'font-lock-keywords)
1340   (let ((java-keywords
1341          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1342                       "char" "class" "const" "continue" "default" "do"
1343                       "double" "else" "extends" "final" "finally" "float"
1344                       "for" "goto" "if" "implements" "import" "instanceof"
1345                       "int" "interface" "long" "native" "new" "package"
1346                       "private" "protected" "public" "return" "short"
1347                       "static" "super" "switch" "synchronized" "this"
1348                       "throw" "throws" "transient" "try" "void" "volatile"
1349                       "while"
1350
1351                       "false" "null" "true")))
1352
1353     (setq font-lock-keywords
1354           (list
1355
1356            ;; Handle the keywords defined above.
1357            (list (concat "\\<\\(" java-keywords "\\)\\>")
1358                  '(0 font-lock-keyword-face))
1359
1360            ;; Handle numbers too.
1361            ;;
1362            ;; The following isn't quite right, but it's close enough.
1363            (list (concat "\\<\\("
1364                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1365                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1366                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1367                          "[lLfFdD]?")
1368                  '(0 mdw-number-face))
1369
1370            ;; And anything else is punctuation.
1371            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1372                  '(0 mdw-punct-face)))))
1373
1374   (mdw-post-config-mode-hack))
1375
1376 ;;;--------------------------------------------------------------------------
1377 ;;; Javascript programming configuration.
1378
1379 (defun mdw-javascript-style ()
1380   (setq js-indent-level 2)
1381   (setq js-expr-indent-offset 0))
1382
1383 (defun mdw-fontify-javascript ()
1384
1385   ;; Other stuff.
1386   (mdw-javascript-style)
1387   (setq js-auto-indent-flag t)
1388
1389   ;; Now define things to be fontified.
1390   (make-local-variable 'font-lock-keywords)
1391   (let ((javascript-keywords
1392          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1393                       "char" "class" "const" "continue" "debugger" "default"
1394                       "delete" "do" "double" "else" "enum" "export" "extends"
1395                       "final" "finally" "float" "for" "function" "goto" "if"
1396                       "implements" "import" "in" "instanceof" "int"
1397                       "interface" "let" "long" "native" "new" "package"
1398                       "private" "protected" "public" "return" "short"
1399                       "static" "super" "switch" "synchronized" "throw"
1400                       "throws" "transient" "try" "typeof" "var" "void"
1401                       "volatile" "while" "with" "yield"
1402
1403                       "boolean" "byte" "char" "double" "float" "int" "long"
1404                       "short" "void"))
1405         (javascript-constants
1406          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1407                       "arguments" "this")))
1408
1409     (setq font-lock-keywords
1410           (list
1411
1412            ;; Handle the keywords defined above.
1413            (list (concat "\\<\\(" javascript-keywords "\\)\\>")
1414                  '(0 font-lock-keyword-face))
1415
1416            ;; Handle the predefined constants defined above.
1417            (list (concat "\\<\\(" javascript-constants "\\)\\>")
1418                  '(0 font-lock-variable-name-face))
1419
1420            ;; Handle numbers too.
1421            ;;
1422            ;; The following isn't quite right, but it's close enough.
1423            (list (concat "\\<\\("
1424                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1425                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1426                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1427                          "[lLfFdD]?")
1428                  '(0 mdw-number-face))
1429
1430            ;; And anything else is punctuation.
1431            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1432                  '(0 mdw-punct-face)))))
1433
1434   (mdw-post-config-mode-hack))
1435
1436 ;;;--------------------------------------------------------------------------
1437 ;;; C# programming configuration.
1438
1439 ;; Make indentation nice.
1440
1441 (defun mdw-csharp-style ()
1442   (c-add-style "[mdw] C# style"
1443                '((c-basic-offset . 2)
1444                  (c-offsets-alist (substatement-open . 0)
1445                                   (label . 0)
1446                                   (case-label . +)
1447                                   (access-label . 0)
1448                                   (inclass . +)
1449                                   (statement-case-intro . +)))
1450                t))
1451
1452 ;; Declare C# fontification style.
1453
1454 (defun mdw-fontify-csharp ()
1455
1456   ;; Other stuff.
1457   (mdw-csharp-style)
1458   (setq c-hanging-comment-ender-p nil)
1459   (setq c-backslash-column 72)
1460   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1461
1462   ;; Now define things to be fontified.
1463   (make-local-variable 'font-lock-keywords)
1464   (let ((csharp-keywords
1465          (mdw-regexps "abstract" "as" "base" "bool" "break"
1466                       "byte" "case" "catch" "char" "checked"
1467                       "class" "const" "continue" "decimal" "default"
1468                       "delegate" "do" "double" "else" "enum"
1469                       "event" "explicit" "extern" "false" "finally"
1470                       "fixed" "float" "for" "foreach" "goto"
1471                       "if" "implicit" "in" "int" "interface"
1472                       "internal" "is" "lock" "long" "namespace"
1473                       "new" "null" "object" "operator" "out"
1474                       "override" "params" "private" "protected" "public"
1475                       "readonly" "ref" "return" "sbyte" "sealed"
1476                       "short" "sizeof" "stackalloc" "static" "string"
1477                       "struct" "switch" "this" "throw" "true"
1478                       "try" "typeof" "uint" "ulong" "unchecked"
1479                       "unsafe" "ushort" "using" "virtual" "void"
1480                       "volatile" "while" "yield")))
1481
1482     (setq font-lock-keywords
1483           (list
1484
1485            ;; Handle the keywords defined above.
1486            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1487                  '(0 font-lock-keyword-face))
1488
1489            ;; Handle numbers too.
1490            ;;
1491            ;; The following isn't quite right, but it's close enough.
1492            (list (concat "\\<\\("
1493                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1494                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1495                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1496                          "[lLfFdD]?")
1497                  '(0 mdw-number-face))
1498
1499            ;; And anything else is punctuation.
1500            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1501                  '(0 mdw-punct-face)))))
1502
1503   (mdw-post-config-mode-hack))
1504
1505 (define-derived-mode csharp-mode java-mode "C#"
1506   "Major mode for editing C# code.")
1507
1508 ;;;--------------------------------------------------------------------------
1509 ;;; Go programming configuration.
1510
1511 (defun mdw-fontify-go ()
1512
1513   (make-local-variable 'font-lock-keywords)
1514   (let ((go-keywords
1515          (mdw-regexps "break" "case" "chan" "const" "continue"
1516                       "default" "defer" "else" "fallthrough" "for"
1517                       "func" "go" "goto" "if" "import"
1518                       "interface" "map" "package" "range" "return"
1519                       "select" "struct" "switch" "type" "var")))
1520
1521     (setq font-lock-keywords
1522           (list
1523
1524            ;; Handle the keywords defined above.
1525            (list (concat "\\<\\(" go-keywords "\\)\\>")
1526                  '(0 font-lock-keyword-face))
1527
1528            ;; Handle numbers too.
1529            ;;
1530            ;; The following isn't quite right, but it's close enough.
1531            (list (concat "\\<\\("
1532                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1533                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1534                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1535                  '(0 mdw-number-face))
1536
1537            ;; And anything else is punctuation.
1538            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1539                  '(0 mdw-punct-face)))))
1540
1541   (mdw-post-config-mode-hack))
1542
1543 ;;;--------------------------------------------------------------------------
1544 ;;; Awk programming configuration.
1545
1546 ;; Make Awk indentation nice.
1547
1548 (defun mdw-awk-style ()
1549   (c-add-style "[mdw] Awk style"
1550                '((c-basic-offset . 2)
1551                  (c-offsets-alist (substatement-open . 0)
1552                                   (statement-cont . 0)
1553                                   (statement-case-intro . +)))
1554                t))
1555
1556 ;; Declare Awk fontification style.
1557
1558 (defun mdw-fontify-awk ()
1559
1560   ;; Miscellaneous fiddling.
1561   (mdw-awk-style)
1562   (setq c-backslash-column 72)
1563   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1564
1565   ;; Now define things to be fontified.
1566   (make-local-variable 'font-lock-keywords)
1567   (let ((c-keywords
1568          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1569                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1570                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1571                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1572                       "atan2" "break" "close" "continue" "cos" "delete"
1573                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1574                       "function" "gensub" "getline" "gsub" "if" "in"
1575                       "index" "int" "length" "log" "match" "next" "rand"
1576                       "return" "print" "printf" "sin" "split" "sprintf"
1577                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1578                       "systime" "tolower" "toupper" "while")))
1579
1580     (setq font-lock-keywords
1581           (list
1582
1583            ;; Handle the keywords defined above.
1584            (list (concat "\\<\\(" c-keywords "\\)\\>")
1585                  '(0 font-lock-keyword-face))
1586
1587            ;; Handle numbers too.
1588            ;;
1589            ;; The following isn't quite right, but it's close enough.
1590            (list (concat "\\<\\("
1591                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1592                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1593                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1594                          "[uUlL]*")
1595                  '(0 mdw-number-face))
1596
1597            ;; And anything else is punctuation.
1598            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1599                  '(0 mdw-punct-face)))))
1600
1601   (mdw-post-config-mode-hack))
1602
1603 ;;;--------------------------------------------------------------------------
1604 ;;; Perl programming style.
1605
1606 ;; Perl indentation style.
1607
1608 (fset 'perl-mode 'cperl-mode)
1609 (setq cperl-indent-level 2)
1610 (setq cperl-continued-statement-offset 2)
1611 (setq cperl-continued-brace-offset 0)
1612 (setq cperl-brace-offset -2)
1613 (setq cperl-brace-imaginary-offset 0)
1614 (setq cperl-label-offset 0)
1615
1616 ;; Define perl fontification style.
1617
1618 (defun mdw-fontify-perl ()
1619
1620   ;; Miscellaneous fiddling.
1621   (modify-syntax-entry ?$ "\\")
1622   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1623   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1624
1625   ;; Now define fontification things.
1626   (make-local-variable 'font-lock-keywords)
1627   (let ((perl-keywords
1628          (mdw-regexps "and" "break" "cmp" "continue" "do" "else" "elsif" "eq"
1629                       "for" "foreach" "ge" "given" "gt" "goto" "if"
1630                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1631                       "our" "package" "redo" "require" "return" "sub"
1632                       "undef" "unless" "until" "use" "when" "while")))
1633
1634     (setq font-lock-keywords
1635           (list
1636
1637            ;; Set up the keywords defined above.
1638            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1639                  '(0 font-lock-keyword-face))
1640
1641            ;; At least numbers are simpler than C.
1642            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1643                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1644                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1645                  '(0 mdw-number-face))
1646
1647            ;; And anything else is punctuation.
1648            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1649                  '(0 mdw-punct-face)))))
1650
1651   (mdw-post-config-mode-hack))
1652
1653 (defun perl-number-tests (&optional arg)
1654   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1655 strip numbers instead."
1656   (interactive "P")
1657   (save-excursion
1658     (goto-char (point-min))
1659     (let ((i 0) (fmt (if arg "" " %4d")))
1660       (while (search-forward "#t" nil t)
1661         (delete-region (point) (line-end-position))
1662         (setq i (1+ i))
1663         (insert (format fmt i)))
1664       (goto-char (point-min))
1665       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1666           (replace-match (format "\\1%d" i))))))
1667
1668 ;;;--------------------------------------------------------------------------
1669 ;;; Python programming style.
1670
1671 (defun mdw-fontify-pythonic (keywords)
1672
1673   ;; Miscellaneous fiddling.
1674   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1675   (setq indent-tabs-mode nil)
1676
1677   ;; Now define fontification things.
1678   (make-local-variable 'font-lock-keywords)
1679   (setq font-lock-keywords
1680         (list
1681
1682          ;; Set up the keywords defined above.
1683          (list (concat "\\_<\\(" keywords "\\)\\_>")
1684                '(0 font-lock-keyword-face))
1685
1686          ;; At least numbers are simpler than C.
1687          (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1688                        "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1689                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1690                '(0 mdw-number-face))
1691
1692          ;; And anything else is punctuation.
1693          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1694                '(0 mdw-punct-face))))
1695
1696   (mdw-post-config-mode-hack))
1697
1698 ;; Define Python fontification styles.
1699
1700 (defun mdw-fontify-python ()
1701   (mdw-fontify-pythonic
1702    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1703                 "del" "elif" "else" "except" "exec" "finally" "for"
1704                 "from" "global" "if" "import" "in" "is" "lambda"
1705                 "not" "or" "pass" "print" "raise" "return" "try"
1706                 "while" "with" "yield")))
1707
1708 (defun mdw-fontify-pyrex ()
1709   (mdw-fontify-pythonic
1710    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
1711                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
1712                 "extern" "finally" "for" "from" "global" "if"
1713                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
1714                 "raise" "return" "struct" "try" "while" "with"
1715                 "yield")))
1716
1717 ;;;--------------------------------------------------------------------------
1718 ;;; Icon programming style.
1719
1720 ;; Icon indentation style.
1721
1722 (setq icon-brace-offset 0
1723       icon-continued-brace-offset 0
1724       icon-continued-statement-offset 2
1725       icon-indent-level 2)
1726
1727 ;; Define Icon fontification style.
1728
1729 (defun mdw-fontify-icon ()
1730
1731   ;; Miscellaneous fiddling.
1732   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1733
1734   ;; Now define fontification things.
1735   (make-local-variable 'font-lock-keywords)
1736   (let ((icon-keywords
1737          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1738                       "end" "every" "fail" "global" "if" "initial"
1739                       "invocable" "link" "local" "next" "not" "of"
1740                       "procedure" "record" "repeat" "return" "static"
1741                       "suspend" "then" "to" "until" "while"))
1742         (preprocessor-keywords
1743          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1744                       "include" "line" "undef")))
1745     (setq font-lock-keywords
1746           (list
1747
1748            ;; Set up the keywords defined above.
1749            (list (concat "\\<\\(" icon-keywords "\\)\\>")
1750                  '(0 font-lock-keyword-face))
1751
1752            ;; The things that Icon calls keywords.
1753            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1754
1755            ;; At least numbers are simpler than C.
1756            (list (concat "\\<[0-9]+"
1757                          "\\([rR][0-9a-zA-Z]+\\|"
1758                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1759                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1760                  '(0 mdw-number-face))
1761
1762            ;; Preprocessor.
1763            (list (concat "^[ \t]*$[ \t]*\\<\\("
1764                          preprocessor-keywords
1765                          "\\)\\>")
1766                  '(0 font-lock-keyword-face))
1767
1768            ;; And anything else is punctuation.
1769            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1770                  '(0 mdw-punct-face)))))
1771
1772   (mdw-post-config-mode-hack))
1773
1774 ;;;--------------------------------------------------------------------------
1775 ;;; ARM assembler programming configuration.
1776
1777 ;; There doesn't appear to be an Emacs mode for this yet.
1778 ;;
1779 ;; Better do something about that, I suppose.
1780
1781 (defvar arm-assembler-mode-map nil)
1782 (defvar arm-assembler-abbrev-table nil)
1783 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1784
1785 (or arm-assembler-mode-map
1786     (progn
1787       (setq arm-assembler-mode-map (make-sparse-keymap))
1788       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1789       (define-key arm-assembler-mode-map [C-return] 'newline)
1790       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1791
1792 (defun arm-assembler-mode ()
1793   "Major mode for ARM assembler programs"
1794   (interactive)
1795
1796   ;; Do standard major mode things.
1797   (kill-all-local-variables)
1798   (use-local-map arm-assembler-mode-map)
1799   (setq local-abbrev-table arm-assembler-abbrev-table)
1800   (setq major-mode 'arm-assembler-mode)
1801   (setq mode-name "ARM assembler")
1802
1803   ;; Set up syntax table.
1804   (set-syntax-table arm-assembler-mode-syntax-table)
1805   (modify-syntax-entry ?;   ; Nasty hack
1806                        "<" arm-assembler-mode-syntax-table)
1807   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1808   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1809   (modify-syntax-entry ?' "\"'" arm-assembler-mode-syntax-table)
1810
1811   (make-local-variable 'comment-start)
1812   (setq comment-start ";")
1813   (make-local-variable 'comment-end)
1814   (setq comment-end "")
1815   (make-local-variable 'comment-column)
1816   (setq comment-column 48)
1817   (make-local-variable 'comment-start-skip)
1818   (setq comment-start-skip ";+[ \t]*")
1819
1820   ;; Play with indentation.
1821   (make-local-variable 'indent-line-function)
1822   (setq indent-line-function 'indent-relative-maybe)
1823
1824   ;; Set fill prefix.
1825   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1826
1827   ;; Fiddle with fontification.
1828   (make-local-variable 'font-lock-keywords)
1829   (setq font-lock-keywords
1830         (list
1831
1832          ;; Handle numbers too.
1833          ;;
1834          ;; The following isn't quite right, but it's close enough.
1835          (list (concat "\\("
1836                        "&[0-9a-fA-F]+\\|"
1837                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1838                        "\\)")
1839                '(0 mdw-number-face))
1840
1841          ;; Do something about operators.
1842          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1843                '(1 font-lock-keyword-face)
1844                '(2 font-lock-string-face))
1845          (list ":[a-zA-Z]+:"
1846                '(0 font-lock-keyword-face))
1847
1848          ;; Do menemonics and directives.
1849          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1850                '(1 font-lock-keyword-face))
1851
1852          ;; And anything else is punctuation.
1853          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1854                '(0 mdw-punct-face)))
1855
1856   (mdw-post-config-mode-hack))
1857   (run-hooks 'arm-assembler-mode-hook))
1858
1859 ;;;--------------------------------------------------------------------------
1860 ;;; Assembler mode.
1861
1862 (defun mdw-fontify-asm ()
1863   (modify-syntax-entry ?' "\"")
1864   (modify-syntax-entry ?. "w")
1865   (setf fill-prefix nil)
1866   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1867
1868 ;;;--------------------------------------------------------------------------
1869 ;;; TCL configuration.
1870
1871 (defun mdw-fontify-tcl ()
1872   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1873   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1874   (make-local-variable 'font-lock-keywords)
1875   (setq font-lock-keywords
1876         (list
1877          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1878                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1879                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1880                '(0 mdw-number-face))
1881          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1882                '(0 mdw-punct-face))))
1883   (mdw-post-config-mode-hack))
1884
1885 ;;;--------------------------------------------------------------------------
1886 ;;; REXX configuration.
1887
1888 (defun mdw-rexx-electric-* ()
1889   (interactive)
1890   (insert ?*)
1891   (rexx-indent-line))
1892
1893 (defun mdw-rexx-indent-newline-indent ()
1894   (interactive)
1895   (rexx-indent-line)
1896   (if abbrev-mode (expand-abbrev))
1897   (newline-and-indent))
1898
1899 (defun mdw-fontify-rexx ()
1900
1901   ;; Various bits of fiddling.
1902   (setq mdw-auto-indent nil)
1903   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1904   (local-set-key [?*] 'mdw-rexx-electric-*)
1905   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1906           '(?! ?? ?# ?@ ?$))
1907   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1908
1909   ;; Set up keywords and things for fontification.
1910   (make-local-variable 'font-lock-keywords-case-fold-search)
1911   (setq font-lock-keywords-case-fold-search t)
1912
1913   (setq rexx-indent 2)
1914   (setq rexx-end-indent rexx-indent)
1915   (setq rexx-cont-indent rexx-indent)
1916
1917   (make-local-variable 'font-lock-keywords)
1918   (let ((rexx-keywords
1919          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1920                       "else" "end" "engineering" "exit" "expose" "for"
1921                       "forever" "form" "fuzz" "if" "interpret" "iterate"
1922                       "leave" "linein" "name" "nop" "numeric" "off" "on"
1923                       "options" "otherwise" "parse" "procedure" "pull"
1924                       "push" "queue" "return" "say" "select" "signal"
1925                       "scientific" "source" "then" "trace" "to" "until"
1926                       "upper" "value" "var" "version" "when" "while"
1927                       "with"
1928
1929                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1930                       "center" "center" "charin" "charout" "chars"
1931                       "compare" "condition" "copies" "c2d" "c2x"
1932                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
1933                       "errortext" "format" "fuzz" "insert" "lastpos"
1934                       "left" "length" "lineout" "lines" "max" "min"
1935                       "overlay" "pos" "queued" "random" "reverse" "right"
1936                       "sign" "sourceline" "space" "stream" "strip"
1937                       "substr" "subword" "symbol" "time" "translate"
1938                       "trunc" "value" "verify" "word" "wordindex"
1939                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1940                       "x2d")))
1941
1942     (setq font-lock-keywords
1943           (list
1944
1945            ;; Set up the keywords defined above.
1946            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1947                  '(0 font-lock-keyword-face))
1948
1949            ;; Fontify all symbols the same way.
1950            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1951                          "[A-Za-z0-9.!?_#@$]+\\)")
1952                  '(0 font-lock-variable-name-face))
1953
1954            ;; And everything else is punctuation.
1955            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1956                  '(0 mdw-punct-face)))))
1957
1958   (mdw-post-config-mode-hack))
1959
1960 ;;;--------------------------------------------------------------------------
1961 ;;; Standard ML programming style.
1962
1963 (defun mdw-fontify-sml ()
1964
1965   ;; Make underscore an honorary letter.
1966   (modify-syntax-entry ?' "w")
1967
1968   ;; Set fill prefix.
1969   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1970
1971   ;; Now define fontification things.
1972   (make-local-variable 'font-lock-keywords)
1973   (let ((sml-keywords
1974          (mdw-regexps "abstype" "and" "andalso" "as"
1975                       "case"
1976                       "datatype" "do"
1977                       "else" "end" "eqtype" "exception"
1978                       "fn" "fun" "functor"
1979                       "handle"
1980                       "if" "in" "include" "infix" "infixr"
1981                       "let" "local"
1982                       "nonfix"
1983                       "of" "op" "open" "orelse"
1984                       "raise" "rec"
1985                       "sharing" "sig" "signature" "struct" "structure"
1986                       "then" "type"
1987                       "val"
1988                       "where" "while" "with" "withtype")))
1989
1990     (setq font-lock-keywords
1991           (list
1992
1993            ;; Set up the keywords defined above.
1994            (list (concat "\\<\\(" sml-keywords "\\)\\>")
1995                  '(0 font-lock-keyword-face))
1996
1997            ;; At least numbers are simpler than C.
1998            (list (concat "\\<\\(\\~\\|\\)"
1999                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
2000                                    "[wW][0-9]+\\)\\|"
2001                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2002                                          "\\([eE]\\(\\~\\|\\)"
2003                                                 "[0-9]+\\|\\)\\)\\)")
2004                  '(0 mdw-number-face))
2005
2006            ;; And anything else is punctuation.
2007            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2008                  '(0 mdw-punct-face)))))
2009
2010   (mdw-post-config-mode-hack))
2011
2012 ;;;--------------------------------------------------------------------------
2013 ;;; Haskell configuration.
2014
2015 (defun mdw-fontify-haskell ()
2016
2017   ;; Fiddle with syntax table to get comments right.
2018   (modify-syntax-entry ?' "\"")
2019   (modify-syntax-entry ?- ". 123")
2020   (modify-syntax-entry ?{ ". 1b")
2021   (modify-syntax-entry ?} ". 4b")
2022   (modify-syntax-entry ?\n ">")
2023
2024   ;; Set fill prefix.
2025   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2026
2027   ;; Fiddle with fontification.
2028   (make-local-variable 'font-lock-keywords)
2029   (let ((haskell-keywords
2030          (mdw-regexps "as" "case" "ccall" "class" "data" "default"
2031                       "deriving" "do" "else" "foreign" "hiding" "if"
2032                       "import" "in" "infix" "infixl" "infixr" "instance"
2033                       "let" "module" "newtype" "of" "qualified" "safe"
2034                       "stdcall" "then" "type" "unsafe" "where")))
2035
2036     (setq font-lock-keywords
2037           (list
2038            (list "--.*$"
2039                  '(0 font-lock-comment-face))
2040            (list (concat "\\<\\(" haskell-keywords "\\)\\>")
2041                  '(0 font-lock-keyword-face))
2042            (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2043                          "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
2044                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2045                  '(0 mdw-number-face))
2046            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2047                  '(0 mdw-punct-face)))))
2048
2049   (mdw-post-config-mode-hack))
2050
2051 ;;;--------------------------------------------------------------------------
2052 ;;; Erlang configuration.
2053
2054 (setq erlang-electric-commands nil)
2055
2056 (defun mdw-fontify-erlang ()
2057
2058   ;; Set fill prefix.
2059   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2060
2061   ;; Fiddle with fontification.
2062   (make-local-variable 'font-lock-keywords)
2063   (let ((erlang-keywords
2064          (mdw-regexps "after" "and" "andalso"
2065                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2066                       "case" "catch" "cond"
2067                       "div" "end" "fun" "if" "let" "not"
2068                       "of" "or" "orelse"
2069                       "query" "receive" "rem" "try" "when" "xor")))
2070
2071     (setq font-lock-keywords
2072           (list
2073            (list "%.*$"
2074                  '(0 font-lock-comment-face))
2075            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2076                  '(0 font-lock-keyword-face))
2077            (list (concat "^-\\sw+\\>")
2078                  '(0 font-lock-keyword-face))
2079            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2080                  '(0 mdw-number-face))
2081            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2082                  '(0 mdw-punct-face)))))
2083
2084   (mdw-post-config-mode-hack))
2085
2086 ;;;--------------------------------------------------------------------------
2087 ;;; Texinfo configuration.
2088
2089 (defun mdw-fontify-texinfo ()
2090
2091   ;; Set fill prefix.
2092   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2093
2094   ;; Real fontification things.
2095   (make-local-variable 'font-lock-keywords)
2096   (setq font-lock-keywords
2097         (list
2098
2099          ;; Environment names are keywords.
2100          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
2101                '(2 font-lock-keyword-face))
2102
2103          ;; Unmark escaped magic characters.
2104          (list "\\(@\\)\\([@{}]\\)"
2105                '(1 font-lock-keyword-face)
2106                '(2 font-lock-variable-name-face))
2107
2108          ;; Make sure we get comments properly.
2109          (list "@c\\(\\|omment\\)\\( .*\\)?$"
2110                '(0 font-lock-comment-face))
2111
2112          ;; Command names are keywords.
2113          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2114                '(0 font-lock-keyword-face))
2115
2116          ;; Fontify TeX special characters as punctuation.
2117          (list "[{}]+"
2118                '(0 mdw-punct-face))))
2119
2120   (mdw-post-config-mode-hack))
2121
2122 ;;;--------------------------------------------------------------------------
2123 ;;; TeX and LaTeX configuration.
2124
2125 (defun mdw-fontify-tex ()
2126   (setq ispell-parser 'tex)
2127   (turn-on-reftex)
2128
2129   ;; Don't make maths into a string.
2130   (modify-syntax-entry ?$ ".")
2131   (modify-syntax-entry ?$ "." font-lock-syntax-table)
2132   (local-set-key [?$] 'self-insert-command)
2133
2134   ;; Set fill prefix.
2135   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2136
2137   ;; Real fontification things.
2138   (make-local-variable 'font-lock-keywords)
2139   (setq font-lock-keywords
2140         (list
2141
2142          ;; Environment names are keywords.
2143          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2144                        "{\\([^}\n]*\\)}")
2145                '(2 font-lock-keyword-face))
2146
2147          ;; Suspended environment names are keywords too.
2148          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2149                        "{\\([^}\n]*\\)}")
2150                '(3 font-lock-keyword-face))
2151
2152          ;; Command names are keywords.
2153          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2154                '(0 font-lock-keyword-face))
2155
2156          ;; Handle @/.../ for italics.
2157          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2158          ;;       '(1 font-lock-keyword-face)
2159          ;;       '(3 font-lock-keyword-face))
2160
2161          ;; Handle @*...* for boldness.
2162          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2163          ;;       '(1 font-lock-keyword-face)
2164          ;;       '(3 font-lock-keyword-face))
2165
2166          ;; Handle @`...' for literal syntax things.
2167          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2168          ;;       '(1 font-lock-keyword-face)
2169          ;;       '(3 font-lock-keyword-face))
2170
2171          ;; Handle @<...> for nonterminals.
2172          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2173          ;;       '(1 font-lock-keyword-face)
2174          ;;       '(3 font-lock-keyword-face))
2175
2176          ;; Handle other @-commands.
2177          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2178          ;;       '(0 font-lock-keyword-face))
2179
2180          ;; Make sure we get comments properly.
2181          (list "%.*"
2182                '(0 font-lock-comment-face))
2183
2184          ;; Fontify TeX special characters as punctuation.
2185          (list "[$^_{}#&]"
2186                '(0 mdw-punct-face))))
2187
2188   (mdw-post-config-mode-hack))
2189
2190 ;;;--------------------------------------------------------------------------
2191 ;;; SGML hacking.
2192
2193 (defun mdw-sgml-mode ()
2194   (interactive)
2195   (sgml-mode)
2196   (mdw-standard-fill-prefix "")
2197   (make-local-variable 'sgml-delimiters)
2198   (setq sgml-delimiters
2199         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2200           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2201           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2202           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2203           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2204           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2205           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2206           "NULL" ""))
2207   (setq major-mode 'mdw-sgml-mode)
2208   (setq mode-name "[mdw] SGML")
2209   (run-hooks 'mdw-sgml-mode-hook))
2210
2211 ;;;--------------------------------------------------------------------------
2212 ;;; Configuration files.
2213
2214 (defvar mdw-conf-quote-normal nil
2215   "*Control syntax category of quote characters `\"' and `''.
2216 If this is `t', consider quote characters to be normal
2217 punctuation, as for `conf-quote-normal'.  If this is `nil' then
2218 leave quote characters as quotes.  If this is a list, then
2219 consider the quote characters in the list to be normal
2220 punctuation.  If this is a single quote character, then consider
2221 that character only to be normal punctuation.")
2222 (defun mdw-conf-quote-normal-acceptable-value-p (value)
2223   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2224   (or (booleanp value)
2225       (every (lambda (v) (memq v '(?\" ?')))
2226              (if (listp value) value (list value)))))
2227 (put 'mdw-conf-quote-normal 'safe-local-variable '
2228      mdw-conf-quote-normal-acceptable-value-p)
2229
2230 (defun mdw-fix-up-quote ()
2231   "Apply the setting of `mdw-conf-quote-normal'."
2232   (let ((flag mdw-conf-quote-normal))
2233     (cond ((eq flag t)
2234            (conf-quote-normal t))
2235           ((not flag)
2236            nil)
2237           (t
2238            (let ((table (copy-syntax-table (syntax-table))))
2239              (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2240                    (if (listp flag) flag (list flag)))
2241              (set-syntax-table table)
2242              (and font-lock-mode (font-lock-fontify-buffer)))))))
2243 (defun mdw-fix-up-quote-hack ()
2244   "Unpleasant hack to call `mdw-fix-up-quote' at the right time.
2245 Annoyingly, `hack-local-variables' is done after `set-auto-mode'
2246 so we wouldn't see a local-variable setting of
2247 `mdw-conf-quote-normal' in `conf-mode-hook'.  Instead, wire
2248 ourselves onto `hack-local-variables-hook' here, and check the
2249 setting once it's actually been made."
2250   (add-hook 'hack-local-variables-hook 'mdw-fix-up-quote t t))
2251 (add-hook 'conf-mode-hook 'mdw-fix-up-quote-hack t)
2252
2253 ;;;--------------------------------------------------------------------------
2254 ;;; Shell scripts.
2255
2256 (defun mdw-setup-sh-script-mode ()
2257
2258   ;; Fetch the shell interpreter's name.
2259   (let ((shell-name sh-shell-file))
2260
2261     ;; Try reading the hash-bang line.
2262     (save-excursion
2263       (goto-char (point-min))
2264       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2265           (setq shell-name (match-string 1))))
2266
2267     ;; Now try to set the shell.
2268     ;;
2269     ;; Don't let `sh-set-shell' bugger up my script.
2270     (let ((executable-set-magic #'(lambda (s &rest r) s)))
2271       (sh-set-shell shell-name)))
2272
2273   ;; Now enable my keys and the fontification.
2274   (mdw-misc-mode-config)
2275
2276   ;; Set the indentation level correctly.
2277   (setq sh-indentation 2)
2278   (setq sh-basic-offset 2))
2279
2280 (setq sh-shell-file "/bin/sh")
2281
2282 ;; Awful hacking to override the shell detection for particular scripts.
2283 (defmacro define-custom-shell-mode (name shell)
2284   `(defun ,name ()
2285      (interactive)
2286      (set (make-local-variable 'sh-shell-file) ,shell)
2287      (sh-mode)))
2288 (define-custom-shell-mode bash-mode "/bin/bash")
2289 (define-custom-shell-mode rc-mode "/usr/bin/rc")
2290 (put 'sh-shell-file 'permanent-local t)
2291
2292 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
2293 (eval-after-load "sh-script"
2294   '(or (assq 'rc sh-mode-syntax-table-input)
2295        (let ((frag '(nil
2296                      ?# "<"
2297                      ?\n ">#"
2298                      ?\" "\"\""
2299                      ?\' "\"\'"
2300                      ?$ "'"
2301                      ?\` "."
2302                      ?! "_"
2303                      ?% "_"
2304                      ?. "_"
2305                      ?^ "_"
2306                      ?~ "_"
2307                      ?, "_"
2308                      ?= "."
2309                      ?< "."
2310                      ?> "."))
2311              (assoc (assq 'rc sh-mode-syntax-table-input)))
2312          (if assoc
2313              (rplacd assoc frag)
2314            (setq sh-mode-syntax-table-input
2315                  (cons (cons 'rc frag)
2316                        sh-mode-syntax-table-input))))))
2317
2318 ;;;--------------------------------------------------------------------------
2319 ;;; Emacs shell mode.
2320
2321 (defun mdw-eshell-prompt ()
2322   (let ((left "[") (right "]"))
2323     (when (= (user-uid) 0)
2324       (setq left "«" right "»"))
2325     (concat left
2326             (save-match-data
2327               (replace-regexp-in-string "\\..*$" "" (system-name)))
2328             " "
2329             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
2330                    (home (expand-file-name "~")) (nhome (length home)))
2331               (if (and (>= npwd nhome)
2332                        (or (= nhome npwd)
2333                            (= (elt pwd nhome) ?/))
2334                        (string= (substring pwd 0 nhome) home))
2335                   (concat "~" (substring pwd (length home)))
2336                 pwd))
2337             right)))
2338 (setq eshell-prompt-function 'mdw-eshell-prompt)
2339 (setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
2340
2341 (defun eshell/e (file) (find-file file) nil)
2342 (defun eshell/ee (file) (find-file-other-window file) nil)
2343 (defun eshell/w3m (url) (w3m-goto-url url) nil)
2344
2345 (mdw-define-face eshell-prompt (t :weight bold))
2346 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2347 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2348 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2349 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2350 (mdw-define-face eshell-ls-executable (t :weight bold))
2351 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2352 (mdw-define-face eshell-ls-readonly (t nil))
2353 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2354
2355 ;;;--------------------------------------------------------------------------
2356 ;;; Messages-file mode.
2357
2358 (defun messages-mode-guts ()
2359   (setq messages-mode-syntax-table (make-syntax-table))
2360   (set-syntax-table messages-mode-syntax-table)
2361   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2362   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2363   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2364   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2365   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2366   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2367   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2368   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2369   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2370   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2371   (make-local-variable 'comment-start)
2372   (make-local-variable 'comment-end)
2373   (make-local-variable 'indent-line-function)
2374   (setq indent-line-function 'indent-relative)
2375   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2376   (make-local-variable 'font-lock-defaults)
2377   (make-local-variable 'messages-mode-keywords)
2378   (let ((keywords
2379          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2380                       "export" "enum" "fixed-octetstring" "flags"
2381                       "harmless" "map" "nested" "optional"
2382                       "optional-tagged" "package" "primitive"
2383                       "primitive-nullfree" "relaxed[ \t]+enum"
2384                       "set" "table" "tagged-optional"   "union"
2385                       "variadic" "vector" "version" "version-tag")))
2386     (setq messages-mode-keywords
2387           (list
2388            (list (concat "\\<\\(" keywords "\\)\\>:")
2389                  '(0 font-lock-keyword-face))
2390            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2391            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2392              (0 font-lock-variable-name-face))
2393            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2394            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2395              (0 mdw-punct-face)))))
2396   (setq font-lock-defaults
2397         '(messages-mode-keywords nil nil nil nil))
2398   (run-hooks 'messages-file-hook))
2399
2400 (defun messages-mode ()
2401   (interactive)
2402   (fundamental-mode)
2403   (setq major-mode 'messages-mode)
2404   (setq mode-name "Messages")
2405   (messages-mode-guts)
2406   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2407   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2408   (setq comment-start "# ")
2409   (setq comment-end "")
2410   (run-hooks 'messages-mode-hook))
2411
2412 (defun cpp-messages-mode ()
2413   (interactive)
2414   (fundamental-mode)
2415   (setq major-mode 'cpp-messages-mode)
2416   (setq mode-name "CPP Messages")
2417   (messages-mode-guts)
2418   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2419   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2420   (setq comment-start "/* ")
2421   (setq comment-end " */")
2422   (let ((preprocessor-keywords
2423          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2424                       "ident" "if" "ifdef" "ifndef" "import" "include"
2425                       "line" "pragma" "unassert" "undef" "warning")))
2426     (setq messages-mode-keywords
2427           (append (list (list (concat "^[ \t]*\\#[ \t]*"
2428                                       "\\(include\\|import\\)"
2429                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2430                               '(2 font-lock-string-face))
2431                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2432                                       preprocessor-keywords
2433                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
2434                               '(1 font-lock-keyword-face)))
2435                   messages-mode-keywords)))
2436   (run-hooks 'cpp-messages-mode-hook))
2437
2438 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2439 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2440 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2441
2442 ;;;--------------------------------------------------------------------------
2443 ;;; Messages-file mode.
2444
2445 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2446   "Face to use for subsittution directives.")
2447 (make-face 'mallow-driver-substitution-face)
2448 (defvar mallow-driver-text-face 'mallow-driver-text-face
2449   "Face to use for body text.")
2450 (make-face 'mallow-driver-text-face)
2451
2452 (defun mallow-driver-mode ()
2453   (interactive)
2454   (fundamental-mode)
2455   (setq major-mode 'mallow-driver-mode)
2456   (setq mode-name "Mallow driver")
2457   (setq mallow-driver-mode-syntax-table (make-syntax-table))
2458   (set-syntax-table mallow-driver-mode-syntax-table)
2459   (make-local-variable 'comment-start)
2460   (make-local-variable 'comment-end)
2461   (make-local-variable 'indent-line-function)
2462   (setq indent-line-function 'indent-relative)
2463   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2464   (make-local-variable 'font-lock-defaults)
2465   (make-local-variable 'mallow-driver-mode-keywords)
2466   (let ((keywords
2467          (mdw-regexps "each" "divert" "file" "if"
2468                       "perl" "set" "string" "type" "write")))
2469     (setq mallow-driver-mode-keywords
2470           (list
2471            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2472                  '(0 font-lock-keyword-face))
2473            (list "^%\\s *\\(#.*\\|\\)$"
2474                  '(0 font-lock-comment-face))
2475            (list "^%"
2476                  '(0 font-lock-keyword-face))
2477            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2478            (list "\\${[^}]*}"
2479                  '(0 mallow-driver-substitution-face t)))))
2480   (setq font-lock-defaults
2481         '(mallow-driver-mode-keywords nil nil nil nil))
2482   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2483   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2484   (setq comment-start "%# ")
2485   (setq comment-end "")
2486   (run-hooks 'mallow-driver-mode-hook))
2487
2488 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2489
2490 ;;;--------------------------------------------------------------------------
2491 ;;; NFast debugs.
2492
2493 (defun nfast-debug-mode ()
2494   (interactive)
2495   (fundamental-mode)
2496   (setq major-mode 'nfast-debug-mode)
2497   (setq mode-name "NFast debug")
2498   (setq messages-mode-syntax-table (make-syntax-table))
2499   (set-syntax-table messages-mode-syntax-table)
2500   (make-local-variable 'font-lock-defaults)
2501   (make-local-variable 'nfast-debug-mode-keywords)
2502   (setq truncate-lines t)
2503   (setq nfast-debug-mode-keywords
2504         (list
2505          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2506            (0 font-lock-keyword-face))
2507          (list (concat "^[ \t]+\\(\\("
2508                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2509                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2510                        "[ \t]+\\)*"
2511                        "[0-9a-fA-F]+\\)[ \t]*$")
2512            '(0 mdw-number-face))
2513          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2514            (1 font-lock-keyword-face))
2515          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2516            (1 font-lock-warning-face))
2517          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2518            (1 nil))
2519          (list (concat "^[ \t]+\\.cmd=[ \t]+"
2520                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2521            '(1 font-lock-keyword-face))
2522          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2523          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2524          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2525          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2526   (setq font-lock-defaults
2527         '(nfast-debug-mode-keywords nil nil nil nil))
2528   (run-hooks 'nfast-debug-mode-hook))
2529
2530 ;;;--------------------------------------------------------------------------
2531 ;;; Other languages.
2532
2533 ;; Smalltalk.
2534
2535 (defun mdw-setup-smalltalk ()
2536   (and mdw-auto-indent
2537        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2538   (make-local-variable 'mdw-auto-indent)
2539   (setq mdw-auto-indent nil)
2540   (local-set-key "\C-i" 'smalltalk-reindent))
2541
2542 (defun mdw-fontify-smalltalk ()
2543   (make-local-variable 'font-lock-keywords)
2544   (setq font-lock-keywords
2545         (list
2546          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2547                '(0 font-lock-keyword-face))
2548          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2549                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2550                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2551                '(0 mdw-number-face))
2552          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2553                '(0 mdw-punct-face))))
2554   (mdw-post-config-mode-hack))
2555
2556 ;; Lispy languages.
2557
2558 ;; Unpleasant bodge.
2559 (unless (boundp 'slime-repl-mode-map)
2560   (setq slime-repl-mode-map (make-sparse-keymap)))
2561
2562 (defun mdw-indent-newline-and-indent ()
2563   (interactive)
2564   (indent-for-tab-command)
2565   (newline-and-indent))
2566
2567 (eval-after-load "cl-indent"
2568   '(progn
2569      (mapc #'(lambda (pair)
2570                (put (car pair)
2571                     'common-lisp-indent-function
2572                     (cdr pair)))
2573       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2574         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2575
2576 (defun mdw-common-lisp-indent ()
2577   (make-local-variable 'lisp-indent-function)
2578   (setq lisp-indent-function 'common-lisp-indent-function))
2579
2580 (setq lisp-simple-loop-indentation 2
2581       lisp-loop-keyword-indentation 6
2582       lisp-loop-forms-indentation 6)
2583
2584 (defun mdw-fontify-lispy ()
2585
2586   ;; Set fill prefix.
2587   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2588
2589   ;; Not much fontification needed.
2590   (make-local-variable 'font-lock-keywords)
2591   (setq font-lock-keywords
2592         (list
2593          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2594                '(0 mdw-punct-face))))
2595
2596   (mdw-post-config-mode-hack))
2597
2598 (defun comint-send-and-indent ()
2599   (interactive)
2600   (comint-send-input)
2601   (and mdw-auto-indent
2602        (indent-for-tab-command)))
2603
2604 (defun mdw-setup-m4 ()
2605   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2606
2607 ;;;--------------------------------------------------------------------------
2608 ;;; Text mode.
2609
2610 (defun mdw-text-mode ()
2611   (setq fill-column 72)
2612   (flyspell-mode t)
2613   (mdw-standard-fill-prefix
2614    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2615   (auto-fill-mode 1))
2616
2617 ;;;--------------------------------------------------------------------------
2618 ;;; Outline and hide/show modes.
2619
2620 (defun mdw-outline-collapse-all ()
2621   "Completely collapse everything in the entire buffer."
2622   (interactive)
2623   (save-excursion
2624     (goto-char (point-min))
2625     (while (< (point) (point-max))
2626       (hide-subtree)
2627       (forward-line))))
2628
2629 (setq hs-hide-comments-when-hiding-all nil)
2630
2631 (defadvice hs-hide-all (after hide-first-comment activate)
2632   (save-excursion (hs-hide-initial-comment-block)))
2633
2634 ;;;--------------------------------------------------------------------------
2635 ;;; Shell mode.
2636
2637 (defun mdw-sh-mode-setup ()
2638   (local-set-key [?\C-a] 'comint-bol)
2639   (add-hook 'comint-output-filter-functions
2640             'comint-watch-for-password-prompt))
2641
2642 (defun mdw-term-mode-setup ()
2643   (setq term-prompt-regexp shell-prompt-pattern)
2644   (make-local-variable 'mouse-yank-at-point)
2645   (make-local-variable 'transient-mark-mode)
2646   (setq mouse-yank-at-point t)
2647   (auto-fill-mode -1)
2648   (setq tab-width 8))
2649
2650 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2651 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
2652 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2653 (defun term-send-meta-meta-something ()
2654   (interactive)
2655   (term-send-raw-string "\e\e")
2656   (term-send-raw))
2657 (eval-after-load 'term
2658   '(progn
2659      (define-key term-raw-map [?\e ?\e] nil)
2660      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2661      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2662      (define-key term-raw-map [M-right] 'term-send-meta-right)
2663      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2664      (define-key term-raw-map [M-left] 'term-send-meta-left)
2665      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2666
2667 (defadvice term-exec (before program-args-list compile activate)
2668   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
2669 This allows you to pass a list of arguments through `ansi-term'."
2670   (let ((program (ad-get-arg 2)))
2671     (if (listp program)
2672         (progn
2673           (ad-set-arg 2 (car program))
2674           (ad-set-arg 4 (cdr program))))))
2675
2676 (defun ssh (host)
2677   "Open a terminal containing an ssh session to the HOST."
2678   (interactive "sHost: ")
2679   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
2680
2681 ;;;--------------------------------------------------------------------------
2682 ;;; Inferior Emacs Lisp.
2683
2684 (setq comint-prompt-read-only t)
2685
2686 (eval-after-load "comint"
2687   '(progn
2688      (define-key comint-mode-map "\C-w" 'comint-kill-region)
2689      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
2690
2691 (eval-after-load "ielm"
2692   '(progn
2693      (define-key ielm-map "\C-w" 'comint-kill-region)
2694      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
2695
2696 ;;;----- That's all, folks --------------------------------------------------
2697
2698 (provide 'dot-emacs)