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

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