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