mdw@git.distorted.org.uk Git - profile/blob - dot-emacs.el

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