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

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