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

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