chiark - git - mdw - profile/blob - el/dot-emacs.el

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