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