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