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