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-misc-mode-config ()
 669   (and mdw-auto-indent
 670        (cond ((eq major-mode 'lisp-mode)
 671               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
 672              ((or (eq major-mode 'slime-repl-mode)
 673                   (eq major-mode 'asm-mode))
 674               nil)
 675              (t
 676               (local-set-key "\C-m" 'newline-and-indent))))
 677   (local-set-key [C-return] 'newline)
 678   (make-variable-buffer-local 'page-delimiter)
 679   (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
 680   (setq comment-column 40)
 681   (auto-fill-mode 1)
 682   (setq fill-column 77)
 683   (setq show-trailing-whitespace t)
 684   (let ((whitespace-style (remove 'trailing whitespace-style)))
 685     (trap (whitespace-mode t)))
 686   (and (fboundp 'gtags-mode)
 687        (gtags-mode))
 688   (outline-minor-mode t)
 689   (hs-minor-mode t)
 690   (reveal-mode t)
 691   (trap (turn-on-font-lock)))
 692
 693 (defun mdw-post-config-mode-hack ()
 694   (let ((whitespace-style (remove 'trailing whitespace-style)))
 695     (trap (whitespace-mode t))))
 696
 697 (eval-after-load 'gtags
 698   '(progn
 699      (dolist (key '([mouse-2] [mouse-3]))
 700        (define-key gtags-mode-map key nil))
 701      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
 702      (define-key gtags-select-mode-map [C-S-mouse-2]
 703        'gtags-select-tag-by-event)
 704      (dolist (map (list gtags-mode-map gtags-select-mode-map))
 705        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
 706
 707 ;; Backup file handling.
 708
 709 (defvar mdw-backup-disable-regexps nil
 710   "*List of regular expressions: if a file name matches any of
 711 these then the file is not backed up.")
 712
 713 (defun mdw-backup-enable-predicate (name)
 714   "[mdw]'s default backup predicate.
 715 Allows a backup if the standard predicate would allow it, and it
 716 doesn't match any of the regular expressions in
 717 `mdw-backup-disable-regexps'."
 718   (and (normal-backup-enable-predicate name)
 719        (let ((answer t) (list mdw-backup-disable-regexps))
 720          (save-match-data
 721            (while list
 722              (if (string-match (car list) name)
 723                  (setq answer nil))
 724              (setq list (cdr list)))
 725            answer))))
 726 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
 727
 728 ;; Frame cleanup.
 729
 730 (defun mdw-last-one-out-turn-off-the-lights (frame)
 731   "Disconnect from an X display if this was the last frame on that display."
 732   (let ((frame-display (frame-parameter frame 'display)))
 733     (when (and frame-display
 734                (eq window-system 'x)
 735                (not (some (lambda (fr)
 736                             (message "checking frame %s" frame)
 737                             (and (not (eq fr frame))
 738                                  (string= (frame-parameter fr 'display)
 739                                           frame-display)
 740                                  (progn "frame %s still uses us" nil)))
 741                           (frame-list))))
 742       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
 743 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
 744
 745 ;;;--------------------------------------------------------------------------
 746 ;;; General fontification.
 747
 748 (defmacro mdw-define-face (name &rest body)
 749   "Define a face, and make sure it's actually set as the definition."
 750   (declare (indent 1)
 751            (debug 0))
 752   `(progn
 753      (make-face ',name)
 754      (defvar ,name ',name)
 755      (put ',name 'face-defface-spec ',body)
 756      (face-spec-set ',name ',body nil)))
 757
 758 (mdw-define-face default
 759   (((type w32)) :family "courier new" :height 85)
 760   (((type x)) :family "6x13" :height 130)
 761   (((type color)) :foreground "white" :background "black")
 762   (t nil))
 763 (mdw-define-face fixed-pitch
 764   (((type w32)) :family "courier new" :height 85)
 765   (((type x)) :family "6x13" :height 130)
 766   (t :foreground "white" :background "black"))
 767 (if (>= emacs-major-version 23)
 768     (mdw-define-face variable-pitch
 769       (((type x)) :family "sans" :height 100))
 770   (mdw-define-face variable-pitch
 771     (((type x)) :family "helvetica" :height 120)))
 772 (mdw-define-face region
 773   (((type tty) (class color)) :background "blue")
 774   (((type tty) (class mono)) :inverse-video t)
 775   (t :background "grey30"))
 776 (mdw-define-face minibuffer-prompt
 777   (t :weight bold))
 778 (mdw-define-face mode-line
 779   (((class color)) :foreground "blue" :background "yellow"
 780                    :box (:line-width 1 :style released-button))
 781   (t :inverse-video t))
 782 (mdw-define-face mode-line-inactive
 783   (((class color)) :foreground "yellow" :background "blue"
 784                    :box (:line-width 1 :style released-button))
 785   (t :inverse-video t))
 786 (mdw-define-face scroll-bar
 787   (t :foreground "black" :background "lightgrey"))
 788 (mdw-define-face fringe
 789   (t :foreground "yellow"))
 790 (mdw-define-face show-paren-match
 791   (((class color)) :background "darkgreen")
 792   (t :underline t))
 793 (mdw-define-face show-paren-mismatch
 794   (((class color)) :background "red")
 795   (t :inverse-video t))
 796 (mdw-define-face highlight
 797   (((class color)) :background "DarkSeaGreen4")
 798   (t :inverse-video t))
 799
 800 (mdw-define-face holiday-face
 801   (t :background "red"))
 802 (mdw-define-face calendar-today-face
 803   (t :foreground "yellow" :weight bold))
 804
 805 (mdw-define-face comint-highlight-prompt
 806   (t :weight bold))
 807 (mdw-define-face comint-highlight-input)
 808
 809 (mdw-define-face trailing-whitespace
 810   (((class color)) :background "red")
 811   (t :inverse-video t))
 812 (mdw-define-face mdw-punct-face
 813   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
 814 (mdw-define-face mdw-number-face
 815   (t :foreground "yellow"))
 816 (mdw-define-face font-lock-function-name-face
 817   (t :slant italic))
 818 (mdw-define-face font-lock-keyword-face
 819   (t :weight bold))
 820 (mdw-define-face font-lock-constant-face
 821   (t :slant italic))
 822 (mdw-define-face font-lock-builtin-face
 823   (t :weight bold))
 824 (mdw-define-face font-lock-type-face
 825   (t :weight bold :slant italic))
 826 (mdw-define-face font-lock-reference-face
 827   (t :weight bold))
 828 (mdw-define-face font-lock-variable-name-face
 829   (t :slant italic))
 830 (mdw-define-face font-lock-comment-delimiter-face
 831   (((class mono)) :weight bold)
 832   (((type tty) (class color)) :foreground "green")
 833   (t :slant italic :foreground "SeaGreen1"))
 834 (mdw-define-face font-lock-comment-face
 835   (((class mono)) :weight bold)
 836   (((type tty) (class color)) :foreground "green")
 837   (t :slant italic :foreground "SeaGreen1"))
 838 (mdw-define-face font-lock-string-face
 839   (((class mono)) :weight bold)
 840   (((class color)) :foreground "SkyBlue1"))
 841 (mdw-define-face message-separator
 842   (t :background "red" :foreground "white" :weight bold))
 843 (mdw-define-face message-cited-text
 844   (default :slant italic)
 845   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 846 (mdw-define-face message-header-cc
 847   (default :weight bold)
 848   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 849 (mdw-define-face message-header-newsgroups
 850   (default :weight bold)
 851   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 852 (mdw-define-face message-header-subject
 853   (default :weight bold)
 854   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 855 (mdw-define-face message-header-to
 856   (default :weight bold)
 857   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 858 (mdw-define-face message-header-xheader
 859   (default :weight bold)
 860   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 861 (mdw-define-face message-header-other
 862   (default :weight bold)
 863   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 864 (mdw-define-face message-header-name
 865   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 866
 867 (mdw-define-face diff-index
 868   (t :weight bold))
 869 (mdw-define-face diff-file-header
 870   (t :weight bold))
 871 (mdw-define-face diff-hunk-header
 872   (t :foreground "SkyBlue1"))
 873 (mdw-define-face diff-function
 874   (t :foreground "SkyBlue1" :weight bold))
 875 (mdw-define-face diff-header
 876   (t :background "grey10"))
 877 (mdw-define-face diff-added
 878   (t :foreground "green"))
 879 (mdw-define-face diff-removed
 880   (t :foreground "red"))
 881 (mdw-define-face diff-context)
 882
 883 (mdw-define-face erc-input-face
 884   (t :foreground "red"))
 885
 886 (mdw-define-face woman-bold
 887   (t :weight bold))
 888 (mdw-define-face woman-italic
 889   (t :slant italic))
 890
 891 (mdw-define-face p4-depot-added-face
 892   (t :foreground "green"))
 893 (mdw-define-face p4-depot-branch-op-face
 894   (t :foreground "yellow"))
 895 (mdw-define-face p4-depot-deleted-face
 896   (t :foreground "red"))
 897 (mdw-define-face p4-depot-unmapped-face
 898   (t :foreground "SkyBlue1"))
 899 (mdw-define-face p4-diff-change-face
 900   (t :foreground "yellow"))
 901 (mdw-define-face p4-diff-del-face
 902   (t :foreground "red"))
 903 (mdw-define-face p4-diff-file-face
 904   (t :foreground "SkyBlue1"))
 905 (mdw-define-face p4-diff-head-face
 906   (t :background "grey10"))
 907 (mdw-define-face p4-diff-ins-face
 908   (t :foreground "green"))
 909
 910 (mdw-define-face whizzy-slice-face
 911   (t :background "grey10"))
 912 (mdw-define-face whizzy-error-face
 913   (t :background "darkred"))
 914
 915 ;;;--------------------------------------------------------------------------
 916 ;;; C programming configuration.
 917
 918 ;; Linux kernel hacking.
 919
 920 (defvar linux-c-mode-hook)
 921
 922 (defun linux-c-mode ()
 923   (interactive)
 924   (c-mode)
 925   (setq major-mode 'linux-c-mode)
 926   (setq mode-name "Linux C")
 927   (run-hooks 'linux-c-mode-hook))
 928
 929 ;; Make C indentation nice.
 930
 931 (defun mdw-c-lineup-arglist (langelem)
 932   "Hack for DWIMmery in c-lineup-arglist."
 933   (if (save-excursion
 934         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
 935       0
 936     (c-lineup-arglist langelem)))
 937
 938 (defun mdw-c-indent-extern-mumble (langelem)
 939   "Indent `extern \"...\" {' lines."
 940   (save-excursion
 941     (back-to-indentation)
 942     (if (looking-at
 943          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
 944         c-basic-offset
 945       nil)))
 946
 947 (defun mdw-c-style ()
 948   (c-add-style "[mdw] C and C++ style"
 949                '((c-basic-offset . 2)
 950                  (comment-column . 40)
 951                  (c-class-key . "class")
 952                  (c-backslash-column . 72)
 953                  (c-offsets-alist
 954                   (substatement-open . (add 0 c-indent-one-line-block))
 955                   (defun-open . (add 0 c-indent-one-line-block))
 956                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
 957                   (topmost-intro . mdw-c-indent-extern-mumble)
 958                   (cpp-define-intro . 0)
 959                   (inextern-lang . [0])
 960                   (label . 0)
 961                   (case-label . +)
 962                   (access-label . -)
 963                   (inclass . +)
 964                   (inline-open . ++)
 965                   (statement-cont . 0)
 966                   (statement-case-intro . +)))
 967                t))
 968
 969 (defvar mdw-c-comment-fill-prefix
 970   `((,(concat "\\([ \t]*/?\\)"
 971               "\\(\*\\|//]\\)"
 972               "\\([ \t]*\\)"
 973               "\\([A-Za-z]+:[ \t]*\\)?"
 974               mdw-hanging-indents)
 975      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
 976   "Fill prefix matching C comments (both kinds).")
 977
 978 (defun mdw-fontify-c-and-c++ ()
 979
 980   ;; Fiddle with some syntax codes.
 981   (modify-syntax-entry ?* ". 23")
 982   (modify-syntax-entry ?/ ". 124b")
 983   (modify-syntax-entry ?\n "> b")
 984
 985   ;; Other stuff.
 986   (mdw-c-style)
 987   (setq c-hanging-comment-ender-p nil)
 988   (setq c-backslash-column 72)
 989   (setq c-label-minimum-indentation 0)
 990   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
 991
 992   ;; Now define things to be fontified.
 993   (make-local-variable 'font-lock-keywords)
 994   (let ((c-keywords
 995          (mdw-regexps "and"             ;C++
 996                       "and_eq"          ;C++
 997                       "asm"             ;K&R, GCC
 998                       "auto"            ;K&R, C89
 999                       "bitand"          ;C++
1000                       "bitor"           ;C++
1001                       "bool"            ;C++, C9X macro
1002                       "break"           ;K&R, C89
1003                       "case"            ;K&R, C89
1004                       "catch"           ;C++
1005                       "char"            ;K&R, C89
1006                       "class"           ;C++
1007                       "complex"         ;C9X macro, C++ template type
1008                       "compl"           ;C++
1009                       "const"           ;C89
1010                       "const_cast"      ;C++
1011                       "continue"        ;K&R, C89
1012                       "defined"         ;C89 preprocessor
1013                       "default"         ;K&R, C89
1014                       "delete"          ;C++
1015                       "do"              ;K&R, C89
1016                       "double"          ;K&R, C89
1017                       "dynamic_cast"    ;C++
1018                       "else"            ;K&R, C89
1019                       ;; "entry"        ;K&R -- never used
1020                       "enum"            ;C89
1021                       "explicit"        ;C++
1022                       "export"          ;C++
1023                       "extern"          ;K&R, C89
1024                       "false"           ;C++, C9X macro
1025                       "float"           ;K&R, C89
1026                       "for"             ;K&R, C89
1027                       ;; "fortran"      ;K&R
1028                       "friend"          ;C++
1029                       "goto"            ;K&R, C89
1030                       "if"              ;K&R, C89
1031                       "imaginary"       ;C9X macro
1032                       "inline"          ;C++, C9X, GCC
1033                       "int"             ;K&R, C89
1034                       "long"            ;K&R, C89
1035                       "mutable"         ;C++
1036                       "namespace"       ;C++
1037                       "new"             ;C++
1038                       "operator"        ;C++
1039                       "or"              ;C++
1040                       "or_eq"           ;C++
1041                       "private"         ;C++
1042                       "protected"       ;C++
1043                       "public"          ;C++
1044                       "register"        ;K&R, C89
1045                       "reinterpret_cast" ;C++
1046                       "restrict"         ;C9X
1047                       "return"           ;K&R, C89
1048                       "short"            ;K&R, C89
1049                       "signed"           ;C89
1050                       "sizeof"           ;K&R, C89
1051                       "static"           ;K&R, C89
1052                       "static_cast"      ;C++
1053                       "struct"           ;K&R, C89
1054                       "switch"           ;K&R, C89
1055                       "template"         ;C++
1056                       "this"             ;C++
1057                       "throw"            ;C++
1058                       "true"             ;C++, C9X macro
1059                       "try"              ;C++
1060                       "this"             ;C++
1061                       "typedef"          ;C89
1062                       "typeid"           ;C++
1063                       "typeof"           ;GCC
1064                       "typename"         ;C++
1065                       "union"            ;K&R, C89
1066                       "unsigned"         ;K&R, C89
1067                       "using"            ;C++
1068                       "virtual"          ;C++
1069                       "void"             ;C89
1070                       "volatile"         ;C89
1071                       "wchar_t"          ;C++, C89 library type
1072                       "while"            ;K&R, C89
1073                       "xor"              ;C++
1074                       "xor_eq"           ;C++
1075                       "_Bool"            ;C9X
1076                       "_Complex"         ;C9X
1077                       "_Imaginary"       ;C9X
1078                       "_Pragma"          ;C9X preprocessor
1079                       "__alignof__"      ;GCC
1080                       "__asm__"          ;GCC
1081                       "__attribute__"    ;GCC
1082                       "__complex__"      ;GCC
1083                       "__const__"        ;GCC
1084                       "__extension__"    ;GCC
1085                       "__imag__"         ;GCC
1086                       "__inline__"       ;GCC
1087                       "__label__"        ;GCC
1088                       "__real__"         ;GCC
1089                       "__signed__"       ;GCC
1090                       "__typeof__"       ;GCC
1091                       "__volatile__"     ;GCC
1092                       ))
1093         (preprocessor-keywords
1094          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1095                       "ident" "if" "ifdef" "ifndef" "import" "include"
1096                       "line" "pragma" "unassert" "undef" "warning"))
1097         (objc-keywords
1098          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1099                       "interface" "private" "protected" "protocol" "public"
1100                       "selector")))
1101
1102     (setq font-lock-keywords
1103           (list
1104
1105            ;; Fontify include files as strings.
1106            (list (concat "^[ \t]*\\#[ \t]*"
1107                          "\\(include\\|import\\)"
1108                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1109                  '(2 font-lock-string-face))
1110
1111            ;; Preprocessor directives are `references'?.
1112            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1113                          preprocessor-keywords
1114                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1115                  '(1 font-lock-keyword-face))
1116
1117            ;; Handle the keywords defined above.
1118            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1119                  '(0 font-lock-keyword-face))
1120
1121            (list (concat "\\<\\(" c-keywords "\\)\\>")
1122                  '(0 font-lock-keyword-face))
1123
1124            ;; Handle numbers too.
1125            ;;
1126            ;; This looks strange, I know.  It corresponds to the
1127            ;; preprocessor's idea of what a number looks like, rather than
1128            ;; anything sensible.
1129            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1130                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1131                  '(0 mdw-number-face))
1132
1133            ;; And anything else is punctuation.
1134            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1135                  '(0 mdw-punct-face))))
1136
1137     (mdw-post-config-mode-hack)))
1138
1139 ;;;--------------------------------------------------------------------------
1140 ;;; AP calc mode.
1141
1142 (defun apcalc-mode ()
1143   (interactive)
1144   (c-mode)
1145   (setq major-mode 'apcalc-mode)
1146   (setq mode-name "AP Calc")
1147   (run-hooks 'apcalc-mode-hook))
1148
1149 (defun mdw-fontify-apcalc ()
1150
1151   ;; Fiddle with some syntax codes.
1152   (modify-syntax-entry ?* ". 23")
1153   (modify-syntax-entry ?/ ". 14")
1154
1155   ;; Other stuff.
1156   (mdw-c-style)
1157   (setq c-hanging-comment-ender-p nil)
1158   (setq c-backslash-column 72)
1159   (setq comment-start "/* ")
1160   (setq comment-end " */")
1161   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1162
1163   ;; Now define things to be fontified.
1164   (make-local-variable 'font-lock-keywords)
1165   (let ((c-keywords
1166          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1167                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1168                       "local" "mat" "obj" "print" "quit" "read" "return"
1169                       "show" "static" "switch" "while" "write")))
1170
1171     (setq font-lock-keywords
1172           (list
1173
1174            ;; Handle the keywords defined above.
1175            (list (concat "\\<\\(" c-keywords "\\)\\>")
1176                  '(0 font-lock-keyword-face))
1177
1178            ;; Handle numbers too.
1179            ;;
1180            ;; This looks strange, I know.  It corresponds to the
1181            ;; preprocessor's idea of what a number looks like, rather than
1182            ;; anything sensible.
1183            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1184                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1185                  '(0 mdw-number-face))
1186
1187            ;; And anything else is punctuation.
1188            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1189                  '(0 mdw-punct-face)))))
1190
1191   (mdw-post-config-mode-hack))
1192
1193 ;;;--------------------------------------------------------------------------
1194 ;;; Java programming configuration.
1195
1196 ;; Make indentation nice.
1197
1198 (defun mdw-java-style ()
1199   (c-add-style "[mdw] Java style"
1200                '((c-basic-offset . 2)
1201                  (c-offsets-alist (substatement-open . 0)
1202                                   (label . +)
1203                                   (case-label . +)
1204                                   (access-label . 0)
1205                                   (inclass . +)
1206                                   (statement-case-intro . +)))
1207                t))
1208
1209 ;; Declare Java fontification style.
1210
1211 (defun mdw-fontify-java ()
1212
1213   ;; Other stuff.
1214   (mdw-java-style)
1215   (setq c-hanging-comment-ender-p nil)
1216   (setq c-backslash-column 72)
1217   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1218
1219   ;; Now define things to be fontified.
1220   (make-local-variable 'font-lock-keywords)
1221   (let ((java-keywords
1222          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1223                       "char" "class" "const" "continue" "default" "do"
1224                       "double" "else" "extends" "final" "finally" "float"
1225                       "for" "goto" "if" "implements" "import" "instanceof"
1226                       "int" "interface" "long" "native" "new" "package"
1227                       "private" "protected" "public" "return" "short"
1228                       "static" "super" "switch" "synchronized" "this"
1229                       "throw" "throws" "transient" "try" "void" "volatile"
1230                       "while"
1231
1232                       "false" "null" "true")))
1233
1234     (setq font-lock-keywords
1235           (list
1236
1237            ;; Handle the keywords defined above.
1238            (list (concat "\\<\\(" java-keywords "\\)\\>")
1239                  '(0 font-lock-keyword-face))
1240
1241            ;; Handle numbers too.
1242            ;;
1243            ;; The following isn't quite right, but it's close enough.
1244            (list (concat "\\<\\("
1245                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1246                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1247                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1248                          "[lLfFdD]?")
1249                  '(0 mdw-number-face))
1250
1251            ;; And anything else is punctuation.
1252            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1253                  '(0 mdw-punct-face)))))
1254
1255   (mdw-post-config-mode-hack))
1256
1257 ;;;--------------------------------------------------------------------------
1258 ;;; C# programming configuration.
1259
1260 ;; Make indentation nice.
1261
1262 (defun mdw-csharp-style ()
1263   (c-add-style "[mdw] C# style"
1264                '((c-basic-offset . 2)
1265                  (c-offsets-alist (substatement-open . 0)
1266                                   (label . 0)
1267                                   (case-label . +)
1268                                   (access-label . 0)
1269                                   (inclass . +)
1270                                   (statement-case-intro . +)))
1271                t))
1272
1273 ;; Declare C# fontification style.
1274
1275 (defun mdw-fontify-csharp ()
1276
1277   ;; Other stuff.
1278   (mdw-csharp-style)
1279   (setq c-hanging-comment-ender-p nil)
1280   (setq c-backslash-column 72)
1281   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1282
1283   ;; Now define things to be fontified.
1284   (make-local-variable 'font-lock-keywords)
1285   (let ((csharp-keywords
1286          (mdw-regexps "abstract" "as" "base" "bool" "break"
1287                       "byte" "case" "catch" "char" "checked"
1288                       "class" "const" "continue" "decimal" "default"
1289                       "delegate" "do" "double" "else" "enum"
1290                       "event" "explicit" "extern" "false" "finally"
1291                       "fixed" "float" "for" "foreach" "goto"
1292                       "if" "implicit" "in" "int" "interface"
1293                       "internal" "is" "lock" "long" "namespace"
1294                       "new" "null" "object" "operator" "out"
1295                       "override" "params" "private" "protected" "public"
1296                       "readonly" "ref" "return" "sbyte" "sealed"
1297                       "short" "sizeof" "stackalloc" "static" "string"
1298                       "struct" "switch" "this" "throw" "true"
1299                       "try" "typeof" "uint" "ulong" "unchecked"
1300                       "unsafe" "ushort" "using" "virtual" "void"
1301                       "volatile" "while" "yield")))
1302
1303     (setq font-lock-keywords
1304           (list
1305
1306            ;; Handle the keywords defined above.
1307            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1308                  '(0 font-lock-keyword-face))
1309
1310            ;; Handle numbers too.
1311            ;;
1312            ;; The following isn't quite right, but it's close enough.
1313            (list (concat "\\<\\("
1314                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1315                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1316                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1317                          "[lLfFdD]?")
1318                  '(0 mdw-number-face))
1319
1320            ;; And anything else is punctuation.
1321            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1322                  '(0 mdw-punct-face)))))
1323
1324   (mdw-post-config-mode-hack))
1325
1326 (define-derived-mode csharp-mode java-mode "C#"
1327   "Major mode for editing C# code.")
1328
1329 ;;;--------------------------------------------------------------------------
1330 ;;; Go programming configuration.
1331
1332 (defun mdw-fontify-go ()
1333
1334   (make-local-variable 'font-lock-keywords)
1335   (let ((go-keywords
1336          (mdw-regexps "break" "case" "chan" "const" "continue"
1337                       "default" "defer" "else" "fallthrough" "for"
1338                       "func" "go" "goto" "if" "import"
1339                       "interface" "map" "package" "range" "return"
1340                       "select" "struct" "switch" "type" "var")))
1341
1342     (setq font-lock-keywords
1343           (list
1344
1345            ;; Handle the keywords defined above.
1346            (list (concat "\\<\\(" go-keywords "\\)\\>")
1347                  '(0 font-lock-keyword-face))
1348
1349            ;; Handle numbers too.
1350            ;;
1351            ;; The following isn't quite right, but it's close enough.
1352            (list (concat "\\<\\("
1353                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1354                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1355                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1356                  '(0 mdw-number-face))
1357
1358            ;; And anything else is punctuation.
1359            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1360                  '(0 mdw-punct-face)))))
1361
1362   (mdw-post-config-mode-hack))
1363
1364 ;;;--------------------------------------------------------------------------
1365 ;;; Awk programming configuration.
1366
1367 ;; Make Awk indentation nice.
1368
1369 (defun mdw-awk-style ()
1370   (c-add-style "[mdw] Awk style"
1371                '((c-basic-offset . 2)
1372                  (c-offsets-alist (substatement-open . 0)
1373                                   (statement-cont . 0)
1374                                   (statement-case-intro . +)))
1375                t))
1376
1377 ;; Declare Awk fontification style.
1378
1379 (defun mdw-fontify-awk ()
1380
1381   ;; Miscellaneous fiddling.
1382   (mdw-awk-style)
1383   (setq c-backslash-column 72)
1384   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1385
1386   ;; Now define things to be fontified.
1387   (make-local-variable 'font-lock-keywords)
1388   (let ((c-keywords
1389          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1390                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1391                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1392                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1393                       "atan2" "break" "close" "continue" "cos" "delete"
1394                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1395                       "function" "gensub" "getline" "gsub" "if" "in"
1396                       "index" "int" "length" "log" "match" "next" "rand"
1397                       "return" "print" "printf" "sin" "split" "sprintf"
1398                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1399                       "systime" "tolower" "toupper" "while")))
1400
1401     (setq font-lock-keywords
1402           (list
1403
1404            ;; Handle the keywords defined above.
1405            (list (concat "\\<\\(" c-keywords "\\)\\>")
1406                  '(0 font-lock-keyword-face))
1407
1408            ;; Handle numbers too.
1409            ;;
1410            ;; The following isn't quite right, but it's close enough.
1411            (list (concat "\\<\\("
1412                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1413                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1414                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1415                          "[uUlL]*")
1416                  '(0 mdw-number-face))
1417
1418            ;; And anything else is punctuation.
1419            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1420                  '(0 mdw-punct-face)))))
1421
1422   (mdw-post-config-mode-hack))
1423
1424 ;;;--------------------------------------------------------------------------
1425 ;;; Perl programming style.
1426
1427 ;; Perl indentation style.
1428
1429 (setq cperl-indent-level 2)
1430 (setq cperl-continued-statement-offset 2)
1431 (setq cperl-continued-brace-offset 0)
1432 (setq cperl-brace-offset -2)
1433 (setq cperl-brace-imaginary-offset 0)
1434 (setq cperl-label-offset 0)
1435
1436 ;; Define perl fontification style.
1437
1438 (defun mdw-fontify-perl ()
1439
1440   ;; Miscellaneous fiddling.
1441   (modify-syntax-entry ?$ "\\")
1442   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1443   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1444
1445   ;; Now define fontification things.
1446   (make-local-variable 'font-lock-keywords)
1447   (let ((perl-keywords
1448          (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1449                       "for" "foreach" "ge" "gt" "goto" "if"
1450                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1451                       "package" "redo" "require" "return" "sub"
1452                       "undef" "unless" "until" "use" "while")))
1453
1454     (setq font-lock-keywords
1455           (list
1456
1457            ;; Set up the keywords defined above.
1458            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1459                  '(0 font-lock-keyword-face))
1460
1461            ;; At least numbers are simpler than C.
1462            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1463                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1464                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1465                  '(0 mdw-number-face))
1466
1467            ;; And anything else is punctuation.
1468            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1469                  '(0 mdw-punct-face)))))
1470
1471   (mdw-post-config-mode-hack))
1472
1473 (defun perl-number-tests (&optional arg)
1474   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1475 strip numbers instead."
1476   (interactive "P")
1477   (save-excursion
1478     (goto-char (point-min))
1479     (let ((i 0) (fmt (if arg "" " %4d")))
1480       (while (search-forward "#t" nil t)
1481         (delete-region (point) (line-end-position))
1482         (setq i (1+ i))
1483         (insert (format fmt i)))
1484       (goto-char (point-min))
1485       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1486           (replace-match (format "\\1%d" i))))))
1487
1488 ;;;--------------------------------------------------------------------------
1489 ;;; Python programming style.
1490
1491 (defun mdw-fontify-pythonic (keywords)
1492
1493   ;; Miscellaneous fiddling.
1494   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1495
1496   ;; Now define fontification things.
1497   (make-local-variable 'font-lock-keywords)
1498   (setq font-lock-keywords
1499         (list
1500
1501          ;; Set up the keywords defined above.
1502          (list (concat "\\<\\(" keywords "\\)\\>")
1503                '(0 font-lock-keyword-face))
1504
1505          ;; At least numbers are simpler than C.
1506          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1507                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1508                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1509                '(0 mdw-number-face))
1510
1511          ;; And anything else is punctuation.
1512          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1513                '(0 mdw-punct-face))))
1514
1515   (mdw-post-config-mode-hack))
1516
1517 ;; Define Python fontification styles.
1518
1519 (defun mdw-fontify-python ()
1520   (mdw-fontify-pythonic
1521    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1522                 "del" "elif" "else" "except" "exec" "finally" "for"
1523                 "from" "global" "if" "import" "in" "is" "lambda"
1524                 "not" "or" "pass" "print" "raise" "return" "try"
1525                 "while" "with" "yield")))
1526
1527 (defun mdw-fontify-pyrex ()
1528   (mdw-fontify-pythonic
1529    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
1530                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
1531                 "extern" "finally" "for" "from" "global" "if"
1532                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
1533                 "raise" "return" "struct" "try" "while" "with"
1534                 "yield")))
1535
1536 ;;;--------------------------------------------------------------------------
1537 ;;; Icon programming style.
1538
1539 ;; Icon indentation style.
1540
1541 (setq icon-brace-offset 0
1542       icon-continued-brace-offset 0
1543       icon-continued-statement-offset 2
1544       icon-indent-level 2)
1545
1546 ;; Define Icon fontification style.
1547
1548 (defun mdw-fontify-icon ()
1549
1550   ;; Miscellaneous fiddling.
1551   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1552
1553   ;; Now define fontification things.
1554   (make-local-variable 'font-lock-keywords)
1555   (let ((icon-keywords
1556          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1557                       "end" "every" "fail" "global" "if" "initial"
1558                       "invocable" "link" "local" "next" "not" "of"
1559                       "procedure" "record" "repeat" "return" "static"
1560                       "suspend" "then" "to" "until" "while"))
1561         (preprocessor-keywords
1562          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1563                       "include" "line" "undef")))
1564     (setq font-lock-keywords
1565           (list
1566
1567            ;; Set up the keywords defined above.
1568            (list (concat "\\<\\(" icon-keywords "\\)\\>")
1569                  '(0 font-lock-keyword-face))
1570
1571            ;; The things that Icon calls keywords.
1572            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1573
1574            ;; At least numbers are simpler than C.
1575            (list (concat "\\<[0-9]+"
1576                          "\\([rR][0-9a-zA-Z]+\\|"
1577                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1578                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1579                  '(0 mdw-number-face))
1580
1581            ;; Preprocessor.
1582            (list (concat "^[ \t]*$[ \t]*\\<\\("
1583                          preprocessor-keywords
1584                          "\\)\\>")
1585                  '(0 font-lock-keyword-face))
1586
1587            ;; And anything else is punctuation.
1588            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1589                  '(0 mdw-punct-face)))))
1590
1591   (mdw-post-config-mode-hack))
1592
1593 ;;;--------------------------------------------------------------------------
1594 ;;; ARM assembler programming configuration.
1595
1596 ;; There doesn't appear to be an Emacs mode for this yet.
1597 ;;
1598 ;; Better do something about that, I suppose.
1599
1600 (defvar arm-assembler-mode-map nil)
1601 (defvar arm-assembler-abbrev-table nil)
1602 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1603
1604 (or arm-assembler-mode-map
1605     (progn
1606       (setq arm-assembler-mode-map (make-sparse-keymap))
1607       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1608       (define-key arm-assembler-mode-map [C-return] 'newline)
1609       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1610
1611 (defun arm-assembler-mode ()
1612   "Major mode for ARM assembler programs"
1613   (interactive)
1614
1615   ;; Do standard major mode things.
1616   (kill-all-local-variables)
1617   (use-local-map arm-assembler-mode-map)
1618   (setq local-abbrev-table arm-assembler-abbrev-table)
1619   (setq major-mode 'arm-assembler-mode)
1620   (setq mode-name "ARM assembler")
1621
1622   ;; Set up syntax table.
1623   (set-syntax-table arm-assembler-mode-syntax-table)
1624   (modify-syntax-entry ?;   ; Nasty hack
1625                        "<" arm-assembler-mode-syntax-table)
1626   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1627   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1628
1629   (make-local-variable 'comment-start)
1630   (setq comment-start ";")
1631   (make-local-variable 'comment-end)
1632   (setq comment-end "")
1633   (make-local-variable 'comment-column)
1634   (setq comment-column 48)
1635   (make-local-variable 'comment-start-skip)
1636   (setq comment-start-skip ";+[ \t]*")
1637
1638   ;; Play with indentation.
1639   (make-local-variable 'indent-line-function)
1640   (setq indent-line-function 'indent-relative-maybe)
1641
1642   ;; Set fill prefix.
1643   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1644
1645   ;; Fiddle with fontification.
1646   (make-local-variable 'font-lock-keywords)
1647   (setq font-lock-keywords
1648         (list
1649
1650          ;; Handle numbers too.
1651          ;;
1652          ;; The following isn't quite right, but it's close enough.
1653          (list (concat "\\("
1654                        "&[0-9a-fA-F]+\\|"
1655                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1656                        "\\)")
1657                '(0 mdw-number-face))
1658
1659          ;; Do something about operators.
1660          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1661                '(1 font-lock-keyword-face)
1662                '(2 font-lock-string-face))
1663          (list ":[a-zA-Z]+:"
1664                '(0 font-lock-keyword-face))
1665
1666          ;; Do menemonics and directives.
1667          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1668                '(1 font-lock-keyword-face))
1669
1670          ;; And anything else is punctuation.
1671          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1672                '(0 mdw-punct-face)))
1673
1674   (mdw-post-config-mode-hack))
1675   (run-hooks 'arm-assembler-mode-hook))
1676
1677 ;;;--------------------------------------------------------------------------
1678 ;;; Assembler mode.
1679
1680 (defun mdw-fontify-asm ()
1681   (modify-syntax-entry ?' "\"")
1682   (modify-syntax-entry ?. "w")
1683   (setf fill-prefix nil)
1684   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1685
1686 ;;;--------------------------------------------------------------------------
1687 ;;; TCL configuration.
1688
1689 (defun mdw-fontify-tcl ()
1690   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1691   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1692   (make-local-variable 'font-lock-keywords)
1693   (setq font-lock-keywords
1694         (list
1695          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1696                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1697                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1698                '(0 mdw-number-face))
1699          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1700                '(0 mdw-punct-face))))
1701   (mdw-post-config-mode-hack))
1702
1703 ;;;--------------------------------------------------------------------------
1704 ;;; REXX configuration.
1705
1706 (defun mdw-rexx-electric-* ()
1707   (interactive)
1708   (insert ?*)
1709   (rexx-indent-line))
1710
1711 (defun mdw-rexx-indent-newline-indent ()
1712   (interactive)
1713   (rexx-indent-line)
1714   (if abbrev-mode (expand-abbrev))
1715   (newline-and-indent))
1716
1717 (defun mdw-fontify-rexx ()
1718
1719   ;; Various bits of fiddling.
1720   (setq mdw-auto-indent nil)
1721   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1722   (local-set-key [?*] 'mdw-rexx-electric-*)
1723   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1724           '(?! ?? ?# ?@ ?$))
1725   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1726
1727   ;; Set up keywords and things for fontification.
1728   (make-local-variable 'font-lock-keywords-case-fold-search)
1729   (setq font-lock-keywords-case-fold-search t)
1730
1731   (setq rexx-indent 2)
1732   (setq rexx-end-indent rexx-indent)
1733   (setq rexx-cont-indent rexx-indent)
1734
1735   (make-local-variable 'font-lock-keywords)
1736   (let ((rexx-keywords
1737          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1738                       "else" "end" "engineering" "exit" "expose" "for"
1739                       "forever" "form" "fuzz" "if" "interpret" "iterate"
1740                       "leave" "linein" "name" "nop" "numeric" "off" "on"
1741                       "options" "otherwise" "parse" "procedure" "pull"
1742                       "push" "queue" "return" "say" "select" "signal"
1743                       "scientific" "source" "then" "trace" "to" "until"
1744                       "upper" "value" "var" "version" "when" "while"
1745                       "with"
1746
1747                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1748                       "center" "center" "charin" "charout" "chars"
1749                       "compare" "condition" "copies" "c2d" "c2x"
1750                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
1751                       "errortext" "format" "fuzz" "insert" "lastpos"
1752                       "left" "length" "lineout" "lines" "max" "min"
1753                       "overlay" "pos" "queued" "random" "reverse" "right"
1754                       "sign" "sourceline" "space" "stream" "strip"
1755                       "substr" "subword" "symbol" "time" "translate"
1756                       "trunc" "value" "verify" "word" "wordindex"
1757                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1758                       "x2d")))
1759
1760     (setq font-lock-keywords
1761           (list
1762
1763            ;; Set up the keywords defined above.
1764            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1765                  '(0 font-lock-keyword-face))
1766
1767            ;; Fontify all symbols the same way.
1768            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1769                          "[A-Za-z0-9.!?_#@$]+\\)")
1770                  '(0 font-lock-variable-name-face))
1771
1772            ;; And everything else is punctuation.
1773            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1774                  '(0 mdw-punct-face)))))
1775
1776   (mdw-post-config-mode-hack))
1777
1778 ;;;--------------------------------------------------------------------------
1779 ;;; Standard ML programming style.
1780
1781 (defun mdw-fontify-sml ()
1782
1783   ;; Make underscore an honorary letter.
1784   (modify-syntax-entry ?' "w")
1785
1786   ;; Set fill prefix.
1787   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1788
1789   ;; Now define fontification things.
1790   (make-local-variable 'font-lock-keywords)
1791   (let ((sml-keywords
1792          (mdw-regexps "abstype" "and" "andalso" "as"
1793                       "case"
1794                       "datatype" "do"
1795                       "else" "end" "eqtype" "exception"
1796                       "fn" "fun" "functor"
1797                       "handle"
1798                       "if" "in" "include" "infix" "infixr"
1799                       "let" "local"
1800                       "nonfix"
1801                       "of" "op" "open" "orelse"
1802                       "raise" "rec"
1803                       "sharing" "sig" "signature" "struct" "structure"
1804                       "then" "type"
1805                       "val"
1806                       "where" "while" "with" "withtype")))
1807
1808     (setq font-lock-keywords
1809           (list
1810
1811            ;; Set up the keywords defined above.
1812            (list (concat "\\<\\(" sml-keywords "\\)\\>")
1813                  '(0 font-lock-keyword-face))
1814
1815            ;; At least numbers are simpler than C.
1816            (list (concat "\\<\\(\\~\\|\\)"
1817                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
1818                                    "[wW][0-9]+\\)\\|"
1819                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1820                                          "\\([eE]\\(\\~\\|\\)"
1821                                                 "[0-9]+\\|\\)\\)\\)")
1822                  '(0 mdw-number-face))
1823
1824            ;; And anything else is punctuation.
1825            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1826                  '(0 mdw-punct-face)))))
1827
1828   (mdw-post-config-mode-hack))
1829
1830 ;;;--------------------------------------------------------------------------
1831 ;;; Haskell configuration.
1832
1833 (defun mdw-fontify-haskell ()
1834
1835   ;; Fiddle with syntax table to get comments right.
1836   (modify-syntax-entry ?' "\"")
1837   (modify-syntax-entry ?- ". 123")
1838   (modify-syntax-entry ?{ ". 1b")
1839   (modify-syntax-entry ?} ". 4b")
1840   (modify-syntax-entry ?\n ">")
1841
1842   ;; Set fill prefix.
1843   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1844
1845   ;; Fiddle with fontification.
1846   (make-local-variable 'font-lock-keywords)
1847   (let ((haskell-keywords
1848          (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1849                       "deriving" "do" "else" "foreign" "hiding" "if"
1850                       "import" "in" "infix" "infixl" "infixr" "instance"
1851                       "let" "module" "newtype" "of" "qualified" "safe"
1852                       "stdcall" "then" "type" "unsafe" "where")))
1853
1854     (setq font-lock-keywords
1855           (list
1856            (list "--.*$"
1857                  '(0 font-lock-comment-face))
1858            (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1859                  '(0 font-lock-keyword-face))
1860            (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1861                          "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1862                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1863                  '(0 mdw-number-face))
1864            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1865                  '(0 mdw-punct-face)))))
1866
1867   (mdw-post-config-mode-hack))
1868
1869 ;;;--------------------------------------------------------------------------
1870 ;;; Erlang configuration.
1871
1872 (setq erlang-electric-commannds
1873       '(erlang-electric-newline erlang-electric-semicolon))
1874
1875 (defun mdw-fontify-erlang ()
1876
1877   ;; Set fill prefix.
1878   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
1879
1880   ;; Fiddle with fontification.
1881   (make-local-variable 'font-lock-keywords)
1882   (let ((erlang-keywords
1883          (mdw-regexps "after" "and" "andalso"
1884                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
1885                       "case" "catch" "cond"
1886                       "div" "end" "fun" "if" "let" "not"
1887                       "of" "or" "orelse"
1888                       "query" "receive" "rem" "try" "when" "xor")))
1889
1890     (setq font-lock-keywords
1891           (list
1892            (list "%.*$"
1893                  '(0 font-lock-comment-face))
1894            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
1895                  '(0 font-lock-keyword-face))
1896            (list (concat "^-\\sw+\\>")
1897                  '(0 font-lock-keyword-face))
1898            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
1899                  '(0 mdw-number-face))
1900            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1901                  '(0 mdw-punct-face)))))
1902
1903   (mdw-post-config-mode-hack))
1904
1905 ;;;--------------------------------------------------------------------------
1906 ;;; Texinfo configuration.
1907
1908 (defun mdw-fontify-texinfo ()
1909
1910   ;; Set fill prefix.
1911   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1912
1913   ;; Real fontification things.
1914   (make-local-variable 'font-lock-keywords)
1915   (setq font-lock-keywords
1916         (list
1917
1918          ;; Environment names are keywords.
1919          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
1920                '(2 font-lock-keyword-face))
1921
1922          ;; Unmark escaped magic characters.
1923          (list "\\(@\\)\\([@{}]\\)"
1924                '(1 font-lock-keyword-face)
1925                '(2 font-lock-variable-name-face))
1926
1927          ;; Make sure we get comments properly.
1928          (list "@c\\(\\|omment\\)\\( .*\\)?$"
1929                '(0 font-lock-comment-face))
1930
1931          ;; Command names are keywords.
1932          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1933                '(0 font-lock-keyword-face))
1934
1935          ;; Fontify TeX special characters as punctuation.
1936          (list "[{}]+"
1937                '(0 mdw-punct-face))))
1938
1939   (mdw-post-config-mode-hack))
1940
1941 ;;;--------------------------------------------------------------------------
1942 ;;; TeX and LaTeX configuration.
1943
1944 (defun mdw-fontify-tex ()
1945   (setq ispell-parser 'tex)
1946   (turn-on-reftex)
1947
1948   ;; Don't make maths into a string.
1949   (modify-syntax-entry ?$ ".")
1950   (modify-syntax-entry ?$ "." font-lock-syntax-table)
1951   (local-set-key [?$] 'self-insert-command)
1952
1953   ;; Set fill prefix.
1954   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1955
1956   ;; Real fontification things.
1957   (make-local-variable 'font-lock-keywords)
1958   (setq font-lock-keywords
1959         (list
1960
1961          ;; Environment names are keywords.
1962          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1963                        "{\\([^}\n]*\\)}")
1964                '(2 font-lock-keyword-face))
1965
1966          ;; Suspended environment names are keywords too.
1967          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1968                        "{\\([^}\n]*\\)}")
1969                '(3 font-lock-keyword-face))
1970
1971          ;; Command names are keywords.
1972          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1973                '(0 font-lock-keyword-face))
1974
1975          ;; Handle @/.../ for italics.
1976          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
1977          ;;       '(1 font-lock-keyword-face)
1978          ;;       '(3 font-lock-keyword-face))
1979
1980          ;; Handle @*...* for boldness.
1981          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
1982          ;;       '(1 font-lock-keyword-face)
1983          ;;       '(3 font-lock-keyword-face))
1984
1985          ;; Handle @`...' for literal syntax things.
1986          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
1987          ;;       '(1 font-lock-keyword-face)
1988          ;;       '(3 font-lock-keyword-face))
1989
1990          ;; Handle @<...> for nonterminals.
1991          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
1992          ;;       '(1 font-lock-keyword-face)
1993          ;;       '(3 font-lock-keyword-face))
1994
1995          ;; Handle other @-commands.
1996          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
1997          ;;       '(0 font-lock-keyword-face))
1998
1999          ;; Make sure we get comments properly.
2000          (list "%.*"
2001                '(0 font-lock-comment-face))
2002
2003          ;; Fontify TeX special characters as punctuation.
2004          (list "[$^_{}#&]"
2005                '(0 mdw-punct-face))))
2006
2007   (mdw-post-config-mode-hack))
2008
2009 ;;;--------------------------------------------------------------------------
2010 ;;; SGML hacking.
2011
2012 (defun mdw-sgml-mode ()
2013   (interactive)
2014   (sgml-mode)
2015   (mdw-standard-fill-prefix "")
2016   (make-variable-buffer-local 'sgml-delimiters)
2017   (setq sgml-delimiters
2018         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2019           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2020           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2021           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2022           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2023           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2024           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2025           "NULL" ""))
2026   (setq major-mode 'mdw-sgml-mode)
2027   (setq mode-name "[mdw] SGML")
2028   (run-hooks 'mdw-sgml-mode-hook))
2029
2030 ;;;--------------------------------------------------------------------------
2031 ;;; Shell scripts.
2032
2033 (defun mdw-setup-sh-script-mode ()
2034
2035   ;; Fetch the shell interpreter's name.
2036   (let ((shell-name sh-shell-file))
2037
2038     ;; Try reading the hash-bang line.
2039     (save-excursion
2040       (goto-char (point-min))
2041       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2042           (setq shell-name (match-string 1))))
2043
2044     ;; Now try to set the shell.
2045     ;;
2046     ;; Don't let `sh-set-shell' bugger up my script.
2047     (let ((executable-set-magic #'(lambda (s &rest r) s)))
2048       (sh-set-shell shell-name)))
2049
2050   ;; Now enable my keys and the fontification.
2051   (mdw-misc-mode-config)
2052
2053   ;; Set the indentation level correctly.
2054   (setq sh-indentation 2)
2055   (setq sh-basic-offset 2))
2056
2057 ;;;--------------------------------------------------------------------------
2058 ;;; Emacs shell mode.
2059
2060 (defun mdw-eshell-prompt ()
2061   (let ((left "[") (right "]"))
2062     (when (= (user-uid) 0)
2063       (setq left "«" right "»"))
2064     (concat left
2065             (save-match-data
2066               (replace-regexp-in-string "\\..*$" "" (system-name)))
2067             " "
2068             (eshell/pwd)
2069             right)))
2070 (setq eshell-prompt-function 'mdw-eshell-prompt)
2071 (setq eshell-prompt-regexp "^\\[[^]]+\\]")
2072
2073 (mdw-define-face eshell-prompt (t :weight bold))
2074 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2075 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2076 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2077 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2078 (mdw-define-face eshell-ls-executable (t :weight bold))
2079 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2080 (mdw-define-face eshell-ls-readonly (t nil))
2081 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2082
2083 ;;;--------------------------------------------------------------------------
2084 ;;; Messages-file mode.
2085
2086 (defun messages-mode-guts ()
2087   (setq messages-mode-syntax-table (make-syntax-table))
2088   (set-syntax-table messages-mode-syntax-table)
2089   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2090   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2091   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2092   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2093   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2094   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2095   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2096   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2097   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2098   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2099   (make-local-variable 'comment-start)
2100   (make-local-variable 'comment-end)
2101   (make-local-variable 'indent-line-function)
2102   (setq indent-line-function 'indent-relative)
2103   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2104   (make-local-variable 'font-lock-defaults)
2105   (make-local-variable 'messages-mode-keywords)
2106   (let ((keywords
2107          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2108                       "export" "enum" "fixed-octetstring" "flags"
2109                       "harmless" "map" "nested" "optional"
2110                       "optional-tagged" "package" "primitive"
2111                       "primitive-nullfree" "relaxed[ \t]+enum"
2112                       "set" "table" "tagged-optional"   "union"
2113                       "variadic" "vector" "version" "version-tag")))
2114     (setq messages-mode-keywords
2115           (list
2116            (list (concat "\\<\\(" keywords "\\)\\>:")
2117                  '(0 font-lock-keyword-face))
2118            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2119            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2120              (0 font-lock-variable-name-face))
2121            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2122            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2123              (0 mdw-punct-face)))))
2124   (setq font-lock-defaults
2125         '(messages-mode-keywords nil nil nil nil))
2126   (run-hooks 'messages-file-hook))
2127
2128 (defun messages-mode ()
2129   (interactive)
2130   (fundamental-mode)
2131   (setq major-mode 'messages-mode)
2132   (setq mode-name "Messages")
2133   (messages-mode-guts)
2134   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2135   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2136   (setq comment-start "# ")
2137   (setq comment-end "")
2138   (turn-on-font-lock-if-enabled)
2139   (run-hooks 'messages-mode-hook))
2140
2141 (defun cpp-messages-mode ()
2142   (interactive)
2143   (fundamental-mode)
2144   (setq major-mode 'cpp-messages-mode)
2145   (setq mode-name "CPP Messages")
2146   (messages-mode-guts)
2147   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2148   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2149   (setq comment-start "/* ")
2150   (setq comment-end " */")
2151   (let ((preprocessor-keywords
2152          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2153                       "ident" "if" "ifdef" "ifndef" "import" "include"
2154                       "line" "pragma" "unassert" "undef" "warning")))
2155     (setq messages-mode-keywords
2156           (append (list (list (concat "^[ \t]*\\#[ \t]*"
2157                                       "\\(include\\|import\\)"
2158                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2159                               '(2 font-lock-string-face))
2160                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2161                                       preprocessor-keywords
2162                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
2163                               '(1 font-lock-keyword-face)))
2164                   messages-mode-keywords)))
2165   (turn-on-font-lock-if-enabled)
2166   (run-hooks 'cpp-messages-mode-hook))
2167
2168 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2169 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2170 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2171
2172 ;;;--------------------------------------------------------------------------
2173 ;;; Messages-file mode.
2174
2175 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2176   "Face to use for subsittution directives.")
2177 (make-face 'mallow-driver-substitution-face)
2178 (defvar mallow-driver-text-face 'mallow-driver-text-face
2179   "Face to use for body text.")
2180 (make-face 'mallow-driver-text-face)
2181
2182 (defun mallow-driver-mode ()
2183   (interactive)
2184   (fundamental-mode)
2185   (setq major-mode 'mallow-driver-mode)
2186   (setq mode-name "Mallow driver")
2187   (setq mallow-driver-mode-syntax-table (make-syntax-table))
2188   (set-syntax-table mallow-driver-mode-syntax-table)
2189   (make-local-variable 'comment-start)
2190   (make-local-variable 'comment-end)
2191   (make-local-variable 'indent-line-function)
2192   (setq indent-line-function 'indent-relative)
2193   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2194   (make-local-variable 'font-lock-defaults)
2195   (make-local-variable 'mallow-driver-mode-keywords)
2196   (let ((keywords
2197          (mdw-regexps "each" "divert" "file" "if"
2198                       "perl" "set" "string" "type" "write")))
2199     (setq mallow-driver-mode-keywords
2200           (list
2201            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2202                  '(0 font-lock-keyword-face))
2203            (list "^%\\s *\\(#.*\\|\\)$"
2204                  '(0 font-lock-comment-face))
2205            (list "^%"
2206                  '(0 font-lock-keyword-face))
2207            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2208            (list "\\${[^}]*}"
2209                  '(0 mallow-driver-substitution-face t)))))
2210   (setq font-lock-defaults
2211         '(mallow-driver-mode-keywords nil nil nil nil))
2212   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2213   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2214   (setq comment-start "%# ")
2215   (setq comment-end "")
2216   (turn-on-font-lock-if-enabled)
2217   (run-hooks 'mallow-driver-mode-hook))
2218
2219 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2220
2221 ;;;--------------------------------------------------------------------------
2222 ;;; NFast debugs.
2223
2224 (defun nfast-debug-mode ()
2225   (interactive)
2226   (fundamental-mode)
2227   (setq major-mode 'nfast-debug-mode)
2228   (setq mode-name "NFast debug")
2229   (setq messages-mode-syntax-table (make-syntax-table))
2230   (set-syntax-table messages-mode-syntax-table)
2231   (make-local-variable 'font-lock-defaults)
2232   (make-local-variable 'nfast-debug-mode-keywords)
2233   (setq truncate-lines t)
2234   (setq nfast-debug-mode-keywords
2235         (list
2236          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2237            (0 font-lock-keyword-face))
2238          (list (concat "^[ \t]+\\(\\("
2239                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2240                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2241                        "[ \t]+\\)*"
2242                        "[0-9a-fA-F]+\\)[ \t]*$")
2243            '(0 mdw-number-face))
2244          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2245            (1 font-lock-keyword-face))
2246          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2247            (1 font-lock-warning-face))
2248          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2249            (1 nil))
2250          (list (concat "^[ \t]+\\.cmd=[ \t]+"
2251                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2252            '(1 font-lock-keyword-face))
2253          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2254          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2255          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2256          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2257   (setq font-lock-defaults
2258         '(nfast-debug-mode-keywords nil nil nil nil))
2259   (turn-on-font-lock-if-enabled)
2260   (run-hooks 'nfast-debug-mode-hook))
2261
2262 ;;;--------------------------------------------------------------------------
2263 ;;; Other languages.
2264
2265 ;; Smalltalk.
2266
2267 (defun mdw-setup-smalltalk ()
2268   (and mdw-auto-indent
2269        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2270   (make-variable-buffer-local 'mdw-auto-indent)
2271   (setq mdw-auto-indent nil)
2272   (local-set-key "\C-i" 'smalltalk-reindent))
2273
2274 (defun mdw-fontify-smalltalk ()
2275   (make-local-variable 'font-lock-keywords)
2276   (setq font-lock-keywords
2277         (list
2278          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2279                '(0 font-lock-keyword-face))
2280          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2281                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2282                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2283                '(0 mdw-number-face))
2284          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2285                '(0 mdw-punct-face))))
2286   (mdw-post-config-mode-hack))
2287
2288 ;; Lispy languages.
2289
2290 ;; Unpleasant bodge.
2291 (unless (boundp 'slime-repl-mode-map)
2292   (setq slime-repl-mode-map (make-sparse-keymap)))
2293
2294 (defun mdw-indent-newline-and-indent ()
2295   (interactive)
2296   (indent-for-tab-command)
2297   (newline-and-indent))
2298
2299 (eval-after-load "cl-indent"
2300   '(progn
2301      (mapc #'(lambda (pair)
2302                (put (car pair)
2303                     'common-lisp-indent-function
2304                     (cdr pair)))
2305       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2306         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2307
2308 (defun mdw-common-lisp-indent ()
2309   (make-variable-buffer-local 'lisp-indent-function)
2310   (setq lisp-indent-function 'common-lisp-indent-function))
2311
2312 (setq lisp-simple-loop-indentation 2
2313       lisp-loop-keyword-indentation 6
2314       lisp-loop-forms-indentation 6)
2315
2316 (defun mdw-fontify-lispy ()
2317
2318   ;; Set fill prefix.
2319   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2320
2321   ;; Not much fontification needed.
2322   (make-local-variable 'font-lock-keywords)
2323   (setq font-lock-keywords
2324         (list
2325          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2326                '(0 mdw-punct-face))))
2327
2328   (mdw-post-config-mode-hack))
2329
2330 (defun comint-send-and-indent ()
2331   (interactive)
2332   (comint-send-input)
2333   (and mdw-auto-indent
2334        (indent-for-tab-command)))
2335
2336 (defun mdw-setup-m4 ()
2337   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2338
2339 ;;;--------------------------------------------------------------------------
2340 ;;; Text mode.
2341
2342 (defun mdw-text-mode ()
2343   (setq fill-column 72)
2344   (flyspell-mode t)
2345   (mdw-standard-fill-prefix
2346    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2347   (auto-fill-mode 1))
2348
2349 ;;;--------------------------------------------------------------------------
2350 ;;; Outline and hide/show modes.
2351
2352 (defun mdw-outline-collapse-all ()
2353   "Completely collapse everything in the entire buffer."
2354   (interactive)
2355   (save-excursion
2356     (goto-char (point-min))
2357     (while (< (point) (point-max))
2358       (hide-subtree)
2359       (forward-line))))
2360
2361 (setq hs-hide-comments-when-hiding-all nil)
2362
2363 (defadvice hs-hide-all (after hide-first-comment activate)
2364   (save-excursion (hs-hide-initial-comment-block)))
2365
2366 ;;;--------------------------------------------------------------------------
2367 ;;; Shell mode.
2368
2369 (defun mdw-sh-mode-setup ()
2370   (local-set-key [?\C-a] 'comint-bol)
2371   (add-hook 'comint-output-filter-functions
2372             'comint-watch-for-password-prompt))
2373
2374 (defun mdw-term-mode-setup ()
2375   (setq term-prompt-regexp shell-prompt-pattern)
2376   (make-local-variable 'mouse-yank-at-point)
2377   (make-local-variable 'transient-mark-mode)
2378   (setq mouse-yank-at-point t)
2379   (auto-fill-mode -1)
2380   (setq tab-width 8))
2381
2382 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2383 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
2384 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2385 (defun term-send-meta-meta-something ()
2386   (interactive)
2387   (term-send-raw-string "\e\e")
2388   (term-send-raw))
2389 (eval-after-load 'term
2390   '(progn
2391      (define-key term-raw-map [?\e ?\e] nil)
2392      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2393      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2394      (define-key term-raw-map [M-right] 'term-send-meta-right)
2395      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2396      (define-key term-raw-map [M-left] 'term-send-meta-left)
2397      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2398
2399 ;;;--------------------------------------------------------------------------
2400 ;;; Inferior Emacs Lisp.
2401
2402 (setq comint-prompt-read-only t)
2403
2404 (eval-after-load "comint"
2405   '(progn
2406      (define-key comint-mode-map "\C-w" 'comint-kill-region)
2407      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
2408
2409 (eval-after-load "ielm"
2410   '(progn
2411      (define-key ielm-map "\C-w" 'comint-kill-region)
2412      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
2413
2414 ;;;----- That's all, folks --------------------------------------------------
2415
2416 (provide 'dot-emacs)