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

   1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
   2 ;;;
   3 ;;; Functions and macros for .emacs
   4 ;;;
   5 ;;; (c) 2004 Mark Wooding
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 2 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software Foundation,
  22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23
  24 ;;;--------------------------------------------------------------------------
  25 ;;; Check command-line.
  26
  27 (defvar mdw-fast-startup nil
  28   "Whether .emacs should optimize for rapid startup.
  29 This may be at the expense of cool features.")
  30 (let ((probe nil) (next command-line-args))
  31   (while next
  32     (cond ((string= (car next) "--mdw-fast-startup")
  33            (setq mdw-fast-startup t)
  34            (if probe
  35                (rplacd probe (cdr next))
  36              (setq command-line-args (cdr next))))
  37           (t
  38            (setq probe next)))
  39     (setq next (cdr next))))
  40
  41 ;;;--------------------------------------------------------------------------
  42 ;;; Some general utilities.
  43
  44 (eval-when-compile
  45   (unless (fboundp 'make-regexp)
  46     (load "make-regexp"))
  47   (require 'cl))
  48
  49 (defmacro mdw-regexps (&rest list)
  50   "Turn a LIST of strings into a single regular expression at compile-time."
  51   (declare (indent nil)
  52            (debug 0))
  53   `',(make-regexp list))
  54
  55 (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   (local-set-key [C-return] 'newline)
 823   (make-local-variable 'page-delimiter)
 824   (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
 825   (setq comment-column 40)
 826   (auto-fill-mode 1)
 827   (setq fill-column 77)
 828   (setq show-trailing-whitespace t)
 829   (mdw-whitespace-mode 1)
 830   (and (fboundp 'gtags-mode)
 831        (gtags-mode))
 832   (if (fboundp 'hs-minor-mode)
 833       (trap (hs-minor-mode t))
 834     (outline-minor-mode t))
 835   (reveal-mode t)
 836   (trap (turn-on-font-lock)))
 837
 838 (defun mdw-post-config-mode-hack ()
 839   (mdw-whitespace-mode 1))
 840
 841 (eval-after-load 'gtags
 842   '(progn
 843      (dolist (key '([mouse-2] [mouse-3]))
 844        (define-key gtags-mode-map key nil))
 845      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
 846      (define-key gtags-select-mode-map [C-S-mouse-2]
 847        'gtags-select-tag-by-event)
 848      (dolist (map (list gtags-mode-map gtags-select-mode-map))
 849        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
 850
 851 ;; Backup file handling.
 852
 853 (defvar mdw-backup-disable-regexps nil
 854   "*List of regular expressions: if a file name matches any of
 855 these then the file is not backed up.")
 856
 857 (defun mdw-backup-enable-predicate (name)
 858   "[mdw]'s default backup predicate.
 859 Allows a backup if the standard predicate would allow it, and it
 860 doesn't match any of the regular expressions in
 861 `mdw-backup-disable-regexps'."
 862   (and (normal-backup-enable-predicate name)
 863        (let ((answer t) (list mdw-backup-disable-regexps))
 864          (save-match-data
 865            (while list
 866              (if (string-match (car list) name)
 867                  (setq answer nil))
 868              (setq list (cdr list)))
 869            answer))))
 870 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
 871
 872 ;; Frame cleanup.
 873
 874 (defun mdw-last-one-out-turn-off-the-lights (frame)
 875   "Disconnect from an X display if this was the last frame on that display."
 876   (let ((frame-display (frame-parameter frame 'display)))
 877     (when (and frame-display
 878                (eq window-system 'x)
 879                (not (some (lambda (fr)
 880                             (and (not (eq fr frame))
 881                                  (string= (frame-parameter fr 'display)
 882                                           frame-display)))
 883                           (frame-list))))
 884       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
 885 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
 886
 887 ;;;--------------------------------------------------------------------------
 888 ;;; Where is point?
 889
 890 (defvar mdw-point-overlay
 891   (let ((ov (make-overlay 0 0))
 892         (s "."))
 893     (overlay-put ov 'priority 2)
 894     (put-text-property 0 1 'display '(left-fringe vertical-bar) s)
 895     (overlay-put ov 'before-string s)
 896     (delete-overlay ov)
 897     ov)
 898   "An overlay used for showing where point is in the selected window.")
 899
 900 (defun mdw-remove-point-overlay ()
 901   "Remove the current-point overlay."
 902   (delete-overlay mdw-point-overlay))
 903
 904 (defun mdw-update-point-overlay ()
 905   "Mark the current point position with an overlay."
 906   (if (not mdw-point-overlay-mode)
 907       (mdw-remove-point-overlay)
 908     (overlay-put mdw-point-overlay 'window (selected-window))
 909     (if (bolp)
 910         (move-overlay mdw-point-overlay
 911                       (point) (1+ (point)) (current-buffer))
 912       (move-overlay mdw-point-overlay
 913                     (1- (point)) (point) (current-buffer)))))
 914
 915 (defvar mdw-point-overlay-buffers nil
 916   "List of buffers using `mdw-point-overlay-mode'.")
 917
 918 (define-minor-mode mdw-point-overlay-mode
 919   "Indicate current line with an overlay."
 920   :global nil
 921   (let ((buffer (current-buffer)))
 922     (setq mdw-point-overlay-buffers
 923           (mapcan (lambda (buf)
 924                     (if (and (buffer-live-p buf)
 925                              (not (eq buf buffer)))
 926                         (list buf)))
 927                   mdw-point-overlay-buffers))
 928     (if mdw-point-overlay-mode
 929         (setq mdw-point-overlay-buffers
 930               (cons buffer mdw-point-overlay-buffers))))
 931   (cond (mdw-point-overlay-buffers
 932          (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
 933          (add-hook 'post-command-hook 'mdw-update-point-overlay))
 934         (t
 935          (mdw-remove-point-overlay)
 936          (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
 937          (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
 938
 939 (define-globalized-minor-mode mdw-global-point-overlay-mode
 940   mdw-point-overlay-mode
 941   (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
 942
 943 ;;;--------------------------------------------------------------------------
 944 ;;; Fullscreen-ness.
 945
 946 (defvar mdw-full-screen-parameters
 947   '((menu-bar-lines . 0)
 948     ;(vertical-scroll-bars . nil)
 949     )
 950   "Frame parameters to set when making a frame fullscreen.")
 951
 952 (defvar mdw-full-screen-save
 953   '(width height)
 954   "Extra frame parameters to save when setting fullscreen.")
 955
 956 (defun mdw-toggle-full-screen (&optional frame)
 957   "Show the FRAME fullscreen."
 958   (interactive)
 959   (when window-system
 960     (cond ((frame-parameter frame 'fullscreen)
 961            (set-frame-parameter frame 'fullscreen nil)
 962            (modify-frame-parameters
 963             nil
 964             (or (frame-parameter frame 'mdw-full-screen-saved)
 965                 (mapcar (lambda (assoc)
 966                           (assq (car assoc) default-frame-alist))
 967                         mdw-full-screen-parameters))))
 968           (t
 969            (let ((saved (mapcar (lambda (param)
 970                                   (cons param (frame-parameter frame param)))
 971                                 (append (mapcar #'car
 972                                                 mdw-full-screen-parameters)
 973                                         mdw-full-screen-save))))
 974              (set-frame-parameter frame 'mdw-full-screen-saved saved))
 975            (modify-frame-parameters frame mdw-full-screen-parameters)
 976            (set-frame-parameter frame 'fullscreen 'fullboth)))))
 977
 978 ;;;--------------------------------------------------------------------------
 979 ;;; General fontification.
 980
 981 (defmacro mdw-define-face (name &rest body)
 982   "Define a face, and make sure it's actually set as the definition."
 983   (declare (indent 1)
 984            (debug 0))
 985   `(progn
 986      (make-face ',name)
 987      (defvar ,name ',name)
 988      (put ',name 'face-defface-spec ',body)
 989      (face-spec-set ',name ',body nil)))
 990
 991 (mdw-define-face default
 992   (((type w32)) :family "courier new" :height 85)
 993   (((type x)) :family "6x13" :foundry "trad" :height 130)
 994   (((type color)) :foreground "white" :background "black")
 995   (t nil))
 996 (mdw-define-face fixed-pitch
 997   (((type w32)) :family "courier new" :height 85)
 998   (((type x)) :family "6x13" :foundry "trad" :height 130)
 999   (t :foreground "white" :background "black"))
1000 (if (>= emacs-major-version 23)
1001     (mdw-define-face variable-pitch
1002       (((type x)) :family "sans" :height 100))
1003   (mdw-define-face variable-pitch
1004     (((type x)) :family "helvetica" :height 90)))
1005 (mdw-define-face region
1006   (((type tty) (class color)) :background "blue")
1007   (((type tty) (class mono)) :inverse-video t)
1008   (t :background "grey30"))
1009 (mdw-define-face match
1010   (((type tty) (class color)) :background "blue")
1011   (((type tty) (class mono)) :inverse-video t)
1012   (t :background "blue"))
1013 (mdw-define-face mc/cursor-face
1014   (((type tty) (class mono)) :inverse-video t)
1015   (t :background "red"))
1016 (mdw-define-face minibuffer-prompt
1017   (t :weight bold))
1018 (mdw-define-face mode-line
1019   (((class color)) :foreground "blue" :background "yellow"
1020                    :box (:line-width 1 :style released-button))
1021   (t :inverse-video t))
1022 (mdw-define-face mode-line-inactive
1023   (((class color)) :foreground "yellow" :background "blue"
1024                    :box (:line-width 1 :style released-button))
1025   (t :inverse-video t))
1026 (mdw-define-face nobreak-space
1027   (((type tty)))
1028   (t :inherit escape-glyph :underline t))
1029 (mdw-define-face scroll-bar
1030   (t :foreground "black" :background "lightgrey"))
1031 (mdw-define-face fringe
1032   (t :foreground "yellow"))
1033 (mdw-define-face show-paren-match
1034   (((class color)) :background "darkgreen")
1035   (t :underline t))
1036 (mdw-define-face show-paren-mismatch
1037   (((class color)) :background "red")
1038   (t :inverse-video t))
1039 (mdw-define-face highlight
1040   (((type x) (class color)) :background "DarkSeaGreen4")
1041   (((type tty) (class color)) :background "cyan")
1042   (t :inverse-video t))
1043
1044 (mdw-define-face holiday-face
1045   (t :background "red"))
1046 (mdw-define-face calendar-today-face
1047   (t :foreground "yellow" :weight bold))
1048
1049 (mdw-define-face comint-highlight-prompt
1050   (t :weight bold))
1051 (mdw-define-face comint-highlight-input
1052   (t nil))
1053
1054 (mdw-define-face dired-directory
1055   (t :foreground "cyan" :weight bold))
1056 (mdw-define-face dired-symlink
1057   (t :foreground "cyan"))
1058 (mdw-define-face dired-perm-write
1059   (t nil))
1060
1061 (mdw-define-face trailing-whitespace
1062   (((class color)) :background "red")
1063   (t :inverse-video t))
1064 (mdw-define-face mdw-punct-face
1065   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
1066 (mdw-define-face mdw-number-face
1067   (t :foreground "yellow"))
1068 (mdw-define-face mdw-trivial-face)
1069 (mdw-define-face font-lock-function-name-face
1070   (t :slant italic))
1071 (mdw-define-face font-lock-keyword-face
1072   (t :weight bold))
1073 (mdw-define-face font-lock-constant-face
1074   (t :slant italic))
1075 (mdw-define-face font-lock-builtin-face
1076   (t :weight bold))
1077 (mdw-define-face font-lock-type-face
1078   (t :weight bold :slant italic))
1079 (mdw-define-face font-lock-reference-face
1080   (t :weight bold))
1081 (mdw-define-face font-lock-variable-name-face
1082   (t :slant italic))
1083 (mdw-define-face font-lock-comment-delimiter-face
1084   (((class mono)) :weight bold)
1085   (((type tty) (class color)) :foreground "green")
1086   (t :slant italic :foreground "SeaGreen1"))
1087 (mdw-define-face font-lock-comment-face
1088   (((class mono)) :weight bold)
1089   (((type tty) (class color)) :foreground "green")
1090   (t :slant italic :foreground "SeaGreen1"))
1091 (mdw-define-face font-lock-string-face
1092   (((class mono)) :weight bold)
1093   (((class color)) :foreground "SkyBlue1"))
1094
1095 (mdw-define-face message-separator
1096   (t :background "red" :foreground "white" :weight bold))
1097 (mdw-define-face message-cited-text
1098   (default :slant italic)
1099   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1100 (mdw-define-face message-header-cc
1101   (default :weight bold)
1102   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1103 (mdw-define-face message-header-newsgroups
1104   (default :weight bold)
1105   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1106 (mdw-define-face message-header-subject
1107   (default :weight bold)
1108   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1109 (mdw-define-face message-header-to
1110   (default :weight bold)
1111   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1112 (mdw-define-face message-header-xheader
1113   (default :weight bold)
1114   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1115 (mdw-define-face message-header-other
1116   (default :weight bold)
1117   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1118 (mdw-define-face message-header-name
1119   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1120 (mdw-define-face which-func
1121   (t nil))
1122
1123 (mdw-define-face diff-header
1124   (t nil))
1125 (mdw-define-face diff-index
1126   (t :weight bold))
1127 (mdw-define-face diff-file-header
1128   (t :weight bold))
1129 (mdw-define-face diff-hunk-header
1130   (t :foreground "SkyBlue1"))
1131 (mdw-define-face diff-function
1132   (t :foreground "SkyBlue1" :weight bold))
1133 (mdw-define-face diff-header
1134   (t :background "grey10"))
1135 (mdw-define-face diff-added
1136   (t :foreground "green"))
1137 (mdw-define-face diff-removed
1138   (t :foreground "red"))
1139 (mdw-define-face diff-context
1140   (t nil))
1141 (mdw-define-face diff-refine-change
1142   (((class color) (type x)) :background "RoyalBlue4")
1143   (t :underline t))
1144
1145 (mdw-define-face dylan-header-background
1146   (((class color) (type x)) :background "NavyBlue")
1147   (t :background "blue"))
1148
1149 (mdw-define-face magit-diff-add
1150   (t :foreground "green"))
1151 (mdw-define-face magit-diff-del
1152   (t :foreground "red"))
1153 (mdw-define-face magit-diff-file-header
1154   (t :weight bold))
1155 (mdw-define-face magit-diff-hunk-header
1156   (t :foreground "SkyBlue1"))
1157 (mdw-define-face magit-item-highlight
1158   (((type tty)) :background "blue")
1159   (t :background "DarkSeaGreen4"))
1160 (mdw-define-face magit-log-head-label-remote
1161   (((type tty)) :background "cyan" :foreground "green")
1162   (t :background "grey11" :foreground "DarkSeaGreen2" :box t))
1163 (mdw-define-face magit-log-head-label-local
1164   (((type tty)) :background "cyan" :foreground "yellow")
1165   (t :background "grey11" :foreground "LightSkyBlue1" :box t))
1166 (mdw-define-face magit-log-head-label-tags
1167   (((type tty)) :background "red" :foreground "yellow")
1168   (t :background "LemonChiffon1" :foreground "goldenrod4" :box t))
1169 (mdw-define-face magit-log-graph
1170   (((type tty)) :foreground "magenta")
1171   (t :foreground "grey80"))
1172
1173 (mdw-define-face erc-input-face
1174   (t :foreground "red"))
1175
1176 (mdw-define-face woman-bold
1177   (t :weight bold))
1178 (mdw-define-face woman-italic
1179   (t :slant italic))
1180
1181 (eval-after-load "rst"
1182   '(progn
1183      (mdw-define-face rst-level-1-face
1184        (t :foreground "SkyBlue1" :weight bold))
1185      (mdw-define-face rst-level-2-face
1186        (t :foreground "SeaGreen1" :weight bold))
1187      (mdw-define-face rst-level-3-face
1188        (t :weight bold))
1189      (mdw-define-face rst-level-4-face
1190        (t :slant italic))
1191      (mdw-define-face rst-level-5-face
1192        (t :underline t))
1193      (mdw-define-face rst-level-6-face
1194        ())))
1195
1196 (mdw-define-face p4-depot-added-face
1197   (t :foreground "green"))
1198 (mdw-define-face p4-depot-branch-op-face
1199   (t :foreground "yellow"))
1200 (mdw-define-face p4-depot-deleted-face
1201   (t :foreground "red"))
1202 (mdw-define-face p4-depot-unmapped-face
1203   (t :foreground "SkyBlue1"))
1204 (mdw-define-face p4-diff-change-face
1205   (t :foreground "yellow"))
1206 (mdw-define-face p4-diff-del-face
1207   (t :foreground "red"))
1208 (mdw-define-face p4-diff-file-face
1209   (t :foreground "SkyBlue1"))
1210 (mdw-define-face p4-diff-head-face
1211   (t :background "grey10"))
1212 (mdw-define-face p4-diff-ins-face
1213   (t :foreground "green"))
1214
1215 (mdw-define-face w3m-anchor-face
1216   (t :foreground "SkyBlue1" :underline t))
1217 (mdw-define-face w3m-arrived-anchor-face
1218   (t :foreground "SkyBlue1" :underline t))
1219
1220 (mdw-define-face whizzy-slice-face
1221   (t :background "grey10"))
1222 (mdw-define-face whizzy-error-face
1223   (t :background "darkred"))
1224
1225 ;; Ellipses used to indicate hidden text (and similar).
1226 (mdw-define-face mdw-ellipsis-face
1227   (((type tty)) :foreground "blue") (t :foreground "grey60"))
1228 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1229       (backslash (make-glyph-code ?\ 'mdw-ellipsis-face))
1230       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1231       (bar (make-glyph-code ?| mdw-ellipsis-face)))
1232   (set-display-table-slot standard-display-table 0 dollar)
1233   (set-display-table-slot standard-display-table 1 backslash)
1234   (set-display-table-slot standard-display-table 4
1235                           (vector dot dot dot))
1236   (set-display-table-slot standard-display-table 5 bar))
1237
1238 ;;;--------------------------------------------------------------------------
1239 ;;; C programming configuration.
1240
1241 ;; Linux kernel hacking.
1242
1243 (defvar linux-c-mode-hook)
1244
1245 (defun linux-c-mode ()
1246   (interactive)
1247   (c-mode)
1248   (setq major-mode 'linux-c-mode)
1249   (setq mode-name "Linux C")
1250   (run-hooks 'linux-c-mode-hook))
1251
1252 ;; Make C indentation nice.
1253
1254 (defun mdw-c-lineup-arglist (langelem)
1255   "Hack for DWIMmery in c-lineup-arglist."
1256   (if (save-excursion
1257         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1258       0
1259     (c-lineup-arglist langelem)))
1260
1261 (defun mdw-c-indent-extern-mumble (langelem)
1262   "Indent `extern \"...\" {' lines."
1263   (save-excursion
1264     (back-to-indentation)
1265     (if (looking-at
1266          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1267         c-basic-offset
1268       nil)))
1269
1270 (defun mdw-c-style ()
1271   (c-add-style "[mdw] C and C++ style"
1272                '((c-basic-offset . 2)
1273                  (comment-column . 40)
1274                  (c-class-key . "class")
1275                  (c-backslash-column . 72)
1276                  (c-offsets-alist
1277                   (substatement-open . (add 0 c-indent-one-line-block))
1278                   (defun-open . (add 0 c-indent-one-line-block))
1279                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
1280                   (topmost-intro . mdw-c-indent-extern-mumble)
1281                   (cpp-define-intro . 0)
1282                   (knr-argdecl . 0)
1283                   (inextern-lang . [0])
1284                   (label . 0)
1285                   (case-label . +)
1286                   (access-label . -)
1287                   (inclass . +)
1288                   (inline-open . ++)
1289                   (statement-cont . +)
1290                   (statement-case-intro . +)))
1291                t))
1292
1293 (defvar mdw-c-comment-fill-prefix
1294   `((,(concat "\\([ \t]*/?\\)"
1295               "\\(\*\\|//]\\)"
1296               "\\([ \t]*\\)"
1297               "\\([A-Za-z]+:[ \t]*\\)?"
1298               mdw-hanging-indents)
1299      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1300   "Fill prefix matching C comments (both kinds).")
1301
1302 (defun mdw-fontify-c-and-c++ ()
1303
1304   ;; Fiddle with some syntax codes.
1305   (modify-syntax-entry ?* ". 23")
1306   (modify-syntax-entry ?/ ". 124b")
1307   (modify-syntax-entry ?\n "> b")
1308
1309   ;; Other stuff.
1310   (mdw-c-style)
1311   (setq c-hanging-comment-ender-p nil)
1312   (setq c-backslash-column 72)
1313   (setq c-label-minimum-indentation 0)
1314   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1315
1316   ;; Now define things to be fontified.
1317   (make-local-variable 'font-lock-keywords)
1318   (let ((c-keywords
1319          (mdw-regexps "and"             ;C++
1320                       "and_eq"          ;C++
1321                       "asm"             ;K&R, GCC
1322                       "auto"            ;K&R, C89
1323                       "bitand"          ;C++
1324                       "bitor"           ;C++
1325                       "bool"            ;C++, C9X macro
1326                       "break"           ;K&R, C89
1327                       "case"            ;K&R, C89
1328                       "catch"           ;C++
1329                       "char"            ;K&R, C89
1330                       "class"           ;C++
1331                       "complex"         ;C9X macro, C++ template type
1332                       "compl"           ;C++
1333                       "const"           ;C89
1334                       "const_cast"      ;C++
1335                       "continue"        ;K&R, C89
1336                       "defined"         ;C89 preprocessor
1337                       "default"         ;K&R, C89
1338                       "delete"          ;C++
1339                       "do"              ;K&R, C89
1340                       "double"          ;K&R, C89
1341                       "dynamic_cast"    ;C++
1342                       "else"            ;K&R, C89
1343                       ;; "entry"        ;K&R -- never used
1344                       "enum"            ;C89
1345                       "explicit"        ;C++
1346                       "export"          ;C++
1347                       "extern"          ;K&R, C89
1348                       "float"           ;K&R, C89
1349                       "for"             ;K&R, C89
1350                       ;; "fortran"      ;K&R
1351                       "friend"          ;C++
1352                       "goto"            ;K&R, C89
1353                       "if"              ;K&R, C89
1354                       "imaginary"       ;C9X macro
1355                       "inline"          ;C++, C9X, GCC
1356                       "int"             ;K&R, C89
1357                       "long"            ;K&R, C89
1358                       "mutable"         ;C++
1359                       "namespace"       ;C++
1360                       "new"             ;C++
1361                       "operator"        ;C++
1362                       "or"              ;C++
1363                       "or_eq"           ;C++
1364                       "private"         ;C++
1365                       "protected"       ;C++
1366                       "public"          ;C++
1367                       "register"        ;K&R, C89
1368                       "reinterpret_cast" ;C++
1369                       "restrict"         ;C9X
1370                       "return"           ;K&R, C89
1371                       "short"            ;K&R, C89
1372                       "signed"           ;C89
1373                       "sizeof"           ;K&R, C89
1374                       "static"           ;K&R, C89
1375                       "static_cast"      ;C++
1376                       "struct"           ;K&R, C89
1377                       "switch"           ;K&R, C89
1378                       "template"         ;C++
1379                       "throw"            ;C++
1380                       "try"              ;C++
1381                       "this"             ;C++
1382                       "typedef"          ;C89
1383                       "typeid"           ;C++
1384                       "typeof"           ;GCC
1385                       "typename"         ;C++
1386                       "union"            ;K&R, C89
1387                       "unsigned"         ;K&R, C89
1388                       "using"            ;C++
1389                       "virtual"          ;C++
1390                       "void"             ;C89
1391                       "volatile"         ;C89
1392                       "wchar_t"          ;C++, C89 library type
1393                       "while"            ;K&R, C89
1394                       "xor"              ;C++
1395                       "xor_eq"           ;C++
1396                       "_Bool"            ;C9X
1397                       "_Complex"         ;C9X
1398                       "_Imaginary"       ;C9X
1399                       "_Pragma"          ;C9X preprocessor
1400                       "__alignof__"      ;GCC
1401                       "__asm__"          ;GCC
1402                       "__attribute__"    ;GCC
1403                       "__complex__"      ;GCC
1404                       "__const__"        ;GCC
1405                       "__extension__"    ;GCC
1406                       "__imag__"         ;GCC
1407                       "__inline__"       ;GCC
1408                       "__label__"        ;GCC
1409                       "__real__"         ;GCC
1410                       "__signed__"       ;GCC
1411                       "__typeof__"       ;GCC
1412                       "__volatile__"     ;GCC
1413                       ))
1414         (c-constants
1415          (mdw-regexps "false"           ;C++, C9X macro
1416                       "this"             ;C++
1417                       "true"             ;C++, C9X macro
1418                       ))
1419         (preprocessor-keywords
1420          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1421                       "ident" "if" "ifdef" "ifndef" "import" "include"
1422                       "line" "pragma" "unassert" "undef" "warning"))
1423         (objc-keywords
1424          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1425                       "interface" "private" "protected" "protocol" "public"
1426                       "selector")))
1427
1428     (setq font-lock-keywords
1429           (list
1430
1431            ;; Fontify include files as strings.
1432            (list (concat "^[ \t]*\\#[ \t]*"
1433                          "\\(include\\|import\\)"
1434                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1435                  '(2 font-lock-string-face))
1436
1437            ;; Preprocessor directives are `references'?.
1438            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1439                          preprocessor-keywords
1440                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1441                  '(1 font-lock-keyword-face))
1442
1443            ;; Handle the keywords defined above.
1444            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1445                  '(0 font-lock-keyword-face))
1446
1447            (list (concat "\\<\\(" c-keywords "\\)\\>")
1448                  '(0 font-lock-keyword-face))
1449
1450            (list (concat "\\<\\(" c-constants "\\)\\>")
1451                  '(0 font-lock-variable-name-face))
1452
1453            ;; Handle numbers too.
1454            ;;
1455            ;; This looks strange, I know.  It corresponds to the
1456            ;; preprocessor's idea of what a number looks like, rather than
1457            ;; anything sensible.
1458            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1459                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1460                  '(0 mdw-number-face))
1461
1462            ;; And anything else is punctuation.
1463            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1464                  '(0 mdw-punct-face))))
1465
1466     (mdw-post-config-mode-hack)))
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   (mdw-post-config-mode-hack))
1521
1522 ;;;--------------------------------------------------------------------------
1523 ;;; Java programming configuration.
1524
1525 ;; Make indentation nice.
1526
1527 (defun mdw-java-style ()
1528   (c-add-style "[mdw] Java style"
1529                '((c-basic-offset . 2)
1530                  (c-offsets-alist (substatement-open . 0)
1531                                   (label . +)
1532                                   (case-label . +)
1533                                   (access-label . 0)
1534                                   (inclass . +)
1535                                   (statement-case-intro . +)))
1536                t))
1537
1538 ;; Declare Java fontification style.
1539
1540 (defun mdw-fontify-java ()
1541
1542   ;; Other stuff.
1543   (mdw-java-style)
1544   (setq c-hanging-comment-ender-p nil)
1545   (setq c-backslash-column 72)
1546   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1547
1548   ;; Now define things to be fontified.
1549   (make-local-variable 'font-lock-keywords)
1550   (let ((java-keywords
1551          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1552                       "char" "class" "const" "continue" "default" "do"
1553                       "double" "else" "extends" "final" "finally" "float"
1554                       "for" "goto" "if" "implements" "import" "instanceof"
1555                       "int" "interface" "long" "native" "new" "package"
1556                       "private" "protected" "public" "return" "short"
1557                       "static" "switch" "synchronized" "throw" "throws"
1558                       "transient" "try" "void" "volatile" "while"))
1559
1560         (java-constants
1561          (mdw-regexps "false" "null" "super" "this" "true")))
1562
1563     (setq font-lock-keywords
1564           (list
1565
1566            ;; Handle the keywords defined above.
1567            (list (concat "\\<\\(" java-keywords "\\)\\>")
1568                  '(0 font-lock-keyword-face))
1569
1570            ;; Handle the magic constants defined above.
1571            (list (concat "\\<\\(" java-constants "\\)\\>")
1572                  '(0 font-lock-variable-name-face))
1573
1574            ;; Handle numbers too.
1575            ;;
1576            ;; The following isn't quite right, but it's close enough.
1577            (list (concat "\\<\\("
1578                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1579                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1580                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1581                          "[lLfFdD]?")
1582                  '(0 mdw-number-face))
1583
1584            ;; And anything else is punctuation.
1585            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1586                  '(0 mdw-punct-face)))))
1587
1588   (mdw-post-config-mode-hack))
1589
1590 ;;;--------------------------------------------------------------------------
1591 ;;; Javascript programming configuration.
1592
1593 (defun mdw-javascript-style ()
1594   (setq js-indent-level 2)
1595   (setq js-expr-indent-offset 0))
1596
1597 (defun mdw-fontify-javascript ()
1598
1599   ;; Other stuff.
1600   (mdw-javascript-style)
1601   (setq js-auto-indent-flag t)
1602
1603   ;; Now define things to be fontified.
1604   (make-local-variable 'font-lock-keywords)
1605   (let ((javascript-keywords
1606          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1607                       "char" "class" "const" "continue" "debugger" "default"
1608                       "delete" "do" "double" "else" "enum" "export" "extends"
1609                       "final" "finally" "float" "for" "function" "goto" "if"
1610                       "implements" "import" "in" "instanceof" "int"
1611                       "interface" "let" "long" "native" "new" "package"
1612                       "private" "protected" "public" "return" "short"
1613                       "static" "super" "switch" "synchronized" "throw"
1614                       "throws" "transient" "try" "typeof" "var" "void"
1615                       "volatile" "while" "with" "yield"
1616
1617                       "boolean" "byte" "char" "double" "float" "int" "long"
1618                       "short" "void"))
1619         (javascript-constants
1620          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1621                       "arguments" "this")))
1622
1623     (setq font-lock-keywords
1624           (list
1625
1626            ;; Handle the keywords defined above.
1627            (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
1628                  '(0 font-lock-keyword-face))
1629
1630            ;; Handle the predefined constants defined above.
1631            (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
1632                  '(0 font-lock-variable-name-face))
1633
1634            ;; Handle numbers too.
1635            ;;
1636            ;; The following isn't quite right, but it's close enough.
1637            (list (concat "\\_<\\("
1638                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1639                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1640                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1641                          "[lLfFdD]?")
1642                  '(0 mdw-number-face))
1643
1644            ;; And anything else is punctuation.
1645            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1646                  '(0 mdw-punct-face)))))
1647
1648   (mdw-post-config-mode-hack))
1649
1650 ;;;--------------------------------------------------------------------------
1651 ;;; Scala programming configuration.
1652
1653 (defun mdw-fontify-scala ()
1654
1655   ;; Comment filling.
1656   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1657
1658   ;; Define things to be fontified.
1659   (make-local-variable 'font-lock-keywords)
1660   (let ((scala-keywords
1661          (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
1662                       "extends" "final" "finally" "for" "forSome" "if"
1663                       "implicit" "import" "lazy" "match" "new" "object"
1664                       "override" "package" "private" "protected" "return"
1665                       "sealed" "throw" "trait" "try" "type" "val"
1666                       "var" "while" "with" "yield"))
1667         (scala-constants
1668          (mdw-regexps "false" "null" "super" "this" "true"))
1669         (punctuation "[-!%^&*=+:@#~/?\\|`]"))
1670
1671     (setq font-lock-keywords
1672           (list
1673
1674            ;; Magical identifiers between backticks.
1675            (list (concat "`\\([^`]+\\)`")
1676                  '(1 font-lock-variable-name-face))
1677
1678            ;; Handle the keywords defined above.
1679            (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
1680                  '(0 font-lock-keyword-face))
1681
1682            ;; Handle the constants defined above.
1683            (list (concat "\\_<\\(" scala-constants "\\)\\_>")
1684                  '(0 font-lock-variable-name-face))
1685
1686            ;; Magical identifiers between backticks.
1687            (list (concat "`\\([^`]+\\)`")
1688                  '(1 font-lock-variable-name-face))
1689
1690            ;; Handle numbers too.
1691            ;;
1692            ;; As usual, not quite right.
1693            (list (concat "\\_<\\("
1694                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1695                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1696                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1697                          "[lLfFdD]?")
1698                  '(0 mdw-number-face))
1699
1700            ;; Identifiers with trailing operators.
1701            (list (concat "_\\(" punctuation "\\)+")
1702                  '(0 mdw-trivial-face))
1703
1704            ;; And everything else is punctuation.
1705            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1706                  '(0 mdw-punct-face)))
1707
1708           font-lock-syntactic-keywords
1709           (list
1710
1711            ;; Single quotes around characters.  But not when used to quote
1712            ;; symbol names.  Ugh.
1713            (list (concat "\\('\\)"
1714                          "\\(" "."
1715                          "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
1716                                "u+" "[0-9a-fA-F]\\{4\\}"
1717                          "\\|" "\\\\" "[0-7]\\{1,3\\}"
1718                          "\\|" "\\\\" "." "\\)"
1719                          "\\('\\)")
1720                  '(1 "\"")
1721                  '(4 "\"")))))
1722
1723   (mdw-post-config-mode-hack))
1724
1725 ;;;--------------------------------------------------------------------------
1726 ;;; C# programming configuration.
1727
1728 ;; Make indentation nice.
1729
1730 (defun mdw-csharp-style ()
1731   (c-add-style "[mdw] C# style"
1732                '((c-basic-offset . 2)
1733                  (c-offsets-alist (substatement-open . 0)
1734                                   (label . 0)
1735                                   (case-label . +)
1736                                   (access-label . 0)
1737                                   (inclass . +)
1738                                   (statement-case-intro . +)))
1739                t))
1740
1741 ;; Declare C# fontification style.
1742
1743 (defun mdw-fontify-csharp ()
1744
1745   ;; Other stuff.
1746   (mdw-csharp-style)
1747   (setq c-hanging-comment-ender-p nil)
1748   (setq c-backslash-column 72)
1749   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1750
1751   ;; Now define things to be fontified.
1752   (make-local-variable 'font-lock-keywords)
1753   (let ((csharp-keywords
1754          (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
1755                       "char" "checked" "class" "const" "continue" "decimal"
1756                       "default" "delegate" "do" "double" "else" "enum"
1757                       "event" "explicit" "extern" "finally" "fixed" "float"
1758                       "for" "foreach" "goto" "if" "implicit" "in" "int"
1759                       "interface" "internal" "is" "lock" "long" "namespace"
1760                       "new" "object" "operator" "out" "override" "params"
1761                       "private" "protected" "public" "readonly" "ref"
1762                       "return" "sbyte" "sealed" "short" "sizeof"
1763                       "stackalloc" "static" "string" "struct" "switch"
1764                       "throw" "try" "typeof" "uint" "ulong" "unchecked"
1765                       "unsafe" "ushort" "using" "virtual" "void" "volatile"
1766                       "while" "yield"))
1767
1768         (csharp-constants
1769          (mdw-regexps "base" "false" "null" "this" "true")))
1770
1771     (setq font-lock-keywords
1772           (list
1773
1774            ;; Handle the keywords defined above.
1775            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1776                  '(0 font-lock-keyword-face))
1777
1778            ;; Handle the magic constants defined above.
1779            (list (concat "\\<\\(" csharp-constants "\\)\\>")
1780                  '(0 font-lock-variable-name-face))
1781
1782            ;; Handle numbers too.
1783            ;;
1784            ;; The following isn't quite right, but it's close enough.
1785            (list (concat "\\<\\("
1786                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1787                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1788                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1789                          "[lLfFdD]?")
1790                  '(0 mdw-number-face))
1791
1792            ;; And anything else is punctuation.
1793            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1794                  '(0 mdw-punct-face)))))
1795
1796   (mdw-post-config-mode-hack))
1797
1798 (define-derived-mode csharp-mode java-mode "C#"
1799   "Major mode for editing C# code.")
1800
1801 ;;;--------------------------------------------------------------------------
1802 ;;; F# programming configuration.
1803
1804 (setq fsharp-indent-offset 2)
1805
1806 (defun mdw-fontify-fsharp ()
1807
1808   (let ((punct "=<>+-*/|&%!@?"))
1809     (do ((i 0 (1+ i)))
1810         ((>= i (length punct)))
1811       (modify-syntax-entry (aref punct i) ".")))
1812
1813   (modify-syntax-entry ?_ "_")
1814   (modify-syntax-entry ?( "(")
1815   (modify-syntax-entry ?) ")")
1816
1817   (setq indent-tabs-mode nil)
1818
1819   (let ((fsharp-keywords
1820          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
1821                       "begin" "break"
1822                       "checked" "class" "component" "const" "constraint"
1823                       "constructor" "continue"
1824                       "default" "delegate" "do" "done" "downcast" "downto"
1825                       "eager" "elif" "else" "end" "exception" "extern"
1826                       "finally" "fixed" "for" "fori" "fun" "function"
1827                       "functor"
1828                       "global"
1829                       "if" "in" "include" "inherit" "inline" "interface"
1830                       "internal"
1831                       "lazy" "let"
1832                       "match" "measure" "member" "method" "mixin" "module"
1833                       "mutable"
1834                       "namespace" "new"
1835                       "object" "of" "open" "or" "override"
1836                       "parallel" "params" "private" "process" "protected"
1837                       "public" "pure"
1838                       "rec" "recursive" "return"
1839                       "sealed" "sig" "static" "struct"
1840                       "tailcall" "then" "to" "trait" "try" "type"
1841                       "upcast" "use"
1842                       "val" "virtual" "void" "volatile"
1843                       "when" "while" "with"
1844                       "yield"))
1845
1846         (fsharp-builtins
1847          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
1848                       "base" "false" "null" "true"))
1849
1850         (bang-keywords
1851          (mdw-regexps "do" "let" "return" "use" "yield"))
1852
1853         (preprocessor-keywords
1854          (mdw-regexps "if" "indent" "else" "endif")))
1855
1856     (setq font-lock-keywords
1857           (list (list (concat "\\(^\\|[^\"]\\)"
1858                               "\\(" "(\\*"
1859                                     "[^*]*\\*+"
1860                                     "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
1861                                     ")"
1862                               "\\|"
1863                                     "//.*"
1864                               "\\)")
1865                       '(2 font-lock-comment-face))
1866
1867                 (list (concat "'" "\\("
1868                                     "\\\\"
1869                                     "\\(" "[ntbr'\\]"
1870                                     "\\|" "[0-9][0-9][0-9]"
1871                                     "\\|" "u" "[0-9a-fA-F]\\{4\\}"
1872                                     "\\|" "U" "[0-9a-fA-F]\\{8\\}"
1873                                     "\\)"
1874                                   "\\|"
1875                                   "." "\\)" "'"
1876                               "\\|"
1877                               "\"" "[^\"\\]*"
1878                                     "\\(" "\\\\" "\\(.\\|\n\\)"
1879                                           "[^\"\\]*" "\\)*"
1880                               "\\(\"\\|\\'\\)")
1881                       '(0 font-lock-string-face))
1882
1883                 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
1884                               "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
1885                               "\\|"
1886                               "\\_<\\(" fsharp-keywords "\\)\\_>")
1887                       '(0 font-lock-keyword-face))
1888                 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
1889                       '(0 font-lock-variable-name-face))
1890
1891                 (list (concat "\\_<"
1892                               "\\(" "0[bB][01]+" "\\|"
1893                                     "0[oO][0-7]+" "\\|"
1894                                     "0[xX][0-9a-fA-F]+" "\\)"
1895                               "\\(" "lf\\|LF" "\\|"
1896                                     "[uU]?[ysnlL]?" "\\)"
1897                               "\\|"
1898                               "\\_<"
1899                               "[0-9]+" "\\("
1900                                 "[mMQRZING]"
1901                                 "\\|"
1902                                 "\\(\\.[0-9]*\\)?"
1903                                 "\\([eE][-+]?[0-9]+\\)?"
1904                                 "[fFmM]?"
1905                                 "\\|"
1906                                 "[uU]?[ysnlL]?"
1907                               "\\)")
1908                       '(0 mdw-number-face))
1909
1910                 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1911                       '(0 mdw-punct-face)))))
1912
1913   (mdw-post-config-mode-hack))
1914
1915 (defun mdw-fontify-inferior-fsharp ()
1916   (mdw-fontify-fsharp)
1917   (setq font-lock-keywords
1918         (append (list (list "^[#-]" '(0 font-lock-comment-face))
1919                       (list "^>" '(0 font-lock-keyword-face)))
1920                 font-lock-keywords)))
1921
1922 ;;;--------------------------------------------------------------------------
1923 ;;; Go programming configuration.
1924
1925 (defun mdw-fontify-go ()
1926
1927   (make-local-variable 'font-lock-keywords)
1928   (let ((go-keywords
1929          (mdw-regexps "break" "case" "chan" "const" "continue"
1930                       "default" "defer" "else" "fallthrough" "for"
1931                       "func" "go" "goto" "if" "import"
1932                       "interface" "map" "package" "range" "return"
1933                       "select" "struct" "switch" "type" "var"))
1934         (go-intrinsics
1935          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
1936                       "float32" "float64" "int" "uint8" "int16" "int32"
1937                       "int64" "rune" "string" "uint" "uint8" "uint16"
1938                       "uint32" "uint64" "uintptr" "void"
1939                       "false" "iota" "nil" "true"
1940                       "init" "main"
1941                       "append" "cap" "copy" "delete" "imag" "len" "make"
1942                       "new" "panic" "real" "recover")))
1943
1944     (setq font-lock-keywords
1945           (list
1946
1947            ;; Handle the keywords defined above.
1948            (list (concat "\\<\\(" go-keywords "\\)\\>")
1949                  '(0 font-lock-keyword-face))
1950            (list (concat "\\<\\(" go-intrinsics "\\)\\>")
1951                  '(0 font-lock-variable-name-face))
1952
1953            ;; Strings and characters.
1954            (list (concat "'"
1955                          "\\(" "[^\\']" "\\|"
1956                                "\\\\"
1957                                "\\(" "[abfnrtv\\'\"]" "\\|"
1958                                      "[0-7]\\{3\\}" "\\|"
1959                                      "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
1960                                      "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
1961                                      "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
1962                          "'"
1963                          "\\|"
1964                          "\""
1965                          "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
1966                          "\\(\"\\|$\\)"
1967                          "\\|"
1968                          "`" "[^`]+" "`")
1969                  '(0 font-lock-string-face))
1970
1971            ;; Handle numbers too.
1972            ;;
1973            ;; The following isn't quite right, but it's close enough.
1974            (list (concat "\\<\\("
1975                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1976                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1977                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1978                  '(0 mdw-number-face))
1979
1980            ;; And anything else is punctuation.
1981            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1982                  '(0 mdw-punct-face)))))
1983
1984   (mdw-post-config-mode-hack))
1985
1986 ;;;--------------------------------------------------------------------------
1987 ;;; Rust programming configuration.
1988
1989 (setq-default rust-indent-offset 2)
1990
1991 (defun mdw-self-insert-and-indent (count)
1992   (interactive "p")
1993   (self-insert-command count)
1994   (indent-according-to-mode))
1995
1996 (defun mdw-fontify-rust ()
1997
1998   ;; Hack syntax categories.
1999   (modify-syntax-entry ?= ".")
2000
2001   ;; Fontify keywords and things.
2002   (make-local-variable 'font-lock-keywords)
2003   (let ((rust-keywords
2004          (mdw-regexps "abstract" "alignof" "as"
2005                       "become" "box" "break"
2006                       "const" "continue" "create"
2007                       "do"
2008                       "else" "enum" "extern"
2009                       "false" "final" "fn" "for"
2010                       "if" "impl" "in"
2011                       "let" "loop"
2012                       "macro" "match" "mod" "move" "mut"
2013                       "offsetof" "override"
2014                       "priv" "pub" "pure"
2015                       "ref" "return"
2016                       "self" "sizeof" "static" "struct" "super"
2017                       "true" "trait" "type" "typeof"
2018                       "unsafe" "unsized" "use"
2019                       "virtual"
2020                       "where" "while"
2021                       "yield"))
2022         (rust-builtins
2023          (mdw-regexps "array" "pointer" "slice" "tuple"
2024                       "bool" "true" "false"
2025                       "f32" "f64"
2026                       "i8" "i16" "i32" "i64" "isize"
2027                       "u8" "u16" "u32" "u64" "usize"
2028                       "char" "str")))
2029     (setq font-lock-keywords
2030           (list
2031
2032            ;; Handle the keywords defined above.
2033            (list (concat "\\<\\(" rust-keywords "\\)\\>")
2034                  '(0 font-lock-keyword-face))
2035            (list (concat "\\<\\(" rust-builtins "\\)\\>")
2036                  '(0 font-lock-variable-name-face))
2037
2038            ;; Handle numbers too.
2039            (list (concat "\\<\\("
2040                                "[0-9][0-9_]*"
2041                                "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
2042                                "\\|" "\\.[0-9_]+"
2043                                "\\)"
2044                                "\\(f32\\|f64\\)?"
2045                          "\\|" "\\(" "[0-9][0-9_]*"
2046                                "\\|" "0x[0-9a-fA-F_]+"
2047                                "\\|" "0o[0-7_]+"
2048                                "\\|" "0b[01_]+"
2049                                "\\)"
2050                                "\\([ui]\\(8\\|16\\|32\\|64\\|s\\|size\\)\\)?"
2051                          "\\)\\>")
2052                  '(0 mdw-number-face))
2053
2054            ;; And anything else is punctuation.
2055            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2056                  '(0 mdw-punct-face)))))
2057
2058   ;; Hack key bindings.
2059   (local-set-key [?{] 'mdw-self-insert-and-indent)
2060   (local-set-key [?}] 'mdw-self-insert-and-indent)
2061
2062   ;; Final hacking.
2063   (mdw-post-config-mode-hack))
2064
2065 ;;;--------------------------------------------------------------------------
2066 ;;; Awk programming configuration.
2067
2068 ;; Make Awk indentation nice.
2069
2070 (defun mdw-awk-style ()
2071   (c-add-style "[mdw] Awk style"
2072                '((c-basic-offset . 2)
2073                  (c-offsets-alist (substatement-open . 0)
2074                                   (statement-cont . 0)
2075                                   (statement-case-intro . +)))
2076                t))
2077
2078 ;; Declare Awk fontification style.
2079
2080 (defun mdw-fontify-awk ()
2081
2082   ;; Miscellaneous fiddling.
2083   (mdw-awk-style)
2084   (setq c-backslash-column 72)
2085   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2086
2087   ;; Now define things to be fontified.
2088   (make-local-variable 'font-lock-keywords)
2089   (let ((c-keywords
2090          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
2091                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
2092                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
2093                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
2094                       "atan2" "break" "close" "continue" "cos" "delete"
2095                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
2096                       "function" "gensub" "getline" "gsub" "if" "in"
2097                       "index" "int" "length" "log" "match" "next" "rand"
2098                       "return" "print" "printf" "sin" "split" "sprintf"
2099                       "sqrt" "srand" "strftime" "sub" "substr" "system"
2100                       "systime" "tolower" "toupper" "while")))
2101
2102     (setq font-lock-keywords
2103           (list
2104
2105            ;; Handle the keywords defined above.
2106            (list (concat "\\<\\(" c-keywords "\\)\\>")
2107                  '(0 font-lock-keyword-face))
2108
2109            ;; Handle numbers too.
2110            ;;
2111            ;; The following isn't quite right, but it's close enough.
2112            (list (concat "\\<\\("
2113                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2114                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2115                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2116                          "[uUlL]*")
2117                  '(0 mdw-number-face))
2118
2119            ;; And anything else is punctuation.
2120            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2121                  '(0 mdw-punct-face)))))
2122
2123   (mdw-post-config-mode-hack))
2124
2125 ;;;--------------------------------------------------------------------------
2126 ;;; Perl programming style.
2127
2128 ;; Perl indentation style.
2129
2130 (setq cperl-indent-level 2)
2131 (setq cperl-continued-statement-offset 2)
2132 (setq cperl-continued-brace-offset 0)
2133 (setq cperl-brace-offset -2)
2134 (setq cperl-brace-imaginary-offset 0)
2135 (setq cperl-label-offset 0)
2136
2137 ;; Define perl fontification style.
2138
2139 (defun mdw-fontify-perl ()
2140
2141   ;; Miscellaneous fiddling.
2142   (modify-syntax-entry ?$ "\\")
2143   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
2144   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2145
2146   ;; Now define fontification things.
2147   (make-local-variable 'font-lock-keywords)
2148   (let ((perl-keywords
2149          (mdw-regexps "and"
2150                       "break"
2151                       "cmp" "continue"
2152                       "default" "do"
2153                       "else" "elsif" "eq"
2154                       "for" "foreach"
2155                       "ge" "given" "gt" "goto"
2156                       "if"
2157                       "last" "le" "local" "lt"
2158                       "my"
2159                       "ne" "next"
2160                       "or" "our"
2161                       "package"
2162                       "redo" "require" "return"
2163                       "sub"
2164                       "undef" "unless" "until" "use"
2165                       "when" "while")))
2166
2167     (setq font-lock-keywords
2168           (list
2169
2170            ;; Set up the keywords defined above.
2171            (list (concat "\\<\\(" perl-keywords "\\)\\>")
2172                  '(0 font-lock-keyword-face))
2173
2174            ;; At least numbers are simpler than C.
2175            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2176                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2177                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2178                  '(0 mdw-number-face))
2179
2180            ;; And anything else is punctuation.
2181            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2182                  '(0 mdw-punct-face)))))
2183
2184   (mdw-post-config-mode-hack))
2185
2186 (defun perl-number-tests (&optional arg)
2187   "Assign consecutive numbers to lines containing `#t'.  With ARG,
2188 strip numbers instead."
2189   (interactive "P")
2190   (save-excursion
2191     (goto-char (point-min))
2192     (let ((i 0) (fmt (if arg "" " %4d")))
2193       (while (search-forward "#t" nil t)
2194         (delete-region (point) (line-end-position))
2195         (setq i (1+ i))
2196         (insert (format fmt i)))
2197       (goto-char (point-min))
2198       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
2199           (replace-match (format "\\1%d" i))))))
2200
2201 ;;;--------------------------------------------------------------------------
2202 ;;; Python programming style.
2203
2204 (defun mdw-fontify-pythonic (keywords)
2205
2206   ;; Miscellaneous fiddling.
2207   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2208   (setq indent-tabs-mode nil)
2209
2210   ;; Now define fontification things.
2211   (make-local-variable 'font-lock-keywords)
2212   (setq font-lock-keywords
2213         (list
2214
2215          ;; Set up the keywords defined above.
2216          (list (concat "\\_<\\(" keywords "\\)\\_>")
2217                '(0 font-lock-keyword-face))
2218
2219          ;; At least numbers are simpler than C.
2220          (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2221                        "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2222                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
2223                '(0 mdw-number-face))
2224
2225          ;; And anything else is punctuation.
2226          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2227                '(0 mdw-punct-face))))
2228
2229   (mdw-post-config-mode-hack))
2230
2231 ;; Define Python fontification styles.
2232
2233 (defun mdw-fontify-python ()
2234   (mdw-fontify-pythonic
2235    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2236                 "del" "elif" "else" "except" "exec" "finally" "for"
2237                 "from" "global" "if" "import" "in" "is" "lambda"
2238                 "not" "or" "pass" "print" "raise" "return" "try"
2239                 "while" "with" "yield")))
2240
2241 (defun mdw-fontify-pyrex ()
2242   (mdw-fontify-pythonic
2243    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
2244                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
2245                 "extern" "finally" "for" "from" "global" "if"
2246                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
2247                 "raise" "return" "struct" "try" "while" "with"
2248                 "yield")))
2249
2250 ;;;--------------------------------------------------------------------------
2251 ;;; Icon programming style.
2252
2253 ;; Icon indentation style.
2254
2255 (setq icon-brace-offset 0
2256       icon-continued-brace-offset 0
2257       icon-continued-statement-offset 2
2258       icon-indent-level 2)
2259
2260 ;; Define Icon fontification style.
2261
2262 (defun mdw-fontify-icon ()
2263
2264   ;; Miscellaneous fiddling.
2265   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2266
2267   ;; Now define fontification things.
2268   (make-local-variable 'font-lock-keywords)
2269   (let ((icon-keywords
2270          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
2271                       "end" "every" "fail" "global" "if" "initial"
2272                       "invocable" "link" "local" "next" "not" "of"
2273                       "procedure" "record" "repeat" "return" "static"
2274                       "suspend" "then" "to" "until" "while"))
2275         (preprocessor-keywords
2276          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
2277                       "include" "line" "undef")))
2278     (setq font-lock-keywords
2279           (list
2280
2281            ;; Set up the keywords defined above.
2282            (list (concat "\\<\\(" icon-keywords "\\)\\>")
2283                  '(0 font-lock-keyword-face))
2284
2285            ;; The things that Icon calls keywords.
2286            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
2287
2288            ;; At least numbers are simpler than C.
2289            (list (concat "\\<[0-9]+"
2290                          "\\([rR][0-9a-zA-Z]+\\|"
2291                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
2292                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
2293                  '(0 mdw-number-face))
2294
2295            ;; Preprocessor.
2296            (list (concat "^[ \t]*$[ \t]*\\<\\("
2297                          preprocessor-keywords
2298                          "\\)\\>")
2299                  '(0 font-lock-keyword-face))
2300
2301            ;; And anything else is punctuation.
2302            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2303                  '(0 mdw-punct-face)))))
2304
2305   (mdw-post-config-mode-hack))
2306
2307 ;;;--------------------------------------------------------------------------
2308 ;;; Assembler mode.
2309
2310 (defun mdw-fontify-asm ()
2311   (modify-syntax-entry ?' "\"")
2312   (modify-syntax-entry ?. "w")
2313   (modify-syntax-entry ?\n ">")
2314   (setf fill-prefix nil)
2315   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
2316
2317 (defun mdw-asm-set-comment ()
2318   (modify-syntax-entry ?; "."
2319                        )
2320   (modify-syntax-entry asm-comment-char "<b")
2321   (setq comment-start (string asm-comment-char ? )))
2322 (add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
2323 (put 'asm-comment-char 'safe-local-variable 'characterp)
2324
2325 ;;;--------------------------------------------------------------------------
2326 ;;; TCL configuration.
2327
2328 (defun mdw-fontify-tcl ()
2329   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
2330   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2331   (make-local-variable 'font-lock-keywords)
2332   (setq font-lock-keywords
2333         (list
2334          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2335                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2336                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2337                '(0 mdw-number-face))
2338          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2339                '(0 mdw-punct-face))))
2340   (mdw-post-config-mode-hack))
2341
2342 ;;;--------------------------------------------------------------------------
2343 ;;; Dylan programming configuration.
2344
2345 (defun mdw-fontify-dylan ()
2346
2347   (make-local-variable 'font-lock-keywords)
2348
2349   ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
2350   ;; hook, which undoes all of our configuration.
2351   (setq major-mode 'dylan-mode)
2352   (font-lock-set-defaults)
2353
2354   (let* ((word "[-_a-zA-Z!*@<>$%]+")
2355          (dylan-keywords (mdw-regexps
2356
2357                           "C-address" "C-callable-wrapper" "C-function"
2358                           "C-mapped-subtype" "C-pointer-type" "C-struct"
2359                           "C-subtype" "C-union" "C-variable"
2360
2361                           "above" "abstract" "afterwards" "all"
2362                           "begin" "below" "block" "by"
2363                           "case" "class" "cleanup" "constant" "create"
2364                           "define" "domain"
2365                           "else" "elseif" "end" "exception" "export"
2366                           "finally" "for" "from" "function"
2367                           "generic"
2368                           "handler"
2369                           "if" "in" "instance" "interface" "iterate"
2370                           "keyed-by"
2371                           "let" "library" "local"
2372                           "macro" "method" "module"
2373                           "otherwise"
2374                           "profiling"
2375                           "select" "slot" "subclass"
2376                           "table" "then" "to"
2377                           "unless" "until" "use"
2378                           "variable" "virtual"
2379                           "when" "while"))
2380          (sharp-keywords (mdw-regexps
2381                           "all-keys" "key" "next" "rest" "include"
2382                           "t" "f")))
2383     (setq font-lock-keywords
2384           (list (list (concat "\\<\\(" dylan-keywords
2385                               "\\|" "with\\(out\\)?-" word
2386                               "\\)\\>")
2387                       '(0 font-lock-keyword-face))
2388                 (list (concat "\\<" word ":" "\\|"
2389                               "#\\(" sharp-keywords "\\)\\>")
2390                       '(0 font-lock-variable-name-face))
2391                 (list (concat "\\("
2392                               "\\([-+]\\|\\<\\)[0-9]+" "\\("
2393                                 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
2394                                 "\\|" "/[0-9]+"
2395                               "\\)"
2396                               "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
2397                               "\\|" "#b[01]+"
2398                               "\\|" "#o[0-7]+"
2399                               "\\|" "#x[0-9a-zA-Z]+"
2400                               "\\)\\>")
2401                       '(0 mdw-number-face))
2402                 (list (concat "\\("
2403                               "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
2404                               "\\_<[-+*/=<>:&|]+\\_>"
2405                               "\\)")
2406                       '(0 mdw-punct-face)))))
2407
2408   (mdw-post-config-mode-hack))
2409
2410 ;;;--------------------------------------------------------------------------
2411 ;;; Algol 68 configuration.
2412
2413 (setq a68-indent-step 2)
2414
2415 (defun mdw-fontify-algol-68 ()
2416
2417   ;; Fix up the syntax table.
2418   (modify-syntax-entry ?# "!" a68-mode-syntax-table)
2419   (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
2420     (modify-syntax-entry ch "." a68-mode-syntax-table))
2421
2422   (make-local-variable 'font-lock-keywords)
2423
2424   (let ((not-comment
2425          (let ((word "COMMENT"))
2426            (do ((regexp (concat "[^" (substring word 0 1) "]+")
2427                         (concat regexp "\\|"
2428                                 (substring word 0 i)
2429                                 "[^" (substring word i (1+ i)) "]"))
2430                 (i 1 (1+ i)))
2431                ((>= i (length word)) regexp)))))
2432     (setq font-lock-keywords
2433           (list (list (concat "\\<COMMENT\\>"
2434                               "\\(" not-comment "\\)\\{0,5\\}"
2435                               "\\(\\'\\|\\<COMMENT\\>\\)")
2436                       '(0 font-lock-comment-face))
2437                 (list (concat "\\<CO\\>"
2438                               "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
2439                               "\\($\\|\\<CO\\>\\)")
2440                       '(0 font-lock-comment-face))
2441                 (list "\\<[A-Z_]+\\>"
2442                       '(0 font-lock-keyword-face))
2443                 (list (concat "\\<"
2444                               "[0-9]+"
2445                               "\\(\\.[0-9]+\\)?"
2446                               "\\([eE][-+]?[0-9]+\\)?"
2447                               "\\>")
2448                       '(0 mdw-number-face))
2449                 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
2450                       '(0 mdw-punct-face)))))
2451
2452   (mdw-post-config-mode-hack))
2453
2454 ;;;--------------------------------------------------------------------------
2455 ;;; REXX configuration.
2456
2457 (defun mdw-rexx-electric-* ()
2458   (interactive)
2459   (insert ?*)
2460   (rexx-indent-line))
2461
2462 (defun mdw-rexx-indent-newline-indent ()
2463   (interactive)
2464   (rexx-indent-line)
2465   (if abbrev-mode (expand-abbrev))
2466   (newline-and-indent))
2467
2468 (defun mdw-fontify-rexx ()
2469
2470   ;; Various bits of fiddling.
2471   (setq mdw-auto-indent nil)
2472   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
2473   (local-set-key [?*] 'mdw-rexx-electric-*)
2474   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
2475           '(?! ?? ?# ?@ ?$))
2476   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
2477
2478   ;; Set up keywords and things for fontification.
2479   (make-local-variable 'font-lock-keywords-case-fold-search)
2480   (setq font-lock-keywords-case-fold-search t)
2481
2482   (setq rexx-indent 2)
2483   (setq rexx-end-indent rexx-indent)
2484   (setq rexx-cont-indent rexx-indent)
2485
2486   (make-local-variable 'font-lock-keywords)
2487   (let ((rexx-keywords
2488          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
2489                       "else" "end" "engineering" "exit" "expose" "for"
2490                       "forever" "form" "fuzz" "if" "interpret" "iterate"
2491                       "leave" "linein" "name" "nop" "numeric" "off" "on"
2492                       "options" "otherwise" "parse" "procedure" "pull"
2493                       "push" "queue" "return" "say" "select" "signal"
2494                       "scientific" "source" "then" "trace" "to" "until"
2495                       "upper" "value" "var" "version" "when" "while"
2496                       "with"
2497
2498                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
2499                       "center" "center" "charin" "charout" "chars"
2500                       "compare" "condition" "copies" "c2d" "c2x"
2501                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
2502                       "errortext" "format" "fuzz" "insert" "lastpos"
2503                       "left" "length" "lineout" "lines" "max" "min"
2504                       "overlay" "pos" "queued" "random" "reverse" "right"
2505                       "sign" "sourceline" "space" "stream" "strip"
2506                       "substr" "subword" "symbol" "time" "translate"
2507                       "trunc" "value" "verify" "word" "wordindex"
2508                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
2509                       "x2d")))
2510
2511     (setq font-lock-keywords
2512           (list
2513
2514            ;; Set up the keywords defined above.
2515            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
2516                  '(0 font-lock-keyword-face))
2517
2518            ;; Fontify all symbols the same way.
2519            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
2520                          "[A-Za-z0-9.!?_#@$]+\\)")
2521                  '(0 font-lock-variable-name-face))
2522
2523            ;; And everything else is punctuation.
2524            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2525                  '(0 mdw-punct-face)))))
2526
2527   (mdw-post-config-mode-hack))
2528
2529 ;;;--------------------------------------------------------------------------
2530 ;;; Standard ML programming style.
2531
2532 (defun mdw-fontify-sml ()
2533
2534   ;; Make underscore an honorary letter.
2535   (modify-syntax-entry ?' "w")
2536
2537   ;; Set fill prefix.
2538   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
2539
2540   ;; Now define fontification things.
2541   (make-local-variable 'font-lock-keywords)
2542   (let ((sml-keywords
2543          (mdw-regexps "abstype" "and" "andalso" "as"
2544                       "case"
2545                       "datatype" "do"
2546                       "else" "end" "eqtype" "exception"
2547                       "fn" "fun" "functor"
2548                       "handle"
2549                       "if" "in" "include" "infix" "infixr"
2550                       "let" "local"
2551                       "nonfix"
2552                       "of" "op" "open" "orelse"
2553                       "raise" "rec"
2554                       "sharing" "sig" "signature" "struct" "structure"
2555                       "then" "type"
2556                       "val"
2557                       "where" "while" "with" "withtype")))
2558
2559     (setq font-lock-keywords
2560           (list
2561
2562            ;; Set up the keywords defined above.
2563            (list (concat "\\<\\(" sml-keywords "\\)\\>")
2564                  '(0 font-lock-keyword-face))
2565
2566            ;; At least numbers are simpler than C.
2567            (list (concat "\\<\\(\\~\\|\\)"
2568                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
2569                                    "[wW][0-9]+\\)\\|"
2570                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2571                                          "\\([eE]\\(\\~\\|\\)"
2572                                                 "[0-9]+\\|\\)\\)\\)")
2573                  '(0 mdw-number-face))
2574
2575            ;; And anything else is punctuation.
2576            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2577                  '(0 mdw-punct-face)))))
2578
2579   (mdw-post-config-mode-hack))
2580
2581 ;;;--------------------------------------------------------------------------
2582 ;;; Haskell configuration.
2583
2584 (defun mdw-fontify-haskell ()
2585
2586   ;; Fiddle with syntax table to get comments right.
2587   (modify-syntax-entry ?' "_")
2588   (modify-syntax-entry ?- ". 12")
2589   (modify-syntax-entry ?\n ">")
2590
2591   ;; Make punctuation be punctuation
2592   (let ((punct "=<>+-*/|&%!@?$.^:#`"))
2593     (do ((i 0 (1+ i)))
2594         ((>= i (length punct)))
2595       (modify-syntax-entry (aref punct i) ".")))
2596
2597   ;; Set fill prefix.
2598   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2599
2600   ;; Fiddle with fontification.
2601   (make-local-variable 'font-lock-keywords)
2602   (let ((haskell-keywords
2603          (mdw-regexps "as"
2604                       "case" "ccall" "class"
2605                       "data" "default" "deriving" "do"
2606                       "else" "exists"
2607                       "forall" "foreign"
2608                       "hiding"
2609                       "if" "import" "in" "infix" "infixl" "infixr" "instance"
2610                       "let"
2611                       "mdo" "module"
2612                       "newtype"
2613                       "of"
2614                       "proc"
2615                       "qualified"
2616                       "rec"
2617                       "safe" "stdcall"
2618                       "then" "type"
2619                       "unsafe"
2620                       "where"))
2621         (control-sequences
2622          (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
2623                       "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
2624                       "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
2625                       "SP" "STX" "SUB" "SYN" "US" "VT")))
2626
2627     (setq font-lock-keywords
2628           (list
2629            (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
2630                               "\\(-+}\\|-*\\'\\)"
2631                          "\\|"
2632                          "--.*$")
2633                  '(0 font-lock-comment-face))
2634            (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
2635                  '(0 font-lock-keyword-face))
2636            (list (concat "'\\("
2637                          "[^\\]"
2638                          "\\|"
2639                          "\\\\"
2640                          "\\(" "[abfnrtv\\\"']" "\\|"
2641                                "^" "\\(" control-sequences "\\|"
2642                                          "[]A-Z@[\\^_]" "\\)" "\\|"
2643                                "\\|"
2644                                "[0-9]+" "\\|"
2645                                "[oO][0-7]+" "\\|"
2646                                "[xX][0-9A-Fa-f]+"
2647                          "\\)"
2648                          "\\)'")
2649                  '(0 font-lock-string-face))
2650            (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
2651                  '(0 font-lock-variable-name-face))
2652            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
2653                          "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
2654                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2655                  '(0 mdw-number-face))
2656            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2657                  '(0 mdw-punct-face)))))
2658
2659   (mdw-post-config-mode-hack))
2660
2661 ;;;--------------------------------------------------------------------------
2662 ;;; Erlang configuration.
2663
2664 (setq erlang-electric-commands nil)
2665
2666 (defun mdw-fontify-erlang ()
2667
2668   ;; Set fill prefix.
2669   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2670
2671   ;; Fiddle with fontification.
2672   (make-local-variable 'font-lock-keywords)
2673   (let ((erlang-keywords
2674          (mdw-regexps "after" "and" "andalso"
2675                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2676                       "case" "catch" "cond"
2677                       "div" "end" "fun" "if" "let" "not"
2678                       "of" "or" "orelse"
2679                       "query" "receive" "rem" "try" "when" "xor")))
2680
2681     (setq font-lock-keywords
2682           (list
2683            (list "%.*$"
2684                  '(0 font-lock-comment-face))
2685            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2686                  '(0 font-lock-keyword-face))
2687            (list (concat "^-\\sw+\\>")
2688                  '(0 font-lock-keyword-face))
2689            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2690                  '(0 mdw-number-face))
2691            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2692                  '(0 mdw-punct-face)))))
2693
2694   (mdw-post-config-mode-hack))
2695
2696 ;;;--------------------------------------------------------------------------
2697 ;;; Texinfo configuration.
2698
2699 (defun mdw-fontify-texinfo ()
2700
2701   ;; Set fill prefix.
2702   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2703
2704   ;; Real fontification things.
2705   (make-local-variable 'font-lock-keywords)
2706   (setq font-lock-keywords
2707         (list
2708
2709          ;; Environment names are keywords.
2710          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
2711                '(2 font-lock-keyword-face))
2712
2713          ;; Unmark escaped magic characters.
2714          (list "\\(@\\)\\([@{}]\\)"
2715                '(1 font-lock-keyword-face)
2716                '(2 font-lock-variable-name-face))
2717
2718          ;; Make sure we get comments properly.
2719          (list "@c\\(\\|omment\\)\\( .*\\)?$"
2720                '(0 font-lock-comment-face))
2721
2722          ;; Command names are keywords.
2723          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2724                '(0 font-lock-keyword-face))
2725
2726          ;; Fontify TeX special characters as punctuation.
2727          (list "[{}]+"
2728                '(0 mdw-punct-face))))
2729
2730   (mdw-post-config-mode-hack))
2731
2732 ;;;--------------------------------------------------------------------------
2733 ;;; TeX and LaTeX configuration.
2734
2735 (defun mdw-fontify-tex ()
2736   (setq ispell-parser 'tex)
2737   (turn-on-reftex)
2738
2739   ;; Don't make maths into a string.
2740   (modify-syntax-entry ?$ ".")
2741   (modify-syntax-entry ?$ "." font-lock-syntax-table)
2742   (local-set-key [?$] 'self-insert-command)
2743
2744   ;; Set fill prefix.
2745   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2746
2747   ;; Real fontification things.
2748   (make-local-variable 'font-lock-keywords)
2749   (setq font-lock-keywords
2750         (list
2751
2752          ;; Environment names are keywords.
2753          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2754                        "{\\([^}\n]*\\)}")
2755                '(2 font-lock-keyword-face))
2756
2757          ;; Suspended environment names are keywords too.
2758          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2759                        "{\\([^}\n]*\\)}")
2760                '(3 font-lock-keyword-face))
2761
2762          ;; Command names are keywords.
2763          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2764                '(0 font-lock-keyword-face))
2765
2766          ;; Handle @/.../ for italics.
2767          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2768          ;;       '(1 font-lock-keyword-face)
2769          ;;       '(3 font-lock-keyword-face))
2770
2771          ;; Handle @*...* for boldness.
2772          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2773          ;;       '(1 font-lock-keyword-face)
2774          ;;       '(3 font-lock-keyword-face))
2775
2776          ;; Handle @`...' for literal syntax things.
2777          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2778          ;;       '(1 font-lock-keyword-face)
2779          ;;       '(3 font-lock-keyword-face))
2780
2781          ;; Handle @<...> for nonterminals.
2782          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2783          ;;       '(1 font-lock-keyword-face)
2784          ;;       '(3 font-lock-keyword-face))
2785
2786          ;; Handle other @-commands.
2787          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2788          ;;       '(0 font-lock-keyword-face))
2789
2790          ;; Make sure we get comments properly.
2791          (list "%.*"
2792                '(0 font-lock-comment-face))
2793
2794          ;; Fontify TeX special characters as punctuation.
2795          (list "[$^_{}#&]"
2796                '(0 mdw-punct-face))))
2797
2798   (mdw-post-config-mode-hack))
2799
2800 ;;;--------------------------------------------------------------------------
2801 ;;; SGML hacking.
2802
2803 (defun mdw-sgml-mode ()
2804   (interactive)
2805   (sgml-mode)
2806   (mdw-standard-fill-prefix "")
2807   (make-local-variable 'sgml-delimiters)
2808   (setq sgml-delimiters
2809         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2810           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2811           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2812           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2813           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2814           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2815           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2816           "NULL" ""))
2817   (setq major-mode 'mdw-sgml-mode)
2818   (setq mode-name "[mdw] SGML")
2819   (run-hooks 'mdw-sgml-mode-hook))
2820
2821 ;;;--------------------------------------------------------------------------
2822 ;;; Configuration files.
2823
2824 (defvar mdw-conf-quote-normal nil
2825   "*Control syntax category of quote characters `\"' and `''.
2826 If this is `t', consider quote characters to be normal
2827 punctuation, as for `conf-quote-normal'.  If this is `nil' then
2828 leave quote characters as quotes.  If this is a list, then
2829 consider the quote characters in the list to be normal
2830 punctuation.  If this is a single quote character, then consider
2831 that character only to be normal punctuation.")
2832 (defun mdw-conf-quote-normal-acceptable-value-p (value)
2833   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2834   (or (booleanp value)
2835       (every (lambda (v) (memq v '(?\" ?')))
2836              (if (listp value) value (list value)))))
2837 (put 'mdw-conf-quote-normal 'safe-local-variable
2838      'mdw-conf-quote-normal-acceptable-value-p)
2839
2840 (defun mdw-fix-up-quote ()
2841   "Apply the setting of `mdw-conf-quote-normal'."
2842   (let ((flag mdw-conf-quote-normal))
2843     (cond ((eq flag t)
2844            (conf-quote-normal t))
2845           ((not flag)
2846            nil)
2847           (t
2848            (let ((table (copy-syntax-table (syntax-table))))
2849              (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2850                    (if (listp flag) flag (list flag)))
2851              (set-syntax-table table)
2852              (and font-lock-mode (font-lock-fontify-buffer)))))))
2853 (add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t)
2854
2855 ;;;--------------------------------------------------------------------------
2856 ;;; Shell scripts.
2857
2858 (defun mdw-setup-sh-script-mode ()
2859
2860   ;; Fetch the shell interpreter's name.
2861   (let ((shell-name sh-shell-file))
2862
2863     ;; Try reading the hash-bang line.
2864     (save-excursion
2865       (goto-char (point-min))
2866       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2867           (setq shell-name (match-string 1))))
2868
2869     ;; Now try to set the shell.
2870     ;;
2871     ;; Don't let `sh-set-shell' bugger up my script.
2872     (let ((executable-set-magic #'(lambda (s &rest r) s)))
2873       (sh-set-shell shell-name)))
2874
2875   ;; Don't insert here-document scaffolding automatically.
2876   (local-set-key "<" 'self-insert-command)
2877
2878   ;; Now enable my keys and the fontification.
2879   (mdw-misc-mode-config)
2880
2881   ;; Set the indentation level correctly.
2882   (setq sh-indentation 2)
2883   (setq sh-basic-offset 2))
2884
2885 (setq sh-shell-file "/bin/sh")
2886
2887 ;; Awful hacking to override the shell detection for particular scripts.
2888 (defmacro define-custom-shell-mode (name shell)
2889   `(defun ,name ()
2890      (interactive)
2891      (set (make-local-variable 'sh-shell-file) ,shell)
2892      (sh-mode)))
2893 (define-custom-shell-mode bash-mode "/bin/bash")
2894 (define-custom-shell-mode rc-mode "/usr/bin/rc")
2895 (put 'sh-shell-file 'permanent-local t)
2896
2897 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
2898 (eval-after-load "sh-script"
2899   '(or (assq 'rc sh-mode-syntax-table-input)
2900        (let ((frag '(nil
2901                      ?# "<"
2902                      ?\n ">#"
2903                      ?\" "\"\""
2904                      ?\' "\"\'"
2905                      ?$ "'"
2906                      ?\` "."
2907                      ?! "_"
2908                      ?% "_"
2909                      ?. "_"
2910                      ?^ "_"
2911                      ?~ "_"
2912                      ?, "_"
2913                      ?= "."
2914                      ?< "."
2915                      ?> "."))
2916              (assoc (assq 'rc sh-mode-syntax-table-input)))
2917          (if assoc
2918              (rplacd assoc frag)
2919            (setq sh-mode-syntax-table-input
2920                  (cons (cons 'rc frag)
2921                        sh-mode-syntax-table-input))))))
2922
2923 ;;;--------------------------------------------------------------------------
2924 ;;; Emacs shell mode.
2925
2926 (defun mdw-eshell-prompt ()
2927   (let ((left "[") (right "]"))
2928     (when (= (user-uid) 0)
2929       (setq left "«" right "»"))
2930     (concat left
2931             (save-match-data
2932               (replace-regexp-in-string "\\..*$" "" (system-name)))
2933             " "
2934             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
2935                    (home (expand-file-name "~")) (nhome (length home)))
2936               (if (and (>= npwd nhome)
2937                        (or (= nhome npwd)
2938                            (= (elt pwd nhome) ?/))
2939                        (string= (substring pwd 0 nhome) home))
2940                   (concat "~" (substring pwd (length home)))
2941                 pwd))
2942             right)))
2943 (setq eshell-prompt-function 'mdw-eshell-prompt)
2944 (setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
2945
2946 (defun eshell/e (file) (find-file file) nil)
2947 (defun eshell/ee (file) (find-file-other-window file) nil)
2948 (defun eshell/w3m (url) (w3m-goto-url url) nil)
2949
2950 (mdw-define-face eshell-prompt (t :weight bold))
2951 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2952 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2953 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2954 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2955 (mdw-define-face eshell-ls-executable (t :weight bold))
2956 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2957 (mdw-define-face eshell-ls-readonly (t nil))
2958 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2959
2960 ;;;--------------------------------------------------------------------------
2961 ;;; Messages-file mode.
2962
2963 (defun messages-mode-guts ()
2964   (setq messages-mode-syntax-table (make-syntax-table))
2965   (set-syntax-table messages-mode-syntax-table)
2966   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2967   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2968   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2969   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2970   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2971   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2972   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2973   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2974   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2975   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2976   (make-local-variable 'comment-start)
2977   (make-local-variable 'comment-end)
2978   (make-local-variable 'indent-line-function)
2979   (setq indent-line-function 'indent-relative)
2980   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2981   (make-local-variable 'font-lock-defaults)
2982   (make-local-variable 'messages-mode-keywords)
2983   (let ((keywords
2984          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2985                       "export" "enum" "fixed-octetstring" "flags"
2986                       "harmless" "map" "nested" "optional"
2987                       "optional-tagged" "package" "primitive"
2988                       "primitive-nullfree" "relaxed[ \t]+enum"
2989                       "set" "table" "tagged-optional"   "union"
2990                       "variadic" "vector" "version" "version-tag")))
2991     (setq messages-mode-keywords
2992           (list
2993            (list (concat "\\<\\(" keywords "\\)\\>:")
2994                  '(0 font-lock-keyword-face))
2995            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2996            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2997              (0 font-lock-variable-name-face))
2998            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2999            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3000              (0 mdw-punct-face)))))
3001   (setq font-lock-defaults
3002         '(messages-mode-keywords nil nil nil nil))
3003   (run-hooks 'messages-file-hook))
3004
3005 (defun messages-mode ()
3006   (interactive)
3007   (fundamental-mode)
3008   (setq major-mode 'messages-mode)
3009   (setq mode-name "Messages")
3010   (messages-mode-guts)
3011   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
3012   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
3013   (setq comment-start "# ")
3014   (setq comment-end "")
3015   (run-hooks 'messages-mode-hook))
3016
3017 (defun cpp-messages-mode ()
3018   (interactive)
3019   (fundamental-mode)
3020   (setq major-mode 'cpp-messages-mode)
3021   (setq mode-name "CPP Messages")
3022   (messages-mode-guts)
3023   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
3024   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
3025   (setq comment-start "/* ")
3026   (setq comment-end " */")
3027   (let ((preprocessor-keywords
3028          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3029                       "ident" "if" "ifdef" "ifndef" "import" "include"
3030                       "line" "pragma" "unassert" "undef" "warning")))
3031     (setq messages-mode-keywords
3032           (append (list (list (concat "^[ \t]*\\#[ \t]*"
3033                                       "\\(include\\|import\\)"
3034                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
3035                               '(2 font-lock-string-face))
3036                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3037                                       preprocessor-keywords
3038                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
3039                               '(1 font-lock-keyword-face)))
3040                   messages-mode-keywords)))
3041   (run-hooks 'cpp-messages-mode-hook))
3042
3043 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
3044 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
3045 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
3046
3047 ;;;--------------------------------------------------------------------------
3048 ;;; Messages-file mode.
3049
3050 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
3051   "Face to use for subsittution directives.")
3052 (make-face 'mallow-driver-substitution-face)
3053 (defvar mallow-driver-text-face 'mallow-driver-text-face
3054   "Face to use for body text.")
3055 (make-face 'mallow-driver-text-face)
3056
3057 (defun mallow-driver-mode ()
3058   (interactive)
3059   (fundamental-mode)
3060   (setq major-mode 'mallow-driver-mode)
3061   (setq mode-name "Mallow driver")
3062   (setq mallow-driver-mode-syntax-table (make-syntax-table))
3063   (set-syntax-table mallow-driver-mode-syntax-table)
3064   (make-local-variable 'comment-start)
3065   (make-local-variable 'comment-end)
3066   (make-local-variable 'indent-line-function)
3067   (setq indent-line-function 'indent-relative)
3068   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3069   (make-local-variable 'font-lock-defaults)
3070   (make-local-variable 'mallow-driver-mode-keywords)
3071   (let ((keywords
3072          (mdw-regexps "each" "divert" "file" "if"
3073                       "perl" "set" "string" "type" "write")))
3074     (setq mallow-driver-mode-keywords
3075           (list
3076            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
3077                  '(0 font-lock-keyword-face))
3078            (list "^%\\s *\\(#.*\\|\\)$"
3079                  '(0 font-lock-comment-face))
3080            (list "^%"
3081                  '(0 font-lock-keyword-face))
3082            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
3083            (list "\\${[^}]*}"
3084                  '(0 mallow-driver-substitution-face t)))))
3085   (setq font-lock-defaults
3086         '(mallow-driver-mode-keywords nil nil nil nil))
3087   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
3088   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
3089   (setq comment-start "%# ")
3090   (setq comment-end "")
3091   (run-hooks 'mallow-driver-mode-hook))
3092
3093 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
3094
3095 ;;;--------------------------------------------------------------------------
3096 ;;; NFast debugs.
3097
3098 (defun nfast-debug-mode ()
3099   (interactive)
3100   (fundamental-mode)
3101   (setq major-mode 'nfast-debug-mode)
3102   (setq mode-name "NFast debug")
3103   (setq messages-mode-syntax-table (make-syntax-table))
3104   (set-syntax-table messages-mode-syntax-table)
3105   (make-local-variable 'font-lock-defaults)
3106   (make-local-variable 'nfast-debug-mode-keywords)
3107   (setq truncate-lines t)
3108   (setq nfast-debug-mode-keywords
3109         (list
3110          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
3111            (0 font-lock-keyword-face))
3112          (list (concat "^[ \t]+\\(\\("
3113                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3114                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3115                        "[ \t]+\\)*"
3116                        "[0-9a-fA-F]+\\)[ \t]*$")
3117            '(0 mdw-number-face))
3118          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
3119            (1 font-lock-keyword-face))
3120          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
3121            (1 font-lock-warning-face))
3122          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
3123            (1 nil))
3124          (list (concat "^[ \t]+\\.cmd=[ \t]+"
3125                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
3126            '(1 font-lock-keyword-face))
3127          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
3128          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
3129          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
3130          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
3131   (setq font-lock-defaults
3132         '(nfast-debug-mode-keywords nil nil nil nil))
3133   (run-hooks 'nfast-debug-mode-hook))
3134
3135 ;;;--------------------------------------------------------------------------
3136 ;;; Other languages.
3137
3138 ;; Smalltalk.
3139
3140 (defun mdw-setup-smalltalk ()
3141   (and mdw-auto-indent
3142        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
3143   (make-local-variable 'mdw-auto-indent)
3144   (setq mdw-auto-indent nil)
3145   (local-set-key "\C-i" 'smalltalk-reindent))
3146
3147 (defun mdw-fontify-smalltalk ()
3148   (make-local-variable 'font-lock-keywords)
3149   (setq font-lock-keywords
3150         (list
3151          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
3152                '(0 font-lock-keyword-face))
3153          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3154                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3155                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3156                '(0 mdw-number-face))
3157          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3158                '(0 mdw-punct-face))))
3159   (mdw-post-config-mode-hack))
3160
3161 ;; Lispy languages.
3162
3163 ;; Unpleasant bodge.
3164 (unless (boundp 'slime-repl-mode-map)
3165   (setq slime-repl-mode-map (make-sparse-keymap)))
3166
3167 (defun mdw-indent-newline-and-indent ()
3168   (interactive)
3169   (indent-for-tab-command)
3170   (newline-and-indent))
3171
3172 (eval-after-load "cl-indent"
3173   '(progn
3174      (mapc #'(lambda (pair)
3175                (put (car pair)
3176                     'common-lisp-indent-function
3177                     (cdr pair)))
3178       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
3179         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
3180
3181 (defun mdw-common-lisp-indent ()
3182   (make-local-variable 'lisp-indent-function)
3183   (setq lisp-indent-function 'common-lisp-indent-function))
3184
3185 (setq lisp-simple-loop-indentation 2
3186       lisp-loop-keyword-indentation 6
3187       lisp-loop-forms-indentation 6)
3188
3189 (defun mdw-fontify-lispy ()
3190
3191   ;; Set fill prefix.
3192   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
3193
3194   ;; Not much fontification needed.
3195   (make-local-variable 'font-lock-keywords)
3196   (setq font-lock-keywords
3197         (list (list (concat "\\("
3198                             "\\_<[-+]?"
3199                             "\\(" "[0-9]+/[0-9]+"
3200                             "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
3201                                         "\\.[0-9]+" "\\)"
3202                                   "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
3203                             "\\)"
3204                             "\\|"
3205                             "#"
3206                             "\\(" "x" "[-+]?"
3207                                   "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
3208                             "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
3209                             "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
3210                             "\\|" "[0-9]+" "r" "[-+]?"
3211                                   "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
3212                             "\\)"
3213                             "\\)\\_>")
3214                     '(0 mdw-number-face))
3215               (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3216                     '(0 mdw-punct-face))))
3217
3218   (mdw-post-config-mode-hack))
3219
3220 (defun comint-send-and-indent ()
3221   (interactive)
3222   (comint-send-input)
3223   (and mdw-auto-indent
3224        (indent-for-tab-command)))
3225
3226 (defun mdw-setup-m4 ()
3227
3228   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
3229   ;; annoying: fix it.
3230   (modify-syntax-entry ?{ "(")
3231   (modify-syntax-entry ?} ")")
3232
3233   ;; Fill prefix.
3234   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
3235
3236 ;;;--------------------------------------------------------------------------
3237 ;;; Text mode.
3238
3239 (defun mdw-text-mode ()
3240   (setq fill-column 72)
3241   (flyspell-mode t)
3242   (mdw-standard-fill-prefix
3243    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
3244   (auto-fill-mode 1))
3245
3246 ;;;--------------------------------------------------------------------------
3247 ;;; Outline and hide/show modes.
3248
3249 (defun mdw-outline-collapse-all ()
3250   "Completely collapse everything in the entire buffer."
3251   (interactive)
3252   (save-excursion
3253     (goto-char (point-min))
3254     (while (< (point) (point-max))
3255       (hide-subtree)
3256       (forward-line))))
3257
3258 (setq hs-hide-comments-when-hiding-all nil)
3259
3260 (defadvice hs-hide-all (after hide-first-comment activate)
3261   (save-excursion (hs-hide-initial-comment-block)))
3262
3263 ;;;--------------------------------------------------------------------------
3264 ;;; Shell mode.
3265
3266 (defun mdw-sh-mode-setup ()
3267   (local-set-key [?\C-a] 'comint-bol)
3268   (add-hook 'comint-output-filter-functions
3269             'comint-watch-for-password-prompt))
3270
3271 (defun mdw-term-mode-setup ()
3272   (setq term-prompt-regexp shell-prompt-pattern)
3273   (make-local-variable 'mouse-yank-at-point)
3274   (make-local-variable 'transient-mark-mode)
3275   (setq mouse-yank-at-point t)
3276   (auto-fill-mode -1)
3277   (setq tab-width 8))
3278
3279 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
3280 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
3281 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
3282 (defun term-send-meta-meta-something ()
3283   (interactive)
3284   (term-send-raw-string "\e\e")
3285   (term-send-raw))
3286 (eval-after-load 'term
3287   '(progn
3288      (define-key term-raw-map [?\e ?\e] nil)
3289      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
3290      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
3291      (define-key term-raw-map [M-right] 'term-send-meta-right)
3292      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
3293      (define-key term-raw-map [M-left] 'term-send-meta-left)
3294      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
3295
3296 (defadvice term-exec (before program-args-list compile activate)
3297   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
3298 This allows you to pass a list of arguments through `ansi-term'."
3299   (let ((program (ad-get-arg 2)))
3300     (if (listp program)
3301         (progn
3302           (ad-set-arg 2 (car program))
3303           (ad-set-arg 4 (cdr program))))))
3304
3305 (defun ssh (host)
3306   "Open a terminal containing an ssh session to the HOST."
3307   (interactive "sHost: ")
3308   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
3309
3310 (defvar git-grep-command
3311   "env PAGER=cat git grep --no-color -nH -e "
3312   "*The default command for \\[git-grep].")
3313
3314 (defvar git-grep-history nil)
3315
3316 (defun git-grep (command-args)
3317   "Run `git grep' with user-specified args and collect output in a buffer."
3318   (interactive
3319    (list (read-shell-command "Run git grep (like this): "
3320                              git-grep-command 'git-grep-history)))
3321   (grep command-args))
3322
3323 ;;;--------------------------------------------------------------------------
3324 ;;; Inferior Emacs Lisp.
3325
3326 (setq comint-prompt-read-only t)
3327
3328 (eval-after-load "comint"
3329   '(progn
3330      (define-key comint-mode-map "\C-w" 'comint-kill-region)
3331      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
3332
3333 (eval-after-load "ielm"
3334   '(progn
3335      (define-key ielm-map "\C-w" 'comint-kill-region)
3336      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
3337
3338 ;;;----- That's all, folks --------------------------------------------------
3339
3340 (provide 'dot-emacs)