chiark - git - mdw - profile/blob - dot-emacs.el

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