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