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