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