chiark - git - mdw - profile/blob - el/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 ;;;--------------------------------------------------------------------------
  25 ;;; Check command-line.
  26
  27 (defvar mdw-fast-startup nil
  28   "Whether .emacs should optimize for rapid startup.
  29 This may be at the expense of cool features.")
  30 (let ((probe nil) (next command-line-args))
  31   (while next
  32     (cond ((string= (car next) "--mdw-fast-startup")
  33            (setq mdw-fast-startup t)
  34            (if probe
  35                (rplacd probe (cdr next))
  36              (setq command-line-args (cdr next))))
  37           (t
  38            (setq probe next)))
  39     (setq next (cdr next))))
  40
  41 ;;;--------------------------------------------------------------------------
  42 ;;; Some general utilities.
  43
  44 (eval-when-compile
  45   (unless (fboundp 'make-regexp)
  46     (load "make-regexp"))
  47   (require 'cl))
  48
  49 (defmacro mdw-regexps (&rest list)
  50   "Turn a LIST of strings into a single regular expression at compile-time."
  51   (declare (indent nil)
  52            (debug 0))
  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   (declare (indent 0)
  63            (debug t))
  64   `(condition-case err
  65        ,(if (cdr forms) (cons 'progn forms) (car forms))
  66      (error (message "Error (trapped): %s in %s"
  67                      (error-message-string err)
  68                      ',forms))))
  69
  70 ;; Configuration reading.
  71
  72 (defvar mdw-config nil)
  73 (defun mdw-config (sym)
  74   "Read the configuration variable named SYM."
  75   (unless mdw-config
  76     (setq mdw-config
  77           (flet ((replace (what with)
  78                    (goto-char (point-min))
  79                    (while (re-search-forward what nil t)
  80                      (replace-match with t))))
  81             (with-temp-buffer
  82               (insert-file-contents "~/.mdw.conf")
  83               (replace  "^[ \t]*\\(#.*\\|\\)\n" "")
  84               (replace (concat "^[ \t]*"
  85                                "\\([-a-zA-Z0-9_.]*\\)"
  86                                "[ \t]*=[ \t]*"
  87                                "\\(.*[^ \t\n]\\|\\)"
  88                                "[ \t]**\\(\n\\|$\\)")
  89                        "(\\1 . \"\\2\")\n")
  90               (car (read-from-string
  91                     (concat "(" (buffer-string) ")")))))))
  92   (cdr (assq sym mdw-config)))
  93
  94 ;; Set up the load path convincingly.
  95
  96 (dolist (dir (append (and (boundp 'debian-emacs-flavor)
  97                           (list (concat "/usr/share/"
  98                                         (symbol-name debian-emacs-flavor)
  99                                         "/site-lisp")))))
 100   (dolist (sub (directory-files dir t))
 101     (when (and (file-accessible-directory-p sub)
 102                (not (member sub load-path)))
 103       (setq load-path (nconc load-path (list sub))))))
 104
 105 ;; Is an Emacs library available?
 106
 107 (defun library-exists-p (name)
 108   "Return non-nil if NAME is an available library.
 109 Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
 110 load path.  The non-nil value is the filename we found for the
 111 library."
 112   (let ((path load-path) elt (foundp nil))
 113     (while (and path (not foundp))
 114       (setq elt (car path))
 115       (setq path (cdr path))
 116       (setq foundp (or (let ((file (concat elt "/" name ".elc")))
 117                          (and (file-exists-p file) file))
 118                        (let ((file (concat elt "/" name ".el")))
 119                          (and (file-exists-p file) file)))))
 120     foundp))
 121
 122 (defun maybe-autoload (symbol file &optional docstring interactivep type)
 123   "Set an autoload if the file actually exists."
 124   (and (library-exists-p file)
 125        (autoload symbol file docstring interactivep type)))
 126
 127 (defun mdw-kick-menu-bar (&optional frame)
 128   "Regenerate FRAME's menu bar so it doesn't have empty menus."
 129   (interactive)
 130   (unless frame (setq frame (selected-frame)))
 131   (let ((old (frame-parameter frame 'menu-bar-lines)))
 132     (set-frame-parameter frame 'menu-bar-lines 0)
 133     (set-frame-parameter frame 'menu-bar-lines old)))
 134
 135 ;; Splitting windows.
 136
 137 (unless (fboundp 'scroll-bar-columns)
 138   (defun scroll-bar-columns (side)
 139     (cond ((eq side 'left) 0)
 140           (window-system 3)
 141           (t 1))))
 142 (unless (fboundp 'fringe-columns)
 143   (defun fringe-columns (side)
 144     (cond ((not window-system) 0)
 145           ((eq side 'left) 1)
 146           (t 2))))
 147
 148 (defun mdw-horizontal-window-overhead ()
 149   "Computes the horizontal window overhead.
 150 This is the number of columns used by fringes, scroll bars and other such
 151 cruft."
 152   (if (not window-system)
 153       1
 154     (let ((tot 0))
 155       (dolist (what '(scroll-bar fringe))
 156         (dolist (side '(left right))
 157           (incf tot (funcall (intern (concat (symbol-name what) "-columns"))
 158                              side))))
 159       tot)))
 160
 161 (defun mdw-split-window-horizontally (&optional width)
 162   "Split a window horizontally.
 163 Without a numeric argument, split the window approximately in
 164 half.  With a numeric argument WIDTH, allocate WIDTH columns to
 165 the left-hand window (if positive) or -WIDTH columns to the
 166 right-hand window (if negative).  Space for scroll bars and
 167 fringes is not taken out of the allowance for WIDTH, unlike
 168 \\[split-window-horizontally]."
 169   (interactive "P")
 170   (split-window-horizontally
 171    (cond ((null width) nil)
 172          ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
 173          ((< width 0) width))))
 174
 175 (defun mdw-divvy-window (&optional width)
 176   "Split a wide window into appropriate widths."
 177   (interactive "P")
 178   (setq width (cond (width (prefix-numeric-value width))
 179                     ((and window-system
 180                           (>= emacs-major-version 22))
 181                      77)
 182                     (t 78)))
 183   (let* ((win (selected-window))
 184          (sb-width (mdw-horizontal-window-overhead))
 185          (c (/ (+ (window-width) sb-width)
 186                (+ width sb-width))))
 187     (while (> c 1)
 188       (setq c (1- c))
 189       (split-window-horizontally (+ width sb-width))
 190       (other-window 1))
 191     (select-window win)))
 192
 193 ;; Transient mark mode hacks.
 194
 195 (defadvice exchange-point-and-mark
 196     (around mdw-highlight (&optional arg) activate compile)
 197   "Maybe don't actually exchange point and mark.
 198 If `transient-mark-mode' is on and the mark is inactive, then
 199 just activate it.  A non-trivial prefix argument will force the
 200 usual behaviour.  A trivial prefix argument (i.e., just C-u) will
 201 activate the mark and temporarily enable `transient-mark-mode' if
 202 it's currently off."
 203   (cond ((or mark-active
 204              (and (not transient-mark-mode) (not arg))
 205              (and arg (or (not (consp arg))
 206                           (not (= (car arg) 4)))))
 207          ad-do-it)
 208         (t
 209          (or transient-mark-mode (setq transient-mark-mode 'only))
 210          (set-mark (mark t)))))
 211
 212 ;; Functions for sexp diary entries.
 213
 214 (defun mdw-weekday (l)
 215   "Return non-nil if `date' falls on one of the days of the week in L.
 216 L is a list of day numbers (from 0 to 6 for Sunday through to
 217 Saturday) or symbols `sunday', `monday', etc. (or a mixture).  If
 218 the date stored in `date' falls on a listed day, then the
 219 function returns non-nil."
 220   (let ((d (calendar-day-of-week date)))
 221     (or (memq d l)
 222         (memq (nth d '(sunday monday tuesday wednesday
 223                               thursday friday saturday)) l))))
 224
 225 (defun mdw-todo (&optional when)
 226   "Return non-nil today, or on WHEN, whichever is later."
 227   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
 228         (d (calendar-absolute-from-gregorian date)))
 229     (if when
 230         (setq w (max w (calendar-absolute-from-gregorian
 231                         (cond
 232                          ((not european-calendar-style)
 233                           when)
 234                          ((> (car when) 100)
 235                           (list (nth 1 when)
 236                                 (nth 2 when)
 237                                 (nth 0 when)))
 238                          (t
 239                           (list (nth 1 when)
 240                                 (nth 0 when)
 241                                 (nth 2 when))))))))
 242     (eq w d)))
 243
 244 ;; Fighting with Org-mode's evil key maps.
 245
 246 (defvar mdw-evil-keymap-keys
 247   '(([S-up] . [?\C-c up])
 248     ([S-down] . [?\C-c down])
 249     ([S-left] . [?\C-c left])
 250     ([S-right] . [?\C-c right])
 251     (([M-up] [?\e up]) . [C-up])
 252     (([M-down] [?\e down]) . [C-down])
 253     (([M-left] [?\e left]) . [C-left])
 254     (([M-right] [?\e right]) . [C-right]))
 255   "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
 256 The value is an alist mapping evil keys (as a list, or singleton)
 257 to good keys (in the same form).")
 258
 259 (defun mdw-clobber-evil-keymap (keymap)
 260   "Replace evil key bindings in the KEYMAP.
 261 Evil key bindings are defined in `mdw-evil-keymap-keys'."
 262   (dolist (entry mdw-evil-keymap-keys)
 263     (let ((binding nil)
 264           (keys (if (listp (car entry))
 265                     (car entry)
 266                   (list (car entry))))
 267           (replacements (if (listp (cdr entry))
 268                             (cdr entry)
 269                           (list (cdr entry)))))
 270       (catch 'found
 271         (dolist (key keys)
 272           (setq binding (lookup-key keymap key))
 273           (when binding
 274             (throw 'found nil))))
 275       (when binding
 276         (dolist (key keys)
 277           (define-key keymap key nil))
 278         (dolist (key replacements)
 279           (define-key keymap key binding))))))
 280
 281 (eval-after-load "org-latex"
 282   '(progn
 283      (push '("strayman"
 284              "\\documentclass{strayman}
 285 \\usepackage[utf8]{inputenc}
 286 \\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
 287 \\usepackage[T1]{fontenc}
 288 \\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
 289              ("\\section{%s}" . "\\section*{%s}")
 290              ("\\subsection{%s}" . "\\subsection*{%s}")
 291              ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
 292              ("\\paragraph{%s}" . "\\paragraph*{%s}")
 293              ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
 294            org-export-latex-classes)))
 295
 296 (setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i"
 297       org-export-docbook-xsl-fo-proc-command "fop %i.safe %o"
 298       org-export-docbook-xslt-stylesheet
 299       "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl")
 300
 301 ;;;--------------------------------------------------------------------------
 302 ;;; Mail and news hacking.
 303
 304 (define-derived-mode  mdwmail-mode mail-mode "[mdw] mail"
 305   "Major mode for editing news and mail messages from external programs.
 306 Not much right now.  Just support for doing MailCrypt stuff."
 307   :syntax-table nil
 308   :abbrev-table nil
 309   (run-hooks 'mail-setup-hook))
 310
 311 (define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
 312
 313 (add-hook 'mdwail-mode-hook
 314           (lambda ()
 315             (set-buffer-file-coding-system 'utf-8)
 316             (make-local-variable 'paragraph-separate)
 317             (make-local-variable 'paragraph-start)
 318             (setq paragraph-start
 319                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 320                           paragraph-start))
 321             (setq paragraph-separate
 322                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 323                           paragraph-separate))))
 324
 325 ;; How to encrypt in mdwmail.
 326
 327 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
 328   (or start
 329       (setq start (save-excursion
 330                     (goto-char (point-min))
 331                     (or (search-forward "\n\n" nil t) (point-min)))))
 332   (or end
 333       (setq end (point-max)))
 334   (mc-encrypt-generic recip scm start end from sign))
 335
 336 ;; How to sign in mdwmail.
 337
 338 (defun mdwmail-mc-sign (key scm start end uclr)
 339   (or start
 340       (setq start (save-excursion
 341                     (goto-char (point-min))
 342                     (or (search-forward "\n\n" nil t) (point-min)))))
 343   (or end
 344       (setq end (point-max)))
 345   (mc-sign-generic key scm start end uclr))
 346
 347 ;; Some signature mangling.
 348
 349 (defun mdwmail-mangle-signature ()
 350   (save-excursion
 351     (goto-char (point-min))
 352     (perform-replace "\n-- \n" "\n-- " nil nil nil)))
 353 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
 354 (add-hook 'message-setup-hook 'mdwmail-mangle-signature)
 355
 356 ;; Insert my login name into message-ids, so I can score replies.
 357
 358 (defadvice message-unique-id (after mdw-user-name last activate compile)
 359   "Ensure that the user's name appears at the end of the message-id string,
 360 so that it can be used for convenient filtering."
 361   (setq ad-return-value (concat ad-return-value "." (user-login-name))))
 362
 363 ;; Tell my movemail hack where movemail is.
 364 ;;
 365 ;; This is needed to shup up warnings about LD_PRELOAD.
 366
 367 (let ((path exec-path))
 368   (while path
 369     (let ((try (expand-file-name "movemail" (car path))))
 370       (if (file-executable-p try)
 371           (setenv "REAL_MOVEMAIL" try))
 372       (setq path (cdr path)))))
 373
 374 (eval-after-load "erc"
 375     '(load "~/.ercrc.el"))
 376
 377 ;;;--------------------------------------------------------------------------
 378 ;;; Utility functions.
 379
 380 (or (fboundp 'line-number-at-pos)
 381     (defun line-number-at-pos (&optional pos)
 382       (let ((opoint (or pos (point))) start)
 383         (save-excursion
 384           (save-restriction
 385             (goto-char (point-min))
 386             (widen)
 387             (forward-line 0)
 388             (setq start (point))
 389             (goto-char opoint)
 390             (forward-line 0)
 391             (1+ (count-lines 1 (point))))))))
 392
 393 (defun mdw-uniquify-alist (&rest alists)
 394   "Return the concatenation of the ALISTS with duplicate elements removed.
 395 The first association with a given key prevails; others are
 396 ignored.  The input lists are not modified, although they'll
 397 probably become garbage."
 398   (and alists
 399        (let ((start-list (cons nil nil)))
 400          (mdw-do-uniquify start-list
 401                           start-list
 402                           (car alists)
 403                           (cdr alists)))))
 404
 405 (defun mdw-do-uniquify (done end l rest)
 406   "A helper function for mdw-uniquify-alist.
 407 The DONE argument is a list whose first element is `nil'.  It
 408 contains the uniquified alist built so far.  The leading `nil' is
 409 stripped off at the end of the operation; it's only there so that
 410 DONE always references a cons cell.  END refers to the final cons
 411 cell in the DONE list; it is modified in place each time to avoid
 412 the overheads of `append'ing all the time.  The L argument is the
 413 alist we're currently processing; the remaining alists are given
 414 in REST."
 415
 416   ;; There are several different cases to deal with here.
 417   (cond
 418
 419    ;; Current list isn't empty.  Add the first item to the DONE list if
 420    ;; there's not an item with the same KEY already there.
 421    (l (or (assoc (car (car l)) done)
 422           (progn
 423             (setcdr end (cons (car l) nil))
 424             (setq end (cdr end))))
 425       (mdw-do-uniquify done end (cdr l) rest))
 426
 427    ;; The list we were working on is empty.  Shunt the next list into the
 428    ;; current list position and go round again.
 429    (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
 430
 431    ;; Everything's done.  Remove the leading `nil' from the DONE list and
 432    ;; return it.  Finished!
 433    (t (cdr done))))
 434
 435 (defun date ()
 436   "Insert the current date in a pleasing way."
 437   (interactive)
 438   (insert (save-excursion
 439             (let ((buffer (get-buffer-create "*tmp*")))
 440               (unwind-protect (progn (set-buffer buffer)
 441                                      (erase-buffer)
 442                                      (shell-command "date +%Y-%m-%d" t)
 443                                      (goto-char (mark))
 444                                      (delete-backward-char 1)
 445                                      (buffer-string))
 446                 (kill-buffer buffer))))))
 447
 448 (defun uuencode (file &optional name)
 449   "UUencodes a file, maybe calling it NAME, into the current buffer."
 450   (interactive "fInput file name: ")
 451
 452   ;; If NAME isn't specified, then guess from the filename.
 453   (if (not name)
 454       (setq name
 455             (substring file
 456                        (or (string-match "[^/]*$" file) 0))))
 457   (print (format "uuencode `%s' `%s'" file name))
 458
 459   ;; Now actually do the thing.
 460   (call-process "uuencode" file t nil name))
 461
 462 (defvar np-file "~/.np"
 463   "*Where the `now-playing' file is.")
 464
 465 (defun np (&optional arg)
 466   "Grabs a `now-playing' string."
 467   (interactive)
 468   (save-excursion
 469     (or arg (progn
 470               (goto-char (point-max))
 471               (insert "\nNP: ")
 472               (insert-file-contents np-file)))))
 473
 474 (defun mdw-version-< (ver-a ver-b)
 475   "Answer whether VER-A is strictly earlier than VER-B.
 476 VER-A and VER-B are version numbers, which are strings containing digit
 477 sequences separated by `.'."
 478   (let* ((la (mapcar (lambda (x) (car (read-from-string x)))
 479                      (split-string ver-a "\\.")))
 480          (lb (mapcar (lambda (x) (car (read-from-string x)))
 481                      (split-string ver-b "\\."))))
 482     (catch 'done
 483       (while t
 484         (cond ((null la) (throw 'done lb))
 485               ((null lb) (throw 'done nil))
 486               ((< (car la) (car lb)) (throw 'done t))
 487               ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb))))))))
 488
 489 (defun mdw-check-autorevert ()
 490   "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
 491 This takes into consideration whether it's been found using
 492 tramp, which seems to get itself into a twist."
 493   (cond ((not (boundp 'global-auto-revert-ignore-buffer))
 494          nil)
 495         ((and (buffer-file-name)
 496               (fboundp 'tramp-tramp-file-p)
 497               (tramp-tramp-file-p (buffer-file-name)))
 498          (unless global-auto-revert-ignore-buffer
 499            (setq global-auto-revert-ignore-buffer 'tramp)))
 500         ((eq global-auto-revert-ignore-buffer 'tramp)
 501          (setq global-auto-revert-ignore-buffer nil))))
 502
 503 (defadvice find-file (after mdw-autorevert activate)
 504   (mdw-check-autorevert))
 505 (defadvice write-file (after mdw-autorevert activate)
 506   (mdw-check-autorevert))
 507
 508 ;;;--------------------------------------------------------------------------
 509 ;;; Dired hacking.
 510
 511 (defadvice dired-maybe-insert-subdir
 512     (around mdw-marked-insertion first activate)
 513   "The DIRNAME may be a list of directory names to insert.
 514 Interactively, if files are marked, then insert all of them.
 515 With a numeric prefix argument, select that many entries near
 516 point; with a non-numeric prefix argument, prompt for listing
 517 options."
 518   (interactive
 519    (list (dired-get-marked-files nil
 520                                  (and (integerp current-prefix-arg)
 521                                       current-prefix-arg)
 522                                  #'file-directory-p)
 523          (and current-prefix-arg
 524               (not (integerp current-prefix-arg))
 525               (read-string "Switches for listing: "
 526                            (or dired-subdir-switches
 527                                dired-actual-switches)))))
 528   (let ((dirs (ad-get-arg 0)))
 529     (dolist (dir (if (listp dirs) dirs (list dirs)))
 530       (ad-set-arg 0 dir)
 531       ad-do-it)))
 532
 533 ;;;--------------------------------------------------------------------------
 534 ;;; URL viewing.
 535
 536 (defun mdw-w3m-browse-url (url &optional new-session-p)
 537   "Invoke w3m on the URL in its current window, or at least a different one.
 538 If NEW-SESSION-P, start a new session."
 539   (interactive "sURL: \nP")
 540   (save-excursion
 541     (let ((window (selected-window)))
 542       (unwind-protect
 543           (progn
 544             (select-window (or (and (not new-session-p)
 545                                     (get-buffer-window "*w3m*"))
 546                                (progn
 547                                  (if (one-window-p t) (split-window))
 548                                  (get-lru-window))))
 549             (w3m-browse-url url new-session-p))
 550         (select-window window)))))
 551
 552 (defvar mdw-good-url-browsers
 553   '(browse-url-generic
 554     (w3m . mdw-w3m-browse-url)
 555     browse-url-w3
 556     browse-url-mozilla)
 557   "List of good browsers for mdw-good-url-browsers.
 558 Each item is a browser function name, or a cons (CHECK . FUNC).
 559 A symbol FOO stands for (FOO . FOO).")
 560
 561 (defun mdw-good-url-browser ()
 562   "Return a good URL browser.
 563 Trundle the list of such things, finding the first item for which
 564 CHECK is fboundp, and returning the correponding FUNC."
 565   (let ((bs mdw-good-url-browsers) b check func answer)
 566     (while (and bs (not answer))
 567       (setq b (car bs)
 568             bs (cdr bs))
 569       (if (consp b)
 570           (setq check (car b) func (cdr b))
 571         (setq check b func b))
 572       (if (fboundp check)
 573           (setq answer func)))
 574     answer))
 575
 576 (eval-after-load "w3m-search"
 577   '(progn
 578      (dolist
 579          (item
 580           '(("g" "Google" "http://www.google.co.uk/search?q=%s")
 581             ("gd" "Google Directory"
 582              "http://www.google.com/search?cat=gwd/Top&q=%s")
 583             ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
 584             ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
 585             ("gi" "Images" "http://images.google.com/images?q=%s")
 586             ("rfc" "RFC"
 587              "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
 588             ("wp" "Wikipedia"
 589              "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
 590             ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
 591             ("nc-wiki" "nCipher wiki"
 592              "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
 593             ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
 594             ("lp" "Launchpad bug by number"
 595              "https://bugs.launchpad.net/bugs/%s")
 596             ("lppkg" "Launchpad bugs by package"
 597              "https://bugs.launchpad.net/%s")
 598             ("msdn" "MSDN"
 599              "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
 600             ("debbug" "Debian bug by number"
 601              "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
 602             ("debbugpkg" "Debian bugs by package"
 603              "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
 604             ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
 605        (add-to-list 'w3m-search-engine-alist
 606                     (list (cadr item) (caddr item) nil))
 607        (add-to-list 'w3m-uri-replace-alist
 608                     (list (concat "\\`" (car item) ":")
 609                           'w3m-search-uri-replace
 610                           (cadr item))))))
 611
 612 ;;;--------------------------------------------------------------------------
 613 ;;; Paragraph filling.
 614
 615 ;; Useful variables.
 616
 617 (defvar mdw-fill-prefix nil
 618   "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
 619 If there's no fill prefix currently set (by the `fill-prefix'
 620 variable) and there's a match from one of the regexps here, it
 621 gets used to set the fill-prefix for the current operation.
 622
 623 The variable is a list of items of the form `REGEXP . PREFIX'; if
 624 the REGEXP matches, the PREFIX is used to set the fill prefix.
 625 It in turn is a list of things:
 626
 627   STRING -- insert a literal string
 628   (match . N) -- insert the thing matched by bracketed subexpression N
 629   (pad . N) -- a string of whitespace the same width as subexpression N
 630   (expr . FORM) -- the result of evaluating FORM")
 631
 632 (make-variable-buffer-local 'mdw-fill-prefix)
 633
 634 (defvar mdw-hanging-indents
 635   (concat "\\(\\("
 636             "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
 637             "[ \t]+"
 638           "\\)?\\)")
 639   "*Standard regexp matching parts of a hanging indent.
 640 This is mainly useful in `auto-fill-mode'.")
 641
 642 ;; Setting things up.
 643
 644 (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
 645
 646 ;; Utility functions.
 647
 648 (defun mdw-maybe-tabify (s)
 649   "Tabify or untabify the string S, according to `indent-tabs-mode'."
 650   (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
 651     (with-temp-buffer
 652       (save-match-data
 653         (insert s "\n")
 654         (let ((start (point-min)) (end (point-max)))
 655           (funcall tabfun (point-min) (point-max))
 656           (setq s (buffer-substring (point-min) (1- (point-max)))))))))
 657
 658 (defun mdw-examine-fill-prefixes (l)
 659   "Given a list of dynamic fill prefixes, pick one which matches
 660 context and return the static fill prefix to use.  Point must be
 661 at the start of a line, and match data must be saved."
 662   (cond ((not l) nil)
 663                ((looking-at (car (car l)))
 664                 (mdw-maybe-tabify (apply #'concat
 665                                          (mapcar #'mdw-do-prefix-match
 666                                                  (cdr (car l))))))
 667                (t (mdw-examine-fill-prefixes (cdr l)))))
 668
 669 (defun mdw-maybe-car (p)
 670   "If P is a pair, return (car P), otherwise just return P."
 671   (if (consp p) (car p) p))
 672
 673 (defun mdw-padding (s)
 674   "Return a string the same width as S but made entirely from whitespace."
 675   (let* ((l (length s)) (i 0) (n (make-string l ? )))
 676     (while (< i l)
 677       (if (= 9 (aref s i))
 678           (aset n i 9))
 679       (setq i (1+ i)))
 680     n))
 681
 682 (defun mdw-do-prefix-match (m)
 683   "Expand a dynamic prefix match element.
 684 See `mdw-fill-prefix' for details."
 685   (cond ((not (consp m)) (format "%s" m))
 686            ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
 687            ((eq (car m) 'pad) (mdw-padding (match-string
 688                                             (mdw-maybe-car (cdr m)))))
 689            ((eq (car m) 'eval) (eval (cdr m)))
 690            (t "")))
 691
 692 (defun mdw-choose-dynamic-fill-prefix ()
 693   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
 694   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
 695            ((not mdw-fill-prefix) fill-prefix)
 696            (t (save-excursion
 697                 (beginning-of-line)
 698                 (save-match-data
 699                   (mdw-examine-fill-prefixes mdw-fill-prefix))))))
 700
 701 (defun do-auto-fill ()
 702   "Handle auto-filling, working out a dynamic fill prefix in the
 703 case where there isn't a sensible static one."
 704   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 705     (mdw-do-auto-fill)))
 706
 707 (defun mdw-fill-paragraph ()
 708   "Fill paragraph, getting a dynamic fill prefix."
 709   (interactive)
 710   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 711     (fill-paragraph nil)))
 712
 713 (defun mdw-standard-fill-prefix (rx &optional mat)
 714   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
 715 This is just a short-cut for setting the thing by hand, and by
 716 design it doesn't cope with anything approximating a complicated
 717 case."
 718   (setq mdw-fill-prefix
 719            `((,(concat rx mdw-hanging-indents)
 720               (match . 1)
 721               (pad . ,(or mat 2))))))
 722
 723 ;;;--------------------------------------------------------------------------
 724 ;;; Other common declarations.
 725
 726 ;; Common mode settings.
 727
 728 (defvar mdw-auto-indent t
 729   "Whether to indent automatically after a newline.")
 730
 731 (defun mdw-whitespace-mode (&optional arg)
 732   "Turn on/off whitespace mode, but don't highlight trailing space."
 733   (interactive "P")
 734   (when (and (boundp 'whitespace-style)
 735              (fboundp 'whitespace-mode))
 736     (let ((whitespace-style (remove 'trailing whitespace-style)))
 737       (whitespace-mode arg))
 738     (setq show-trailing-whitespace whitespace-mode)))
 739
 740 (defun mdw-misc-mode-config ()
 741   (and mdw-auto-indent
 742        (cond ((eq major-mode 'lisp-mode)
 743               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
 744              ((or (eq major-mode 'slime-repl-mode)
 745                   (eq major-mode 'asm-mode))
 746               nil)
 747              (t
 748               (local-set-key "\C-m" 'newline-and-indent))))
 749   (local-set-key [C-return] 'newline)
 750   (make-local-variable 'page-delimiter)
 751   (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
 752   (setq comment-column 40)
 753   (auto-fill-mode 1)
 754   (setq fill-column 77)
 755   (setq show-trailing-whitespace t)
 756   (mdw-whitespace-mode 1)
 757   (and (fboundp 'gtags-mode)
 758        (gtags-mode))
 759   (if (fboundp 'hs-minor-mode)
 760       (trap (hs-minor-mode t))
 761     (outline-minor-mode t))
 762   (reveal-mode t)
 763   (trap (turn-on-font-lock)))
 764
 765 (defun mdw-post-config-mode-hack ()
 766   (mdw-whitespace-mode 1))
 767
 768 (eval-after-load 'gtags
 769   '(progn
 770      (dolist (key '([mouse-2] [mouse-3]))
 771        (define-key gtags-mode-map key nil))
 772      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
 773      (define-key gtags-select-mode-map [C-S-mouse-2]
 774        'gtags-select-tag-by-event)
 775      (dolist (map (list gtags-mode-map gtags-select-mode-map))
 776        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
 777
 778 ;; Backup file handling.
 779
 780 (defvar mdw-backup-disable-regexps nil
 781   "*List of regular expressions: if a file name matches any of
 782 these then the file is not backed up.")
 783
 784 (defun mdw-backup-enable-predicate (name)
 785   "[mdw]'s default backup predicate.
 786 Allows a backup if the standard predicate would allow it, and it
 787 doesn't match any of the regular expressions in
 788 `mdw-backup-disable-regexps'."
 789   (and (normal-backup-enable-predicate name)
 790        (let ((answer t) (list mdw-backup-disable-regexps))
 791          (save-match-data
 792            (while list
 793              (if (string-match (car list) name)
 794                  (setq answer nil))
 795              (setq list (cdr list)))
 796            answer))))
 797 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
 798
 799 ;; Frame cleanup.
 800
 801 (defun mdw-last-one-out-turn-off-the-lights (frame)
 802   "Disconnect from an X display if this was the last frame on that display."
 803   (let ((frame-display (frame-parameter frame 'display)))
 804     (when (and frame-display
 805                (eq window-system 'x)
 806                (not (some (lambda (fr)
 807                             (and (not (eq fr frame))
 808                                  (string= (frame-parameter fr 'display)
 809                                           frame-display)))
 810                           (frame-list))))
 811       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
 812 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
 813
 814 ;;;--------------------------------------------------------------------------
 815 ;;; General fontification.
 816
 817 (defmacro mdw-define-face (name &rest body)
 818   "Define a face, and make sure it's actually set as the definition."
 819   (declare (indent 1)
 820            (debug 0))
 821   `(progn
 822      (make-face ',name)
 823      (defvar ,name ',name)
 824      (put ',name 'face-defface-spec ',body)
 825      (face-spec-set ',name ',body nil)))
 826
 827 (mdw-define-face default
 828   (((type w32)) :family "courier new" :height 85)
 829   (((type x)) :family "6x13" :foundry "trad" :height 130)
 830   (((type color)) :foreground "white" :background "black")
 831   (t nil))
 832 (mdw-define-face fixed-pitch
 833   (((type w32)) :family "courier new" :height 85)
 834   (((type x)) :family "6x13" :foundry "trad" :height 130)
 835   (t :foreground "white" :background "black"))
 836 (if (>= emacs-major-version 23)
 837     (mdw-define-face variable-pitch
 838       (((type x)) :family "sans" :height 100))
 839   (mdw-define-face variable-pitch
 840     (((type x)) :family "helvetica" :height 90)))
 841 (mdw-define-face region
 842   (((type tty) (class color)) :background "blue")
 843   (((type tty) (class mono)) :inverse-video t)
 844   (t :background "grey30"))
 845 (mdw-define-face minibuffer-prompt
 846   (t :weight bold))
 847 (mdw-define-face mode-line
 848   (((class color)) :foreground "blue" :background "yellow"
 849                    :box (:line-width 1 :style released-button))
 850   (t :inverse-video t))
 851 (mdw-define-face mode-line-inactive
 852   (((class color)) :foreground "yellow" :background "blue"
 853                    :box (:line-width 1 :style released-button))
 854   (t :inverse-video t))
 855 (mdw-define-face scroll-bar
 856   (t :foreground "black" :background "lightgrey"))
 857 (mdw-define-face fringe
 858   (t :foreground "yellow"))
 859 (mdw-define-face show-paren-match
 860   (((class color)) :background "darkgreen")
 861   (t :underline t))
 862 (mdw-define-face show-paren-mismatch
 863   (((class color)) :background "red")
 864   (t :inverse-video t))
 865 (mdw-define-face highlight
 866   (((type x) (class color)) :background "DarkSeaGreen4")
 867   (((type tty) (class color)) :background "cyan")
 868   (t :inverse-video t))
 869
 870 (mdw-define-face holiday-face
 871   (t :background "red"))
 872 (mdw-define-face calendar-today-face
 873   (t :foreground "yellow" :weight bold))
 874
 875 (mdw-define-face comint-highlight-prompt
 876   (t :weight bold))
 877 (mdw-define-face comint-highlight-input
 878   (t nil))
 879
 880 (mdw-define-face dired-directory
 881   (t :foreground "cyan" :weight bold))
 882 (mdw-define-face dired-symlink
 883   (t :foreground "cyan"))
 884 (mdw-define-face dired-perm-write
 885   (t nil))
 886
 887 (mdw-define-face trailing-whitespace
 888   (((class color)) :background "red")
 889   (t :inverse-video t))
 890 (mdw-define-face mdw-punct-face
 891   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
 892 (mdw-define-face mdw-number-face
 893   (t :foreground "yellow"))
 894 (mdw-define-face font-lock-function-name-face
 895   (t :slant italic))
 896 (mdw-define-face font-lock-keyword-face
 897   (t :weight bold))
 898 (mdw-define-face font-lock-constant-face
 899   (t :slant italic))
 900 (mdw-define-face font-lock-builtin-face
 901   (t :weight bold))
 902 (mdw-define-face font-lock-type-face
 903   (t :weight bold :slant italic))
 904 (mdw-define-face font-lock-reference-face
 905   (t :weight bold))
 906 (mdw-define-face font-lock-variable-name-face
 907   (t :slant italic))
 908 (mdw-define-face font-lock-comment-delimiter-face
 909   (((class mono)) :weight bold)
 910   (((type tty) (class color)) :foreground "green")
 911   (t :slant italic :foreground "SeaGreen1"))
 912 (mdw-define-face font-lock-comment-face
 913   (((class mono)) :weight bold)
 914   (((type tty) (class color)) :foreground "green")
 915   (t :slant italic :foreground "SeaGreen1"))
 916 (mdw-define-face font-lock-string-face
 917   (((class mono)) :weight bold)
 918   (((class color)) :foreground "SkyBlue1"))
 919 (mdw-define-face message-separator
 920   (t :background "red" :foreground "white" :weight bold))
 921 (mdw-define-face message-cited-text
 922   (default :slant italic)
 923   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 924 (mdw-define-face message-header-cc
 925   (default :weight bold)
 926   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 927 (mdw-define-face message-header-newsgroups
 928   (default :weight bold)
 929   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 930 (mdw-define-face message-header-subject
 931   (default :weight bold)
 932   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 933 (mdw-define-face message-header-to
 934   (default :weight bold)
 935   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 936 (mdw-define-face message-header-xheader
 937   (default :weight bold)
 938   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 939 (mdw-define-face message-header-other
 940   (default :weight bold)
 941   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 942 (mdw-define-face message-header-name
 943   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 944 (mdw-define-face which-func
 945   (t nil))
 946
 947 (mdw-define-face diff-header
 948   (t nil))
 949 (mdw-define-face diff-index
 950   (t :weight bold))
 951 (mdw-define-face diff-file-header
 952   (t :weight bold))
 953 (mdw-define-face diff-hunk-header
 954   (t :foreground "SkyBlue1"))
 955 (mdw-define-face diff-function
 956   (t :foreground "SkyBlue1" :weight bold))
 957 (mdw-define-face diff-header
 958   (t :background "grey10"))
 959 (mdw-define-face diff-added
 960   (t :foreground "green"))
 961 (mdw-define-face diff-removed
 962   (t :foreground "red"))
 963 (mdw-define-face diff-context
 964   (t nil))
 965 (mdw-define-face diff-refine-change
 966   (((class color) (type x)) :background "RoyalBlue4")
 967   (t :underline t))
 968
 969 (mdw-define-face magit-diff-add
 970   (t :foreground "green"))
 971 (mdw-define-face magit-diff-del
 972   (t :foreground "red"))
 973 (mdw-define-face magit-diff-file-header
 974   (t :weight bold))
 975 (mdw-define-face magit-diff-hunk-header
 976   (t :foreground "SkyBlue1"))
 977 (mdw-define-face magit-item-highlight
 978   (((type tty)) :background "blue")
 979   (t :background "DarkSeaGreen4"))
 980
 981 (mdw-define-face erc-input-face
 982   (t :foreground "red"))
 983
 984 (mdw-define-face woman-bold
 985   (t :weight bold))
 986 (mdw-define-face woman-italic
 987   (t :slant italic))
 988
 989 (eval-after-load "rst"
 990   '(progn
 991      (mdw-define-face rst-level-1-face
 992        (t :foreground "SkyBlue1" :weight bold))
 993      (mdw-define-face rst-level-2-face
 994        (t :foreground "SeaGreen1" :weight bold))
 995      (mdw-define-face rst-level-3-face
 996        (t :weight bold))
 997      (mdw-define-face rst-level-4-face
 998        (t :slant italic))
 999      (mdw-define-face rst-level-5-face
1000        (t :underline t))
1001      (mdw-define-face rst-level-6-face
1002        ())))
1003
1004 (mdw-define-face p4-depot-added-face
1005   (t :foreground "green"))
1006 (mdw-define-face p4-depot-branch-op-face
1007   (t :foreground "yellow"))
1008 (mdw-define-face p4-depot-deleted-face
1009   (t :foreground "red"))
1010 (mdw-define-face p4-depot-unmapped-face
1011   (t :foreground "SkyBlue1"))
1012 (mdw-define-face p4-diff-change-face
1013   (t :foreground "yellow"))
1014 (mdw-define-face p4-diff-del-face
1015   (t :foreground "red"))
1016 (mdw-define-face p4-diff-file-face
1017   (t :foreground "SkyBlue1"))
1018 (mdw-define-face p4-diff-head-face
1019   (t :background "grey10"))
1020 (mdw-define-face p4-diff-ins-face
1021   (t :foreground "green"))
1022
1023 (mdw-define-face w3m-anchor-face
1024   (t :foreground "SkyBlue1" :underline t))
1025 (mdw-define-face w3m-arrived-anchor-face
1026   (t :foreground "SkyBlue1" :underline t))
1027
1028 (mdw-define-face whizzy-slice-face
1029   (t :background "grey10"))
1030 (mdw-define-face whizzy-error-face
1031   (t :background "darkred"))
1032
1033 ;; Ellipses used to indicate hidden text (and similar).
1034 (mdw-define-face mdw-ellipsis-face
1035   (((type tty)) :foreground "blue") (t :foreground "grey60"))
1036 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1037       (backslash (make-glyph-code ?\ 'mdw-ellipsis-face))
1038       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1039       (bar (make-glyph-code ?| mdw-ellipsis-face)))
1040   (set-display-table-slot standard-display-table 0 dollar)
1041   (set-display-table-slot standard-display-table 1 backslash)
1042   (set-display-table-slot standard-display-table 4
1043                           (vector dot dot dot))
1044   (set-display-table-slot standard-display-table 5 bar))
1045
1046 ;;;--------------------------------------------------------------------------
1047 ;;; C programming configuration.
1048
1049 ;; Linux kernel hacking.
1050
1051 (defvar linux-c-mode-hook)
1052
1053 (defun linux-c-mode ()
1054   (interactive)
1055   (c-mode)
1056   (setq major-mode 'linux-c-mode)
1057   (setq mode-name "Linux C")
1058   (run-hooks 'linux-c-mode-hook))
1059
1060 ;; Make C indentation nice.
1061
1062 (defun mdw-c-lineup-arglist (langelem)
1063   "Hack for DWIMmery in c-lineup-arglist."
1064   (if (save-excursion
1065         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1066       0
1067     (c-lineup-arglist langelem)))
1068
1069 (defun mdw-c-indent-extern-mumble (langelem)
1070   "Indent `extern \"...\" {' lines."
1071   (save-excursion
1072     (back-to-indentation)
1073     (if (looking-at
1074          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1075         c-basic-offset
1076       nil)))
1077
1078 (defun mdw-c-style ()
1079   (c-add-style "[mdw] C and C++ style"
1080                '((c-basic-offset . 2)
1081                  (comment-column . 40)
1082                  (c-class-key . "class")
1083                  (c-backslash-column . 72)
1084                  (c-offsets-alist
1085                   (substatement-open . (add 0 c-indent-one-line-block))
1086                   (defun-open . (add 0 c-indent-one-line-block))
1087                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
1088                   (topmost-intro . mdw-c-indent-extern-mumble)
1089                   (cpp-define-intro . 0)
1090                   (knr-argdecl . 0)
1091                   (inextern-lang . [0])
1092                   (label . 0)
1093                   (case-label . +)
1094                   (access-label . -)
1095                   (inclass . +)
1096                   (inline-open . ++)
1097                   (statement-cont . +)
1098                   (statement-case-intro . +)))
1099                t))
1100
1101 (defvar mdw-c-comment-fill-prefix
1102   `((,(concat "\\([ \t]*/?\\)"
1103               "\\(\*\\|//]\\)"
1104               "\\([ \t]*\\)"
1105               "\\([A-Za-z]+:[ \t]*\\)?"
1106               mdw-hanging-indents)
1107      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1108   "Fill prefix matching C comments (both kinds).")
1109
1110 (defun mdw-fontify-c-and-c++ ()
1111
1112   ;; Fiddle with some syntax codes.
1113   (modify-syntax-entry ?* ". 23")
1114   (modify-syntax-entry ?/ ". 124b")
1115   (modify-syntax-entry ?\n "> b")
1116
1117   ;; Other stuff.
1118   (mdw-c-style)
1119   (setq c-hanging-comment-ender-p nil)
1120   (setq c-backslash-column 72)
1121   (setq c-label-minimum-indentation 0)
1122   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1123
1124   ;; Now define things to be fontified.
1125   (make-local-variable 'font-lock-keywords)
1126   (let ((c-keywords
1127          (mdw-regexps "and"             ;C++
1128                       "and_eq"          ;C++
1129                       "asm"             ;K&R, GCC
1130                       "auto"            ;K&R, C89
1131                       "bitand"          ;C++
1132                       "bitor"           ;C++
1133                       "bool"            ;C++, C9X macro
1134                       "break"           ;K&R, C89
1135                       "case"            ;K&R, C89
1136                       "catch"           ;C++
1137                       "char"            ;K&R, C89
1138                       "class"           ;C++
1139                       "complex"         ;C9X macro, C++ template type
1140                       "compl"           ;C++
1141                       "const"           ;C89
1142                       "const_cast"      ;C++
1143                       "continue"        ;K&R, C89
1144                       "defined"         ;C89 preprocessor
1145                       "default"         ;K&R, C89
1146                       "delete"          ;C++
1147                       "do"              ;K&R, C89
1148                       "double"          ;K&R, C89
1149                       "dynamic_cast"    ;C++
1150                       "else"            ;K&R, C89
1151                       ;; "entry"        ;K&R -- never used
1152                       "enum"            ;C89
1153                       "explicit"        ;C++
1154                       "export"          ;C++
1155                       "extern"          ;K&R, C89
1156                       "false"           ;C++, C9X macro
1157                       "float"           ;K&R, C89
1158                       "for"             ;K&R, C89
1159                       ;; "fortran"      ;K&R
1160                       "friend"          ;C++
1161                       "goto"            ;K&R, C89
1162                       "if"              ;K&R, C89
1163                       "imaginary"       ;C9X macro
1164                       "inline"          ;C++, C9X, GCC
1165                       "int"             ;K&R, C89
1166                       "long"            ;K&R, C89
1167                       "mutable"         ;C++
1168                       "namespace"       ;C++
1169                       "new"             ;C++
1170                       "operator"        ;C++
1171                       "or"              ;C++
1172                       "or_eq"           ;C++
1173                       "private"         ;C++
1174                       "protected"       ;C++
1175                       "public"          ;C++
1176                       "register"        ;K&R, C89
1177                       "reinterpret_cast" ;C++
1178                       "restrict"         ;C9X
1179                       "return"           ;K&R, C89
1180                       "short"            ;K&R, C89
1181                       "signed"           ;C89
1182                       "sizeof"           ;K&R, C89
1183                       "static"           ;K&R, C89
1184                       "static_cast"      ;C++
1185                       "struct"           ;K&R, C89
1186                       "switch"           ;K&R, C89
1187                       "template"         ;C++
1188                       "this"             ;C++
1189                       "throw"            ;C++
1190                       "true"             ;C++, C9X macro
1191                       "try"              ;C++
1192                       "this"             ;C++
1193                       "typedef"          ;C89
1194                       "typeid"           ;C++
1195                       "typeof"           ;GCC
1196                       "typename"         ;C++
1197                       "union"            ;K&R, C89
1198                       "unsigned"         ;K&R, C89
1199                       "using"            ;C++
1200                       "virtual"          ;C++
1201                       "void"             ;C89
1202                       "volatile"         ;C89
1203                       "wchar_t"          ;C++, C89 library type
1204                       "while"            ;K&R, C89
1205                       "xor"              ;C++
1206                       "xor_eq"           ;C++
1207                       "_Bool"            ;C9X
1208                       "_Complex"         ;C9X
1209                       "_Imaginary"       ;C9X
1210                       "_Pragma"          ;C9X preprocessor
1211                       "__alignof__"      ;GCC
1212                       "__asm__"          ;GCC
1213                       "__attribute__"    ;GCC
1214                       "__complex__"      ;GCC
1215                       "__const__"        ;GCC
1216                       "__extension__"    ;GCC
1217                       "__imag__"         ;GCC
1218                       "__inline__"       ;GCC
1219                       "__label__"        ;GCC
1220                       "__real__"         ;GCC
1221                       "__signed__"       ;GCC
1222                       "__typeof__"       ;GCC
1223                       "__volatile__"     ;GCC
1224                       ))
1225         (preprocessor-keywords
1226          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1227                       "ident" "if" "ifdef" "ifndef" "import" "include"
1228                       "line" "pragma" "unassert" "undef" "warning"))
1229         (objc-keywords
1230          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1231                       "interface" "private" "protected" "protocol" "public"
1232                       "selector")))
1233
1234     (setq font-lock-keywords
1235           (list
1236
1237            ;; Fontify include files as strings.
1238            (list (concat "^[ \t]*\\#[ \t]*"
1239                          "\\(include\\|import\\)"
1240                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1241                  '(2 font-lock-string-face))
1242
1243            ;; Preprocessor directives are `references'?.
1244            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1245                          preprocessor-keywords
1246                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1247                  '(1 font-lock-keyword-face))
1248
1249            ;; Handle the keywords defined above.
1250            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1251                  '(0 font-lock-keyword-face))
1252
1253            (list (concat "\\<\\(" c-keywords "\\)\\>")
1254                  '(0 font-lock-keyword-face))
1255
1256            ;; Handle numbers too.
1257            ;;
1258            ;; This looks strange, I know.  It corresponds to the
1259            ;; preprocessor's idea of what a number looks like, rather than
1260            ;; anything sensible.
1261            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1262                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1263                  '(0 mdw-number-face))
1264
1265            ;; And anything else is punctuation.
1266            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1267                  '(0 mdw-punct-face))))
1268
1269     (mdw-post-config-mode-hack)))
1270
1271 ;;;--------------------------------------------------------------------------
1272 ;;; AP calc mode.
1273
1274 (defun apcalc-mode ()
1275   (interactive)
1276   (c-mode)
1277   (setq major-mode 'apcalc-mode)
1278   (setq mode-name "AP Calc")
1279   (run-hooks 'apcalc-mode-hook))
1280
1281 (defun mdw-fontify-apcalc ()
1282
1283   ;; Fiddle with some syntax codes.
1284   (modify-syntax-entry ?* ". 23")
1285   (modify-syntax-entry ?/ ". 14")
1286
1287   ;; Other stuff.
1288   (mdw-c-style)
1289   (setq c-hanging-comment-ender-p nil)
1290   (setq c-backslash-column 72)
1291   (setq comment-start "/* ")
1292   (setq comment-end " */")
1293   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1294
1295   ;; Now define things to be fontified.
1296   (make-local-variable 'font-lock-keywords)
1297   (let ((c-keywords
1298          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1299                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1300                       "local" "mat" "obj" "print" "quit" "read" "return"
1301                       "show" "static" "switch" "while" "write")))
1302
1303     (setq font-lock-keywords
1304           (list
1305
1306            ;; Handle the keywords defined above.
1307            (list (concat "\\<\\(" c-keywords "\\)\\>")
1308                  '(0 font-lock-keyword-face))
1309
1310            ;; Handle numbers too.
1311            ;;
1312            ;; This looks strange, I know.  It corresponds to the
1313            ;; preprocessor's idea of what a number looks like, rather than
1314            ;; anything sensible.
1315            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1316                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1317                  '(0 mdw-number-face))
1318
1319            ;; And anything else is punctuation.
1320            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1321                  '(0 mdw-punct-face)))))
1322
1323   (mdw-post-config-mode-hack))
1324
1325 ;;;--------------------------------------------------------------------------
1326 ;;; Java programming configuration.
1327
1328 ;; Make indentation nice.
1329
1330 (defun mdw-java-style ()
1331   (c-add-style "[mdw] Java style"
1332                '((c-basic-offset . 2)
1333                  (c-offsets-alist (substatement-open . 0)
1334                                   (label . +)
1335                                   (case-label . +)
1336                                   (access-label . 0)
1337                                   (inclass . +)
1338                                   (statement-case-intro . +)))
1339                t))
1340
1341 ;; Declare Java fontification style.
1342
1343 (defun mdw-fontify-java ()
1344
1345   ;; Other stuff.
1346   (mdw-java-style)
1347   (setq c-hanging-comment-ender-p nil)
1348   (setq c-backslash-column 72)
1349   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1350
1351   ;; Now define things to be fontified.
1352   (make-local-variable 'font-lock-keywords)
1353   (let ((java-keywords
1354          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1355                       "char" "class" "const" "continue" "default" "do"
1356                       "double" "else" "extends" "final" "finally" "float"
1357                       "for" "goto" "if" "implements" "import" "instanceof"
1358                       "int" "interface" "long" "native" "new" "package"
1359                       "private" "protected" "public" "return" "short"
1360                       "static" "super" "switch" "synchronized" "this"
1361                       "throw" "throws" "transient" "try" "void" "volatile"
1362                       "while"
1363
1364                       "false" "null" "true")))
1365
1366     (setq font-lock-keywords
1367           (list
1368
1369            ;; Handle the keywords defined above.
1370            (list (concat "\\<\\(" java-keywords "\\)\\>")
1371                  '(0 font-lock-keyword-face))
1372
1373            ;; Handle numbers too.
1374            ;;
1375            ;; The following isn't quite right, but it's close enough.
1376            (list (concat "\\<\\("
1377                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1378                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1379                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1380                          "[lLfFdD]?")
1381                  '(0 mdw-number-face))
1382
1383            ;; And anything else is punctuation.
1384            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1385                  '(0 mdw-punct-face)))))
1386
1387   (mdw-post-config-mode-hack))
1388
1389 ;;;--------------------------------------------------------------------------
1390 ;;; Javascript programming configuration.
1391
1392 (defun mdw-javascript-style ()
1393   (setq js-indent-level 2)
1394   (setq js-expr-indent-offset 0))
1395
1396 (defun mdw-fontify-javascript ()
1397
1398   ;; Other stuff.
1399   (mdw-javascript-style)
1400   (setq js-auto-indent-flag t)
1401
1402   ;; Now define things to be fontified.
1403   (make-local-variable 'font-lock-keywords)
1404   (let ((javascript-keywords
1405          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1406                       "char" "class" "const" "continue" "debugger" "default"
1407                       "delete" "do" "double" "else" "enum" "export" "extends"
1408                       "final" "finally" "float" "for" "function" "goto" "if"
1409                       "implements" "import" "in" "instanceof" "int"
1410                       "interface" "let" "long" "native" "new" "package"
1411                       "private" "protected" "public" "return" "short"
1412                       "static" "super" "switch" "synchronized" "throw"
1413                       "throws" "transient" "try" "typeof" "var" "void"
1414                       "volatile" "while" "with" "yield"
1415
1416                       "boolean" "byte" "char" "double" "float" "int" "long"
1417                       "short" "void"))
1418         (javascript-constants
1419          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1420                       "arguments" "this")))
1421
1422     (setq font-lock-keywords
1423           (list
1424
1425            ;; Handle the keywords defined above.
1426            (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
1427                  '(0 font-lock-keyword-face))
1428
1429            ;; Handle the predefined constants defined above.
1430            (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
1431                  '(0 font-lock-variable-name-face))
1432
1433            ;; Handle numbers too.
1434            ;;
1435            ;; The following isn't quite right, but it's close enough.
1436            (list (concat "\\_<\\("
1437                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1438                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1439                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1440                          "[lLfFdD]?")
1441                  '(0 mdw-number-face))
1442
1443            ;; And anything else is punctuation.
1444            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1445                  '(0 mdw-punct-face)))))
1446
1447   (mdw-post-config-mode-hack))
1448
1449 ;;;--------------------------------------------------------------------------
1450 ;;; C# programming configuration.
1451
1452 ;; Make indentation nice.
1453
1454 (defun mdw-csharp-style ()
1455   (c-add-style "[mdw] C# style"
1456                '((c-basic-offset . 2)
1457                  (c-offsets-alist (substatement-open . 0)
1458                                   (label . 0)
1459                                   (case-label . +)
1460                                   (access-label . 0)
1461                                   (inclass . +)
1462                                   (statement-case-intro . +)))
1463                t))
1464
1465 ;; Declare C# fontification style.
1466
1467 (defun mdw-fontify-csharp ()
1468
1469   ;; Other stuff.
1470   (mdw-csharp-style)
1471   (setq c-hanging-comment-ender-p nil)
1472   (setq c-backslash-column 72)
1473   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1474
1475   ;; Now define things to be fontified.
1476   (make-local-variable 'font-lock-keywords)
1477   (let ((csharp-keywords
1478          (mdw-regexps "abstract" "as" "base" "bool" "break"
1479                       "byte" "case" "catch" "char" "checked"
1480                       "class" "const" "continue" "decimal" "default"
1481                       "delegate" "do" "double" "else" "enum"
1482                       "event" "explicit" "extern" "false" "finally"
1483                       "fixed" "float" "for" "foreach" "goto"
1484                       "if" "implicit" "in" "int" "interface"
1485                       "internal" "is" "lock" "long" "namespace"
1486                       "new" "null" "object" "operator" "out"
1487                       "override" "params" "private" "protected" "public"
1488                       "readonly" "ref" "return" "sbyte" "sealed"
1489                       "short" "sizeof" "stackalloc" "static" "string"
1490                       "struct" "switch" "this" "throw" "true"
1491                       "try" "typeof" "uint" "ulong" "unchecked"
1492                       "unsafe" "ushort" "using" "virtual" "void"
1493                       "volatile" "while" "yield")))
1494
1495     (setq font-lock-keywords
1496           (list
1497
1498            ;; Handle the keywords defined above.
1499            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1500                  '(0 font-lock-keyword-face))
1501
1502            ;; Handle numbers too.
1503            ;;
1504            ;; The following isn't quite right, but it's close enough.
1505            (list (concat "\\<\\("
1506                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1507                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1508                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1509                          "[lLfFdD]?")
1510                  '(0 mdw-number-face))
1511
1512            ;; And anything else is punctuation.
1513            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1514                  '(0 mdw-punct-face)))))
1515
1516   (mdw-post-config-mode-hack))
1517
1518 (define-derived-mode csharp-mode java-mode "C#"
1519   "Major mode for editing C# code.")
1520
1521 ;;;--------------------------------------------------------------------------
1522 ;;; Go programming configuration.
1523
1524 (defun mdw-fontify-go ()
1525
1526   (make-local-variable 'font-lock-keywords)
1527   (let ((go-keywords
1528          (mdw-regexps "break" "case" "chan" "const" "continue"
1529                       "default" "defer" "else" "fallthrough" "for"
1530                       "func" "go" "goto" "if" "import"
1531                       "interface" "map" "package" "range" "return"
1532                       "select" "struct" "switch" "type" "var")))
1533
1534     (setq font-lock-keywords
1535           (list
1536
1537            ;; Handle the keywords defined above.
1538            (list (concat "\\<\\(" go-keywords "\\)\\>")
1539                  '(0 font-lock-keyword-face))
1540
1541            ;; Handle numbers too.
1542            ;;
1543            ;; The following isn't quite right, but it's close enough.
1544            (list (concat "\\<\\("
1545                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1546                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1547                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1548                  '(0 mdw-number-face))
1549
1550            ;; And anything else is punctuation.
1551            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1552                  '(0 mdw-punct-face)))))
1553
1554   (mdw-post-config-mode-hack))
1555
1556 ;;;--------------------------------------------------------------------------
1557 ;;; Awk programming configuration.
1558
1559 ;; Make Awk indentation nice.
1560
1561 (defun mdw-awk-style ()
1562   (c-add-style "[mdw] Awk style"
1563                '((c-basic-offset . 2)
1564                  (c-offsets-alist (substatement-open . 0)
1565                                   (statement-cont . 0)
1566                                   (statement-case-intro . +)))
1567                t))
1568
1569 ;; Declare Awk fontification style.
1570
1571 (defun mdw-fontify-awk ()
1572
1573   ;; Miscellaneous fiddling.
1574   (mdw-awk-style)
1575   (setq c-backslash-column 72)
1576   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1577
1578   ;; Now define things to be fontified.
1579   (make-local-variable 'font-lock-keywords)
1580   (let ((c-keywords
1581          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1582                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1583                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1584                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1585                       "atan2" "break" "close" "continue" "cos" "delete"
1586                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1587                       "function" "gensub" "getline" "gsub" "if" "in"
1588                       "index" "int" "length" "log" "match" "next" "rand"
1589                       "return" "print" "printf" "sin" "split" "sprintf"
1590                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1591                       "systime" "tolower" "toupper" "while")))
1592
1593     (setq font-lock-keywords
1594           (list
1595
1596            ;; Handle the keywords defined above.
1597            (list (concat "\\<\\(" c-keywords "\\)\\>")
1598                  '(0 font-lock-keyword-face))
1599
1600            ;; Handle numbers too.
1601            ;;
1602            ;; The following isn't quite right, but it's close enough.
1603            (list (concat "\\<\\("
1604                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1605                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1606                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1607                          "[uUlL]*")
1608                  '(0 mdw-number-face))
1609
1610            ;; And anything else is punctuation.
1611            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1612                  '(0 mdw-punct-face)))))
1613
1614   (mdw-post-config-mode-hack))
1615
1616 ;;;--------------------------------------------------------------------------
1617 ;;; Perl programming style.
1618
1619 ;; Perl indentation style.
1620
1621 (fset 'perl-mode 'cperl-mode)
1622 (setq cperl-indent-level 2)
1623 (setq cperl-continued-statement-offset 2)
1624 (setq cperl-continued-brace-offset 0)
1625 (setq cperl-brace-offset -2)
1626 (setq cperl-brace-imaginary-offset 0)
1627 (setq cperl-label-offset 0)
1628
1629 ;; Define perl fontification style.
1630
1631 (defun mdw-fontify-perl ()
1632
1633   ;; Miscellaneous fiddling.
1634   (modify-syntax-entry ?$ "\\")
1635   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1636   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1637
1638   ;; Now define fontification things.
1639   (make-local-variable 'font-lock-keywords)
1640   (let ((perl-keywords
1641          (mdw-regexps "and" "break" "cmp" "continue" "do" "else" "elsif" "eq"
1642                       "for" "foreach" "ge" "given" "gt" "goto" "if"
1643                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1644                       "our" "package" "redo" "require" "return" "sub"
1645                       "undef" "unless" "until" "use" "when" "while")))
1646
1647     (setq font-lock-keywords
1648           (list
1649
1650            ;; Set up the keywords defined above.
1651            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1652                  '(0 font-lock-keyword-face))
1653
1654            ;; At least numbers are simpler than C.
1655            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1656                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1657                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1658                  '(0 mdw-number-face))
1659
1660            ;; And anything else is punctuation.
1661            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1662                  '(0 mdw-punct-face)))))
1663
1664   (mdw-post-config-mode-hack))
1665
1666 (defun perl-number-tests (&optional arg)
1667   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1668 strip numbers instead."
1669   (interactive "P")
1670   (save-excursion
1671     (goto-char (point-min))
1672     (let ((i 0) (fmt (if arg "" " %4d")))
1673       (while (search-forward "#t" nil t)
1674         (delete-region (point) (line-end-position))
1675         (setq i (1+ i))
1676         (insert (format fmt i)))
1677       (goto-char (point-min))
1678       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1679           (replace-match (format "\\1%d" i))))))
1680
1681 ;;;--------------------------------------------------------------------------
1682 ;;; Python programming style.
1683
1684 (defun mdw-fontify-pythonic (keywords)
1685
1686   ;; Miscellaneous fiddling.
1687   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1688   (setq indent-tabs-mode nil)
1689
1690   ;; Now define fontification things.
1691   (make-local-variable 'font-lock-keywords)
1692   (setq font-lock-keywords
1693         (list
1694
1695          ;; Set up the keywords defined above.
1696          (list (concat "\\_<\\(" keywords "\\)\\_>")
1697                '(0 font-lock-keyword-face))
1698
1699          ;; At least numbers are simpler than C.
1700          (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1701                        "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1702                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1703                '(0 mdw-number-face))
1704
1705          ;; And anything else is punctuation.
1706          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1707                '(0 mdw-punct-face))))
1708
1709   (mdw-post-config-mode-hack))
1710
1711 ;; Define Python fontification styles.
1712
1713 (defun mdw-fontify-python ()
1714   (mdw-fontify-pythonic
1715    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1716                 "del" "elif" "else" "except" "exec" "finally" "for"
1717                 "from" "global" "if" "import" "in" "is" "lambda"
1718                 "not" "or" "pass" "print" "raise" "return" "try"
1719                 "while" "with" "yield")))
1720
1721 (defun mdw-fontify-pyrex ()
1722   (mdw-fontify-pythonic
1723    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
1724                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
1725                 "extern" "finally" "for" "from" "global" "if"
1726                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
1727                 "raise" "return" "struct" "try" "while" "with"
1728                 "yield")))
1729
1730 ;;;--------------------------------------------------------------------------
1731 ;;; Icon programming style.
1732
1733 ;; Icon indentation style.
1734
1735 (setq icon-brace-offset 0
1736       icon-continued-brace-offset 0
1737       icon-continued-statement-offset 2
1738       icon-indent-level 2)
1739
1740 ;; Define Icon fontification style.
1741
1742 (defun mdw-fontify-icon ()
1743
1744   ;; Miscellaneous fiddling.
1745   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1746
1747   ;; Now define fontification things.
1748   (make-local-variable 'font-lock-keywords)
1749   (let ((icon-keywords
1750          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1751                       "end" "every" "fail" "global" "if" "initial"
1752                       "invocable" "link" "local" "next" "not" "of"
1753                       "procedure" "record" "repeat" "return" "static"
1754                       "suspend" "then" "to" "until" "while"))
1755         (preprocessor-keywords
1756          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1757                       "include" "line" "undef")))
1758     (setq font-lock-keywords
1759           (list
1760
1761            ;; Set up the keywords defined above.
1762            (list (concat "\\<\\(" icon-keywords "\\)\\>")
1763                  '(0 font-lock-keyword-face))
1764
1765            ;; The things that Icon calls keywords.
1766            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1767
1768            ;; At least numbers are simpler than C.
1769            (list (concat "\\<[0-9]+"
1770                          "\\([rR][0-9a-zA-Z]+\\|"
1771                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1772                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1773                  '(0 mdw-number-face))
1774
1775            ;; Preprocessor.
1776            (list (concat "^[ \t]*$[ \t]*\\<\\("
1777                          preprocessor-keywords
1778                          "\\)\\>")
1779                  '(0 font-lock-keyword-face))
1780
1781            ;; And anything else is punctuation.
1782            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1783                  '(0 mdw-punct-face)))))
1784
1785   (mdw-post-config-mode-hack))
1786
1787 ;;;--------------------------------------------------------------------------
1788 ;;; ARM assembler programming configuration.
1789
1790 ;; There doesn't appear to be an Emacs mode for this yet.
1791 ;;
1792 ;; Better do something about that, I suppose.
1793
1794 (defvar arm-assembler-mode-map nil)
1795 (defvar arm-assembler-abbrev-table nil)
1796 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1797
1798 (or arm-assembler-mode-map
1799     (progn
1800       (setq arm-assembler-mode-map (make-sparse-keymap))
1801       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1802       (define-key arm-assembler-mode-map [C-return] 'newline)
1803       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1804
1805 (defun arm-assembler-mode ()
1806   "Major mode for ARM assembler programs"
1807   (interactive)
1808
1809   ;; Do standard major mode things.
1810   (kill-all-local-variables)
1811   (use-local-map arm-assembler-mode-map)
1812   (setq local-abbrev-table arm-assembler-abbrev-table)
1813   (setq major-mode 'arm-assembler-mode)
1814   (setq mode-name "ARM assembler")
1815
1816   ;; Set up syntax table.
1817   (set-syntax-table arm-assembler-mode-syntax-table)
1818   (modify-syntax-entry ?;   ; Nasty hack
1819                        "<" arm-assembler-mode-syntax-table)
1820   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1821   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1822   (modify-syntax-entry ?' "\"'" arm-assembler-mode-syntax-table)
1823
1824   (make-local-variable 'comment-start)
1825   (setq comment-start ";")
1826   (make-local-variable 'comment-end)
1827   (setq comment-end "")
1828   (make-local-variable 'comment-column)
1829   (setq comment-column 48)
1830   (make-local-variable 'comment-start-skip)
1831   (setq comment-start-skip ";+[ \t]*")
1832
1833   ;; Play with indentation.
1834   (make-local-variable 'indent-line-function)
1835   (setq indent-line-function 'indent-relative-maybe)
1836
1837   ;; Set fill prefix.
1838   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1839
1840   ;; Fiddle with fontification.
1841   (make-local-variable 'font-lock-keywords)
1842   (setq font-lock-keywords
1843         (list
1844
1845          ;; Handle numbers too.
1846          ;;
1847          ;; The following isn't quite right, but it's close enough.
1848          (list (concat "\\("
1849                        "&[0-9a-fA-F]+\\|"
1850                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1851                        "\\)")
1852                '(0 mdw-number-face))
1853
1854          ;; Do something about operators.
1855          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1856                '(1 font-lock-keyword-face)
1857                '(2 font-lock-string-face))
1858          (list ":[a-zA-Z]+:"
1859                '(0 font-lock-keyword-face))
1860
1861          ;; Do menemonics and directives.
1862          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1863                '(1 font-lock-keyword-face))
1864
1865          ;; And anything else is punctuation.
1866          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1867                '(0 mdw-punct-face))))
1868
1869   (mdw-post-config-mode-hack)
1870   (run-hooks 'arm-assembler-mode-hook))
1871
1872 ;;;--------------------------------------------------------------------------
1873 ;;; Assembler mode.
1874
1875 (defun mdw-fontify-asm ()
1876   (modify-syntax-entry ?' "\"")
1877   (modify-syntax-entry ?. "w")
1878   (setf fill-prefix nil)
1879   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1880
1881 ;;;--------------------------------------------------------------------------
1882 ;;; TCL configuration.
1883
1884 (defun mdw-fontify-tcl ()
1885   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1886   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1887   (make-local-variable 'font-lock-keywords)
1888   (setq font-lock-keywords
1889         (list
1890          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1891                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1892                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1893                '(0 mdw-number-face))
1894          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1895                '(0 mdw-punct-face))))
1896   (mdw-post-config-mode-hack))
1897
1898 ;;;--------------------------------------------------------------------------
1899 ;;; REXX configuration.
1900
1901 (defun mdw-rexx-electric-* ()
1902   (interactive)
1903   (insert ?*)
1904   (rexx-indent-line))
1905
1906 (defun mdw-rexx-indent-newline-indent ()
1907   (interactive)
1908   (rexx-indent-line)
1909   (if abbrev-mode (expand-abbrev))
1910   (newline-and-indent))
1911
1912 (defun mdw-fontify-rexx ()
1913
1914   ;; Various bits of fiddling.
1915   (setq mdw-auto-indent nil)
1916   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1917   (local-set-key [?*] 'mdw-rexx-electric-*)
1918   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1919           '(?! ?? ?# ?@ ?$))
1920   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1921
1922   ;; Set up keywords and things for fontification.
1923   (make-local-variable 'font-lock-keywords-case-fold-search)
1924   (setq font-lock-keywords-case-fold-search t)
1925
1926   (setq rexx-indent 2)
1927   (setq rexx-end-indent rexx-indent)
1928   (setq rexx-cont-indent rexx-indent)
1929
1930   (make-local-variable 'font-lock-keywords)
1931   (let ((rexx-keywords
1932          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1933                       "else" "end" "engineering" "exit" "expose" "for"
1934                       "forever" "form" "fuzz" "if" "interpret" "iterate"
1935                       "leave" "linein" "name" "nop" "numeric" "off" "on"
1936                       "options" "otherwise" "parse" "procedure" "pull"
1937                       "push" "queue" "return" "say" "select" "signal"
1938                       "scientific" "source" "then" "trace" "to" "until"
1939                       "upper" "value" "var" "version" "when" "while"
1940                       "with"
1941
1942                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1943                       "center" "center" "charin" "charout" "chars"
1944                       "compare" "condition" "copies" "c2d" "c2x"
1945                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
1946                       "errortext" "format" "fuzz" "insert" "lastpos"
1947                       "left" "length" "lineout" "lines" "max" "min"
1948                       "overlay" "pos" "queued" "random" "reverse" "right"
1949                       "sign" "sourceline" "space" "stream" "strip"
1950                       "substr" "subword" "symbol" "time" "translate"
1951                       "trunc" "value" "verify" "word" "wordindex"
1952                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1953                       "x2d")))
1954
1955     (setq font-lock-keywords
1956           (list
1957
1958            ;; Set up the keywords defined above.
1959            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1960                  '(0 font-lock-keyword-face))
1961
1962            ;; Fontify all symbols the same way.
1963            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1964                          "[A-Za-z0-9.!?_#@$]+\\)")
1965                  '(0 font-lock-variable-name-face))
1966
1967            ;; And everything else is punctuation.
1968            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1969                  '(0 mdw-punct-face)))))
1970
1971   (mdw-post-config-mode-hack))
1972
1973 ;;;--------------------------------------------------------------------------
1974 ;;; Standard ML programming style.
1975
1976 (defun mdw-fontify-sml ()
1977
1978   ;; Make underscore an honorary letter.
1979   (modify-syntax-entry ?' "w")
1980
1981   ;; Set fill prefix.
1982   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1983
1984   ;; Now define fontification things.
1985   (make-local-variable 'font-lock-keywords)
1986   (let ((sml-keywords
1987          (mdw-regexps "abstype" "and" "andalso" "as"
1988                       "case"
1989                       "datatype" "do"
1990                       "else" "end" "eqtype" "exception"
1991                       "fn" "fun" "functor"
1992                       "handle"
1993                       "if" "in" "include" "infix" "infixr"
1994                       "let" "local"
1995                       "nonfix"
1996                       "of" "op" "open" "orelse"
1997                       "raise" "rec"
1998                       "sharing" "sig" "signature" "struct" "structure"
1999                       "then" "type"
2000                       "val"
2001                       "where" "while" "with" "withtype")))
2002
2003     (setq font-lock-keywords
2004           (list
2005
2006            ;; Set up the keywords defined above.
2007            (list (concat "\\<\\(" sml-keywords "\\)\\>")
2008                  '(0 font-lock-keyword-face))
2009
2010            ;; At least numbers are simpler than C.
2011            (list (concat "\\<\\(\\~\\|\\)"
2012                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
2013                                    "[wW][0-9]+\\)\\|"
2014                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2015                                          "\\([eE]\\(\\~\\|\\)"
2016                                                 "[0-9]+\\|\\)\\)\\)")
2017                  '(0 mdw-number-face))
2018
2019            ;; And anything else is punctuation.
2020            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2021                  '(0 mdw-punct-face)))))
2022
2023   (mdw-post-config-mode-hack))
2024
2025 ;;;--------------------------------------------------------------------------
2026 ;;; Haskell configuration.
2027
2028 (defun mdw-fontify-haskell ()
2029
2030   ;; Fiddle with syntax table to get comments right.
2031   (modify-syntax-entry ?' "\"")
2032   (modify-syntax-entry ?- ". 123")
2033   (modify-syntax-entry ?{ ". 1b")
2034   (modify-syntax-entry ?} ". 4b")
2035   (modify-syntax-entry ?\n ">")
2036
2037   ;; Set fill prefix.
2038   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2039
2040   ;; Fiddle with fontification.
2041   (make-local-variable 'font-lock-keywords)
2042   (let ((haskell-keywords
2043          (mdw-regexps "as" "case" "ccall" "class" "data" "default"
2044                       "deriving" "do" "else" "foreign" "hiding" "if"
2045                       "import" "in" "infix" "infixl" "infixr" "instance"
2046                       "let" "module" "newtype" "of" "qualified" "safe"
2047                       "stdcall" "then" "type" "unsafe" "where")))
2048
2049     (setq font-lock-keywords
2050           (list
2051            (list "--.*$"
2052                  '(0 font-lock-comment-face))
2053            (list (concat "\\<\\(" haskell-keywords "\\)\\>")
2054                  '(0 font-lock-keyword-face))
2055            (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2056                          "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
2057                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2058                  '(0 mdw-number-face))
2059            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2060                  '(0 mdw-punct-face)))))
2061
2062   (mdw-post-config-mode-hack))
2063
2064 ;;;--------------------------------------------------------------------------
2065 ;;; Erlang configuration.
2066
2067 (setq erlang-electric-commands nil)
2068
2069 (defun mdw-fontify-erlang ()
2070
2071   ;; Set fill prefix.
2072   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2073
2074   ;; Fiddle with fontification.
2075   (make-local-variable 'font-lock-keywords)
2076   (let ((erlang-keywords
2077          (mdw-regexps "after" "and" "andalso"
2078                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2079                       "case" "catch" "cond"
2080                       "div" "end" "fun" "if" "let" "not"
2081                       "of" "or" "orelse"
2082                       "query" "receive" "rem" "try" "when" "xor")))
2083
2084     (setq font-lock-keywords
2085           (list
2086            (list "%.*$"
2087                  '(0 font-lock-comment-face))
2088            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2089                  '(0 font-lock-keyword-face))
2090            (list (concat "^-\\sw+\\>")
2091                  '(0 font-lock-keyword-face))
2092            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2093                  '(0 mdw-number-face))
2094            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2095                  '(0 mdw-punct-face)))))
2096
2097   (mdw-post-config-mode-hack))
2098
2099 ;;;--------------------------------------------------------------------------
2100 ;;; Texinfo configuration.
2101
2102 (defun mdw-fontify-texinfo ()
2103
2104   ;; Set fill prefix.
2105   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2106
2107   ;; Real fontification things.
2108   (make-local-variable 'font-lock-keywords)
2109   (setq font-lock-keywords
2110         (list
2111
2112          ;; Environment names are keywords.
2113          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
2114                '(2 font-lock-keyword-face))
2115
2116          ;; Unmark escaped magic characters.
2117          (list "\\(@\\)\\([@{}]\\)"
2118                '(1 font-lock-keyword-face)
2119                '(2 font-lock-variable-name-face))
2120
2121          ;; Make sure we get comments properly.
2122          (list "@c\\(\\|omment\\)\\( .*\\)?$"
2123                '(0 font-lock-comment-face))
2124
2125          ;; Command names are keywords.
2126          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2127                '(0 font-lock-keyword-face))
2128
2129          ;; Fontify TeX special characters as punctuation.
2130          (list "[{}]+"
2131                '(0 mdw-punct-face))))
2132
2133   (mdw-post-config-mode-hack))
2134
2135 ;;;--------------------------------------------------------------------------
2136 ;;; TeX and LaTeX configuration.
2137
2138 (defun mdw-fontify-tex ()
2139   (setq ispell-parser 'tex)
2140   (turn-on-reftex)
2141
2142   ;; Don't make maths into a string.
2143   (modify-syntax-entry ?$ ".")
2144   (modify-syntax-entry ?$ "." font-lock-syntax-table)
2145   (local-set-key [?$] 'self-insert-command)
2146
2147   ;; Set fill prefix.
2148   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2149
2150   ;; Real fontification things.
2151   (make-local-variable 'font-lock-keywords)
2152   (setq font-lock-keywords
2153         (list
2154
2155          ;; Environment names are keywords.
2156          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2157                        "{\\([^}\n]*\\)}")
2158                '(2 font-lock-keyword-face))
2159
2160          ;; Suspended environment names are keywords too.
2161          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2162                        "{\\([^}\n]*\\)}")
2163                '(3 font-lock-keyword-face))
2164
2165          ;; Command names are keywords.
2166          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2167                '(0 font-lock-keyword-face))
2168
2169          ;; Handle @/.../ for italics.
2170          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2171          ;;       '(1 font-lock-keyword-face)
2172          ;;       '(3 font-lock-keyword-face))
2173
2174          ;; Handle @*...* for boldness.
2175          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2176          ;;       '(1 font-lock-keyword-face)
2177          ;;       '(3 font-lock-keyword-face))
2178
2179          ;; Handle @`...' for literal syntax things.
2180          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2181          ;;       '(1 font-lock-keyword-face)
2182          ;;       '(3 font-lock-keyword-face))
2183
2184          ;; Handle @<...> for nonterminals.
2185          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2186          ;;       '(1 font-lock-keyword-face)
2187          ;;       '(3 font-lock-keyword-face))
2188
2189          ;; Handle other @-commands.
2190          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2191          ;;       '(0 font-lock-keyword-face))
2192
2193          ;; Make sure we get comments properly.
2194          (list "%.*"
2195                '(0 font-lock-comment-face))
2196
2197          ;; Fontify TeX special characters as punctuation.
2198          (list "[$^_{}#&]"
2199                '(0 mdw-punct-face))))
2200
2201   (mdw-post-config-mode-hack))
2202
2203 ;;;--------------------------------------------------------------------------
2204 ;;; SGML hacking.
2205
2206 (defun mdw-sgml-mode ()
2207   (interactive)
2208   (sgml-mode)
2209   (mdw-standard-fill-prefix "")
2210   (make-local-variable 'sgml-delimiters)
2211   (setq sgml-delimiters
2212         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2213           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2214           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2215           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2216           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2217           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2218           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2219           "NULL" ""))
2220   (setq major-mode 'mdw-sgml-mode)
2221   (setq mode-name "[mdw] SGML")
2222   (run-hooks 'mdw-sgml-mode-hook))
2223
2224 ;;;--------------------------------------------------------------------------
2225 ;;; Configuration files.
2226
2227 (defvar mdw-conf-quote-normal nil
2228   "*Control syntax category of quote characters `\"' and `''.
2229 If this is `t', consider quote characters to be normal
2230 punctuation, as for `conf-quote-normal'.  If this is `nil' then
2231 leave quote characters as quotes.  If this is a list, then
2232 consider the quote characters in the list to be normal
2233 punctuation.  If this is a single quote character, then consider
2234 that character only to be normal punctuation.")
2235 (defun mdw-conf-quote-normal-acceptable-value-p (value)
2236   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2237   (or (booleanp value)
2238       (every (lambda (v) (memq v '(?\" ?')))
2239              (if (listp value) value (list value)))))
2240 (put 'mdw-conf-quote-normal 'safe-local-variable '
2241      mdw-conf-quote-normal-acceptable-value-p)
2242
2243 (defun mdw-fix-up-quote ()
2244   "Apply the setting of `mdw-conf-quote-normal'."
2245   (let ((flag mdw-conf-quote-normal))
2246     (cond ((eq flag t)
2247            (conf-quote-normal t))
2248           ((not flag)
2249            nil)
2250           (t
2251            (let ((table (copy-syntax-table (syntax-table))))
2252              (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2253                    (if (listp flag) flag (list flag)))
2254              (set-syntax-table table)
2255              (and font-lock-mode (font-lock-fontify-buffer)))))))
2256 (defun mdw-fix-up-quote-hack ()
2257   "Unpleasant hack to call `mdw-fix-up-quote' at the right time.
2258 Annoyingly, `hack-local-variables' is done after `set-auto-mode'
2259 so we wouldn't see a local-variable setting of
2260 `mdw-conf-quote-normal' in `conf-mode-hook'.  Instead, wire
2261 ourselves onto `hack-local-variables-hook' here, and check the
2262 setting once it's actually been made."
2263   (add-hook 'hack-local-variables-hook 'mdw-fix-up-quote t t))
2264 (add-hook 'conf-mode-hook 'mdw-fix-up-quote-hack t)
2265
2266 ;;;--------------------------------------------------------------------------
2267 ;;; Shell scripts.
2268
2269 (defun mdw-setup-sh-script-mode ()
2270
2271   ;; Fetch the shell interpreter's name.
2272   (let ((shell-name sh-shell-file))
2273
2274     ;; Try reading the hash-bang line.
2275     (save-excursion
2276       (goto-char (point-min))
2277       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2278           (setq shell-name (match-string 1))))
2279
2280     ;; Now try to set the shell.
2281     ;;
2282     ;; Don't let `sh-set-shell' bugger up my script.
2283     (let ((executable-set-magic #'(lambda (s &rest r) s)))
2284       (sh-set-shell shell-name)))
2285
2286   ;; Now enable my keys and the fontification.
2287   (mdw-misc-mode-config)
2288
2289   ;; Set the indentation level correctly.
2290   (setq sh-indentation 2)
2291   (setq sh-basic-offset 2))
2292
2293 (setq sh-shell-file "/bin/sh")
2294
2295 ;; Awful hacking to override the shell detection for particular scripts.
2296 (defmacro define-custom-shell-mode (name shell)
2297   `(defun ,name ()
2298      (interactive)
2299      (set (make-local-variable 'sh-shell-file) ,shell)
2300      (sh-mode)))
2301 (define-custom-shell-mode bash-mode "/bin/bash")
2302 (define-custom-shell-mode rc-mode "/usr/bin/rc")
2303 (put 'sh-shell-file 'permanent-local t)
2304
2305 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
2306 (eval-after-load "sh-script"
2307   '(or (assq 'rc sh-mode-syntax-table-input)
2308        (let ((frag '(nil
2309                      ?# "<"
2310                      ?\n ">#"
2311                      ?\" "\"\""
2312                      ?\' "\"\'"
2313                      ?$ "'"
2314                      ?\` "."
2315                      ?! "_"
2316                      ?% "_"
2317                      ?. "_"
2318                      ?^ "_"
2319                      ?~ "_"
2320                      ?, "_"
2321                      ?= "."
2322                      ?< "."
2323                      ?> "."))
2324              (assoc (assq 'rc sh-mode-syntax-table-input)))
2325          (if assoc
2326              (rplacd assoc frag)
2327            (setq sh-mode-syntax-table-input
2328                  (cons (cons 'rc frag)
2329                        sh-mode-syntax-table-input))))))
2330
2331 ;;;--------------------------------------------------------------------------
2332 ;;; Emacs shell mode.
2333
2334 (defun mdw-eshell-prompt ()
2335   (let ((left "[") (right "]"))
2336     (when (= (user-uid) 0)
2337       (setq left "«" right "»"))
2338     (concat left
2339             (save-match-data
2340               (replace-regexp-in-string "\\..*$" "" (system-name)))
2341             " "
2342             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
2343                    (home (expand-file-name "~")) (nhome (length home)))
2344               (if (and (>= npwd nhome)
2345                        (or (= nhome npwd)
2346                            (= (elt pwd nhome) ?/))
2347                        (string= (substring pwd 0 nhome) home))
2348                   (concat "~" (substring pwd (length home)))
2349                 pwd))
2350             right)))
2351 (setq eshell-prompt-function 'mdw-eshell-prompt)
2352 (setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
2353
2354 (defun eshell/e (file) (find-file file) nil)
2355 (defun eshell/ee (file) (find-file-other-window file) nil)
2356 (defun eshell/w3m (url) (w3m-goto-url url) nil)
2357
2358 (mdw-define-face eshell-prompt (t :weight bold))
2359 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2360 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2361 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2362 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2363 (mdw-define-face eshell-ls-executable (t :weight bold))
2364 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2365 (mdw-define-face eshell-ls-readonly (t nil))
2366 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2367
2368 ;;;--------------------------------------------------------------------------
2369 ;;; Messages-file mode.
2370
2371 (defun messages-mode-guts ()
2372   (setq messages-mode-syntax-table (make-syntax-table))
2373   (set-syntax-table messages-mode-syntax-table)
2374   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2375   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2376   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2377   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2378   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2379   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2380   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2381   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2382   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2383   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2384   (make-local-variable 'comment-start)
2385   (make-local-variable 'comment-end)
2386   (make-local-variable 'indent-line-function)
2387   (setq indent-line-function 'indent-relative)
2388   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2389   (make-local-variable 'font-lock-defaults)
2390   (make-local-variable 'messages-mode-keywords)
2391   (let ((keywords
2392          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2393                       "export" "enum" "fixed-octetstring" "flags"
2394                       "harmless" "map" "nested" "optional"
2395                       "optional-tagged" "package" "primitive"
2396                       "primitive-nullfree" "relaxed[ \t]+enum"
2397                       "set" "table" "tagged-optional"   "union"
2398                       "variadic" "vector" "version" "version-tag")))
2399     (setq messages-mode-keywords
2400           (list
2401            (list (concat "\\<\\(" keywords "\\)\\>:")
2402                  '(0 font-lock-keyword-face))
2403            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2404            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2405              (0 font-lock-variable-name-face))
2406            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2407            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2408              (0 mdw-punct-face)))))
2409   (setq font-lock-defaults
2410         '(messages-mode-keywords nil nil nil nil))
2411   (run-hooks 'messages-file-hook))
2412
2413 (defun messages-mode ()
2414   (interactive)
2415   (fundamental-mode)
2416   (setq major-mode 'messages-mode)
2417   (setq mode-name "Messages")
2418   (messages-mode-guts)
2419   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2420   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2421   (setq comment-start "# ")
2422   (setq comment-end "")
2423   (run-hooks 'messages-mode-hook))
2424
2425 (defun cpp-messages-mode ()
2426   (interactive)
2427   (fundamental-mode)
2428   (setq major-mode 'cpp-messages-mode)
2429   (setq mode-name "CPP Messages")
2430   (messages-mode-guts)
2431   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2432   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2433   (setq comment-start "/* ")
2434   (setq comment-end " */")
2435   (let ((preprocessor-keywords
2436          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2437                       "ident" "if" "ifdef" "ifndef" "import" "include"
2438                       "line" "pragma" "unassert" "undef" "warning")))
2439     (setq messages-mode-keywords
2440           (append (list (list (concat "^[ \t]*\\#[ \t]*"
2441                                       "\\(include\\|import\\)"
2442                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2443                               '(2 font-lock-string-face))
2444                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2445                                       preprocessor-keywords
2446                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
2447                               '(1 font-lock-keyword-face)))
2448                   messages-mode-keywords)))
2449   (run-hooks 'cpp-messages-mode-hook))
2450
2451 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2452 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2453 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2454
2455 ;;;--------------------------------------------------------------------------
2456 ;;; Messages-file mode.
2457
2458 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2459   "Face to use for subsittution directives.")
2460 (make-face 'mallow-driver-substitution-face)
2461 (defvar mallow-driver-text-face 'mallow-driver-text-face
2462   "Face to use for body text.")
2463 (make-face 'mallow-driver-text-face)
2464
2465 (defun mallow-driver-mode ()
2466   (interactive)
2467   (fundamental-mode)
2468   (setq major-mode 'mallow-driver-mode)
2469   (setq mode-name "Mallow driver")
2470   (setq mallow-driver-mode-syntax-table (make-syntax-table))
2471   (set-syntax-table mallow-driver-mode-syntax-table)
2472   (make-local-variable 'comment-start)
2473   (make-local-variable 'comment-end)
2474   (make-local-variable 'indent-line-function)
2475   (setq indent-line-function 'indent-relative)
2476   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2477   (make-local-variable 'font-lock-defaults)
2478   (make-local-variable 'mallow-driver-mode-keywords)
2479   (let ((keywords
2480          (mdw-regexps "each" "divert" "file" "if"
2481                       "perl" "set" "string" "type" "write")))
2482     (setq mallow-driver-mode-keywords
2483           (list
2484            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2485                  '(0 font-lock-keyword-face))
2486            (list "^%\\s *\\(#.*\\|\\)$"
2487                  '(0 font-lock-comment-face))
2488            (list "^%"
2489                  '(0 font-lock-keyword-face))
2490            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2491            (list "\\${[^}]*}"
2492                  '(0 mallow-driver-substitution-face t)))))
2493   (setq font-lock-defaults
2494         '(mallow-driver-mode-keywords nil nil nil nil))
2495   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2496   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2497   (setq comment-start "%# ")
2498   (setq comment-end "")
2499   (run-hooks 'mallow-driver-mode-hook))
2500
2501 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2502
2503 ;;;--------------------------------------------------------------------------
2504 ;;; NFast debugs.
2505
2506 (defun nfast-debug-mode ()
2507   (interactive)
2508   (fundamental-mode)
2509   (setq major-mode 'nfast-debug-mode)
2510   (setq mode-name "NFast debug")
2511   (setq messages-mode-syntax-table (make-syntax-table))
2512   (set-syntax-table messages-mode-syntax-table)
2513   (make-local-variable 'font-lock-defaults)
2514   (make-local-variable 'nfast-debug-mode-keywords)
2515   (setq truncate-lines t)
2516   (setq nfast-debug-mode-keywords
2517         (list
2518          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2519            (0 font-lock-keyword-face))
2520          (list (concat "^[ \t]+\\(\\("
2521                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2522                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2523                        "[ \t]+\\)*"
2524                        "[0-9a-fA-F]+\\)[ \t]*$")
2525            '(0 mdw-number-face))
2526          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2527            (1 font-lock-keyword-face))
2528          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2529            (1 font-lock-warning-face))
2530          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2531            (1 nil))
2532          (list (concat "^[ \t]+\\.cmd=[ \t]+"
2533                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2534            '(1 font-lock-keyword-face))
2535          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2536          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2537          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2538          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2539   (setq font-lock-defaults
2540         '(nfast-debug-mode-keywords nil nil nil nil))
2541   (run-hooks 'nfast-debug-mode-hook))
2542
2543 ;;;--------------------------------------------------------------------------
2544 ;;; Other languages.
2545
2546 ;; Smalltalk.
2547
2548 (defun mdw-setup-smalltalk ()
2549   (and mdw-auto-indent
2550        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2551   (make-local-variable 'mdw-auto-indent)
2552   (setq mdw-auto-indent nil)
2553   (local-set-key "\C-i" 'smalltalk-reindent))
2554
2555 (defun mdw-fontify-smalltalk ()
2556   (make-local-variable 'font-lock-keywords)
2557   (setq font-lock-keywords
2558         (list
2559          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2560                '(0 font-lock-keyword-face))
2561          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2562                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2563                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2564                '(0 mdw-number-face))
2565          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2566                '(0 mdw-punct-face))))
2567   (mdw-post-config-mode-hack))
2568
2569 ;; Lispy languages.
2570
2571 ;; Unpleasant bodge.
2572 (unless (boundp 'slime-repl-mode-map)
2573   (setq slime-repl-mode-map (make-sparse-keymap)))
2574
2575 (defun mdw-indent-newline-and-indent ()
2576   (interactive)
2577   (indent-for-tab-command)
2578   (newline-and-indent))
2579
2580 (eval-after-load "cl-indent"
2581   '(progn
2582      (mapc #'(lambda (pair)
2583                (put (car pair)
2584                     'common-lisp-indent-function
2585                     (cdr pair)))
2586       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2587         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2588
2589 (defun mdw-common-lisp-indent ()
2590   (make-local-variable 'lisp-indent-function)
2591   (setq lisp-indent-function 'common-lisp-indent-function))
2592
2593 (setq lisp-simple-loop-indentation 2
2594       lisp-loop-keyword-indentation 6
2595       lisp-loop-forms-indentation 6)
2596
2597 (defun mdw-fontify-lispy ()
2598
2599   ;; Set fill prefix.
2600   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2601
2602   ;; Not much fontification needed.
2603   (make-local-variable 'font-lock-keywords)
2604   (setq font-lock-keywords
2605         (list
2606          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2607                '(0 mdw-punct-face))))
2608
2609   (mdw-post-config-mode-hack))
2610
2611 (defun comint-send-and-indent ()
2612   (interactive)
2613   (comint-send-input)
2614   (and mdw-auto-indent
2615        (indent-for-tab-command)))
2616
2617 (defun mdw-setup-m4 ()
2618   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2619
2620 ;;;--------------------------------------------------------------------------
2621 ;;; Text mode.
2622
2623 (defun mdw-text-mode ()
2624   (setq fill-column 72)
2625   (flyspell-mode t)
2626   (mdw-standard-fill-prefix
2627    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2628   (auto-fill-mode 1))
2629
2630 ;;;--------------------------------------------------------------------------
2631 ;;; Outline and hide/show modes.
2632
2633 (defun mdw-outline-collapse-all ()
2634   "Completely collapse everything in the entire buffer."
2635   (interactive)
2636   (save-excursion
2637     (goto-char (point-min))
2638     (while (< (point) (point-max))
2639       (hide-subtree)
2640       (forward-line))))
2641
2642 (setq hs-hide-comments-when-hiding-all nil)
2643
2644 (defadvice hs-hide-all (after hide-first-comment activate)
2645   (save-excursion (hs-hide-initial-comment-block)))
2646
2647 ;;;--------------------------------------------------------------------------
2648 ;;; Shell mode.
2649
2650 (defun mdw-sh-mode-setup ()
2651   (local-set-key [?\C-a] 'comint-bol)
2652   (add-hook 'comint-output-filter-functions
2653             'comint-watch-for-password-prompt))
2654
2655 (defun mdw-term-mode-setup ()
2656   (setq term-prompt-regexp shell-prompt-pattern)
2657   (make-local-variable 'mouse-yank-at-point)
2658   (make-local-variable 'transient-mark-mode)
2659   (setq mouse-yank-at-point t)
2660   (auto-fill-mode -1)
2661   (setq tab-width 8))
2662
2663 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2664 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
2665 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2666 (defun term-send-meta-meta-something ()
2667   (interactive)
2668   (term-send-raw-string "\e\e")
2669   (term-send-raw))
2670 (eval-after-load 'term
2671   '(progn
2672      (define-key term-raw-map [?\e ?\e] nil)
2673      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2674      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2675      (define-key term-raw-map [M-right] 'term-send-meta-right)
2676      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2677      (define-key term-raw-map [M-left] 'term-send-meta-left)
2678      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2679
2680 (defadvice term-exec (before program-args-list compile activate)
2681   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
2682 This allows you to pass a list of arguments through `ansi-term'."
2683   (let ((program (ad-get-arg 2)))
2684     (if (listp program)
2685         (progn
2686           (ad-set-arg 2 (car program))
2687           (ad-set-arg 4 (cdr program))))))
2688
2689 (defun ssh (host)
2690   "Open a terminal containing an ssh session to the HOST."
2691   (interactive "sHost: ")
2692   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
2693
2694 ;;;--------------------------------------------------------------------------
2695 ;;; Inferior Emacs Lisp.
2696
2697 (setq comint-prompt-read-only t)
2698
2699 (eval-after-load "comint"
2700   '(progn
2701      (define-key comint-mode-map "\C-w" 'comint-kill-region)
2702      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
2703
2704 (eval-after-load "ielm"
2705   '(progn
2706      (define-key ielm-map "\C-w" 'comint-kill-region)
2707      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
2708
2709 ;;;----- That's all, folks --------------------------------------------------
2710
2711 (provide 'dot-emacs)