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

   1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
   2 ;;;
   3 ;;; Functions and macros for .emacs
   4 ;;;
   5 ;;; (c) 2004 Mark Wooding
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 2 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software Foundation,
  22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23
  24 ;;;--------------------------------------------------------------------------
  25 ;;; Check command-line.
  26
  27 (defgroup mdw nil
  28   "Customization for mdw's Emacs configuration."
  29   :prefix "mdw-")
  30
  31 (defun mdw-check-command-line-switch (switch)
  32   (let ((probe nil) (next command-line-args) (found nil))
  33     (while next
  34       (cond ((string= (car next) switch)
  35              (setq found t)
  36              (if probe (rplacd probe (cdr next))
  37                (setq command-line-args (cdr next))))
  38             (t
  39              (setq probe next)))
  40       (setq next (cdr next)))
  41     found))
  42
  43 (defvar mdw-fast-startup nil
  44   "Whether .emacs should optimize for rapid startup.
  45 This may be at the expense of cool features.")
  46 (setq mdw-fast-startup
  47       (mdw-check-command-line-switch "--mdw-fast-startup"))
  48
  49 (defvar mdw-splashy-startup nil
  50   "Whether to show a splash screen and related frippery.")
  51 (setq mdw-splashy-startup
  52       (mdw-check-command-line-switch "--mdw-splashy-startup"))
  53
  54 ;;;--------------------------------------------------------------------------
  55 ;;; Some general utilities.
  56
  57 (eval-when-compile
  58   (unless (fboundp 'make-regexp) (load "make-regexp"))
  59   (require 'cl-lib))
  60
  61 (defmacro mdw-regexps (&rest list)
  62   "Turn a LIST of strings into a single regular expression at compile-time."
  63   (declare (indent nil)
  64            (debug 0))
  65   `',(make-regexp (sort (cl-copy-list list) #'string<)))
  66
  67 (defun mdw-wrong ()
  68   "This is not the key sequence you're looking for."
  69   (interactive)
  70   (error "wrong button"))
  71
  72 (defun mdw-emacs-version-p (major &optional minor)
  73   "Return non-nil if the running Emacs is at least version MAJOR.MINOR."
  74   (or (> emacs-major-version major)
  75       (and (= emacs-major-version major)
  76            (>= emacs-minor-version (or minor 0)))))
  77
  78 (defun mdw-submode-p (mode parent)
  79   "Return non-nil if MODE is indirectly derived from PARENT."
  80   (let ((answer nil))
  81     (while (cond ((eq mode parent) (setq answer t) nil)
  82                  (t (setq mode (get mode 'derived-mode-parent)))))
  83     answer))
  84
  85 ;; Some error trapping.
  86 ;;
  87 ;; If individual bits of this file go tits-up, we don't particularly want
  88 ;; the whole lot to stop right there and then, because it's bloody annoying.
  89
  90 (eval-and-compile
  91   (defmacro trap (&rest forms)
  92     "Execute FORMS without allowing errors to propagate outside."
  93     (declare (indent 0)
  94              (debug t))
  95     `(condition-case err
  96          ,(if (cdr forms) (cons 'progn forms) (car forms))
  97        (error (message "Error (trapped): %s in %s"
  98                        (error-message-string err)
  99                        ',forms)))))
 100
 101 ;; Configuration reading.
 102
 103 (defvar mdw-config nil)
 104 (defun mdw-config (sym)
 105   "Read the configuration variable named SYM."
 106   (unless mdw-config
 107     (setq mdw-config
 108             (cl-flet ((replace (what with)
 109                         (goto-char (point-min))
 110                         (while (re-search-forward what nil t)
 111                           (replace-match with t))))
 112               (with-temp-buffer
 113                 (insert-file-contents "~/.mdw.conf")
 114                 (replace  "^[ \t]*\\(#.*\\)?\n" "")
 115                 (replace (concat "^[ \t]*"
 116                                  "\\([-a-zA-Z0-9_.]*\\)"
 117                                  "[ \t]*=[ \t]*"
 118                                  "\\(.*[^ \t\n]\\)?"
 119                                  "[ \t]**\\(\n\\|$\\)")
 120                          "(\\1 . \"\\2\")\n")
 121                 (car (read-from-string
 122                       (concat "(" (buffer-string) ")")))))))
 123   (cdr (assq sym mdw-config)))
 124
 125 ;; Local variables hacking.
 126
 127 (defun run-local-vars-mode-hook ()
 128   "Run a hook for the major-mode after local variables have been processed."
 129   (run-hooks (intern (concat (symbol-name major-mode)
 130                              "-local-variables-hook"))))
 131 (add-hook 'hack-local-variables-hook 'run-local-vars-mode-hook)
 132
 133 ;; Set up the load path convincingly.
 134
 135 (dolist (dir (append (and (boundp 'debian-emacs-flavor)
 136                           (list (concat "/usr/share/"
 137                                         (symbol-name debian-emacs-flavor)
 138                                         "/site-lisp")))))
 139   (dolist (sub (directory-files dir t))
 140     (when (and (file-accessible-directory-p sub)
 141                (not (member sub load-path)))
 142       (setq load-path (nconc load-path (list sub))))))
 143
 144 ;; Is an Emacs library available?
 145
 146 (defun library-exists-p (name)
 147   "Return non-nil if NAME is an available library.
 148 Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
 149 load path.  The non-nil value is the filename we found for the
 150 library."
 151   (let ((path load-path) elt (foundp nil))
 152     (while (and path (not foundp))
 153       (setq elt (car path))
 154       (setq path (cdr path))
 155       (setq foundp (or (let ((file (concat elt "/" name ".elc")))
 156                          (and (file-exists-p file) file))
 157                        (let ((file (concat elt "/" name ".el")))
 158                          (and (file-exists-p file) file)))))
 159     foundp))
 160
 161 (defun maybe-autoload (symbol file &optional docstring interactivep type)
 162   "Set an autoload if the file actually exists."
 163   (and (library-exists-p file)
 164        (autoload symbol file docstring interactivep type)))
 165
 166 (defun mdw-kick-menu-bar (&optional frame)
 167   "Regenerate FRAME's menu bar so it doesn't have empty menus."
 168   (interactive)
 169   (unless frame (setq frame (selected-frame)))
 170   (let ((old (frame-parameter frame 'menu-bar-lines)))
 171     (set-frame-parameter frame 'menu-bar-lines 0)
 172     (set-frame-parameter frame 'menu-bar-lines old)))
 173
 174 ;; Page motion.
 175
 176 (defun mdw-fixup-page-position ()
 177   (unless (eq (char-before (point)) ?\f)
 178     (forward-line 0)))
 179
 180 (defadvice backward-page (after mdw-fixup compile activate)
 181   (mdw-fixup-page-position))
 182 (defadvice forward-page (after mdw-fixup compile activate)
 183   (mdw-fixup-page-position))
 184
 185 ;; Bug fix for markdown-mode, which breaks point positioning during
 186 ;; `query-replace'.
 187 (defadvice markdown-check-change-for-wiki-link
 188     (around mdw-save-match activate compile)
 189   "Save match data around the `markdown-mode' `after-change-functions' hook."
 190   (save-match-data ad-do-it))
 191
 192 ;; Bug fix for `bbdb-canonicalize-address': on Emacs 24, `run-hook-with-args'
 193 ;; always returns nil, with the result that all email addresses are lost.
 194 ;; Replace the function entirely.
 195 (defadvice bbdb-canonicalize-address
 196     (around mdw-bug-fix activate compile)
 197   "Don't use `run-hook-with-args', because that doesn't work."
 198   (let ((net (ad-get-arg 0)))
 199
 200     ;; Make sure this is a proper hook list.
 201     (if (functionp bbdb-canonicalize-net-hook)
 202         (setq bbdb-canonicalize-net-hook (list bbdb-canonicalize-net-hook)))
 203
 204     ;; Iterate over the hooks until things converge.
 205     (let ((donep nil))
 206       (while (not donep)
 207         (let (next (changep nil)
 208               hook (hooks bbdb-canonicalize-net-hook))
 209           (while hooks
 210             (setq hook (pop hooks))
 211             (setq next (funcall hook net))
 212             (if (not (equal next net))
 213                 (setq changep t
 214                       net next)))
 215           (setq donep (not changep)))))
 216     (setq ad-return-value net)))
 217
 218 ;; Transient mark mode hacks.
 219
 220 (defadvice exchange-point-and-mark
 221     (around mdw-highlight (&optional arg) activate compile)
 222   "Maybe don't actually exchange point and mark.
 223 If `transient-mark-mode' is on and the mark is inactive, then
 224 just activate it.  A non-trivial prefix argument will force the
 225 usual behaviour.  A trivial prefix argument (i.e., just C-u) will
 226 activate the mark and temporarily enable `transient-mark-mode' if
 227 it's currently off."
 228   (cond ((or mark-active
 229              (and (not transient-mark-mode) (not arg))
 230              (and arg (or (not (consp arg))
 231                           (not (= (car arg) 4)))))
 232          ad-do-it)
 233         (t
 234          (or transient-mark-mode (setq transient-mark-mode 'only))
 235          (set-mark (mark t)))))
 236
 237 ;; Glasses.
 238
 239 (setq glasses-separator "-"
 240       glasses-separate-parentheses-p nil
 241       glasses-uncapitalize-p t)
 242
 243 ;;;--------------------------------------------------------------------------
 244 ;;; Rename buffers along with files.
 245
 246 (defvar mdw-inhibit-rename-buffer nil
 247   "If non-nil, `rename-file' won't rename the buffer visiting the file.")
 248
 249 (defmacro mdw-advise-to-inhibit-rename-buffer (function)
 250   "Advise FUNCTION to set `mdw-inhibit-rename-buffer' while it runs.
 251
 252 This will prevent `rename-file' from renaming the buffer."
 253   `(defadvice ,function (around mdw-inhibit-rename-buffer compile activate)
 254      "Don't rename the buffer when renaming the underlying file."
 255      (let ((mdw-inhibit-rename-buffer t))
 256        ad-do-it)))
 257 (mdw-advise-to-inhibit-rename-buffer recode-file-name)
 258 (mdw-advise-to-inhibit-rename-buffer set-visited-file-name)
 259 (mdw-advise-to-inhibit-rename-buffer backup-buffer)
 260
 261 (defadvice rename-file (after mdw-rename-buffers (from to &optional forcep)
 262                         compile activate)
 263   "If a buffer is visiting the file, rename it to match the new name.
 264
 265 Don't do this if `mdw-inhibit-rename-buffer' is non-nil."
 266   (unless mdw-inhibit-rename-buffer
 267     (let ((buffer (get-file-buffer from)))
 268       (when buffer
 269         (let ((to (if (not (string= (file-name-nondirectory to) "")) to
 270                     (concat to (file-name-nondirectory from)))))
 271           (with-current-buffer buffer
 272             (set-visited-file-name to nil t)))))))
 273
 274 ;;;--------------------------------------------------------------------------
 275 ;;; Window management.
 276
 277 ;; Width configuration.
 278
 279 (defcustom mdw-column-width
 280   (string-to-number (or (mdw-config 'emacs-width) "77"))
 281   "Width of Emacs columns."
 282   :type 'integer)
 283 (defcustom mdw-text-width mdw-column-width
 284   "Expected width of text within columns."
 285   :type 'integer
 286   :safe 'integerp)
 287
 288 ;; Splitting windows.
 289
 290 (unless (fboundp 'scroll-bar-columns)
 291   (defun scroll-bar-columns (side)
 292     (cond ((eq side 'left) 0)
 293           (window-system 3)
 294           (t 1))))
 295 (unless (fboundp 'fringe-columns)
 296   (defun fringe-columns (side)
 297     (cond ((not window-system) 0)
 298           ((eq side 'left) 1)
 299           (t 2))))
 300
 301 (defun mdw-horizontal-window-overhead ()
 302   "Computes the horizontal window overhead.
 303 This is the number of columns used by fringes, scroll bars and other such
 304 cruft."
 305   (if (not window-system)
 306       1
 307     (let ((tot 0))
 308       (dolist (what '(scroll-bar fringe))
 309         (dolist (side '(left right))
 310           (cl-incf tot
 311                    (funcall (intern (concat (symbol-name what) "-columns"))
 312                             side))))
 313       tot)))
 314
 315 (defun mdw-split-window-horizontally (&optional width)
 316   "Split a window horizontally.
 317 Without a numeric argument, split the window approximately in
 318 half.  With a numeric argument WIDTH, allocate WIDTH columns to
 319 the left-hand window (if positive) or -WIDTH columns to the
 320 right-hand window (if negative).  Space for scroll bars and
 321 fringes is not taken out of the allowance for WIDTH, unlike
 322 \\[split-window-horizontally]."
 323   (interactive "P")
 324   (split-window-horizontally
 325    (cond ((null width) nil)
 326          ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
 327          ((< width 0) width))))
 328
 329 (defun mdw-preferred-column-width ()
 330   "Return the preferred column width."
 331   (if (and window-system (mdw-emacs-version-p 22)) mdw-column-width
 332     (1+ mdw-column-width)))
 333
 334 (defun mdw-divvy-window (&optional width)
 335   "Split a wide window into appropriate widths."
 336   (interactive "P")
 337   (setq width (if width (prefix-numeric-value width)
 338                 (mdw-preferred-column-width)))
 339   (let* ((win (selected-window))
 340          (sb-width (mdw-horizontal-window-overhead))
 341          (c (/ (+ (window-width) sb-width)
 342                (+ width sb-width))))
 343     (while (> c 1)
 344       (setq c (1- c))
 345       (split-window-horizontally (+ width sb-width))
 346       (other-window 1))
 347     (select-window win)))
 348
 349 (defun mdw-frame-width-quantized-p (frame-width column-width)
 350   "Return whether the FRAME-WIDTH was chosen specifically for COLUMN-WIDTH."
 351   (let ((sb-width (mdw-horizontal-window-overhead)))
 352     (zerop (mod (+ frame-width sb-width)
 353                 (+ column-width sb-width)))))
 354
 355 (defun mdw-frame-width-for-columns (columns width)
 356   "Return the preferred width for a frame with so many COLUMNS of WIDTH."
 357   (let ((sb-width (mdw-horizontal-window-overhead)))
 358     (- (* columns (+ width sb-width))
 359        sb-width)))
 360
 361 (defun mdw-set-frame-width (columns &optional width)
 362   "Set the current frame to be the correct width for COLUMNS columns.
 363
 364 If WIDTH is non-nil, then it provides the width for the new columns.  (This
 365 can be set interactively with a prefix argument.)"
 366   (interactive "nColumns:
 367 P")
 368   (setq width (if width (prefix-numeric-value width)
 369                 (mdw-preferred-column-width)))
 370   (set-frame-width (selected-frame)
 371                    (mdw-frame-width-for-columns columns width))
 372   (mdw-divvy-window width))
 373
 374 (defcustom mdw-frame-width-fudge
 375   (cond ((<= emacs-major-version 20) 1)
 376         ((= emacs-major-version 26) 3)
 377         (t 0))
 378   "The number of extra columns to add to the desired frame width.
 379
 380 This is sadly necessary because Emacs 26 is broken in this regard."
 381   :type 'integer)
 382
 383 (defcustom mdw-frame-colour-alist
 384   '((black . ("#000000" . "#ffffff"))
 385     (red . ("#2a0000" . "#ffffff"))
 386     (green . ("#002a00" . "#ffffff"))
 387     (blue . ("#00002a" . "#ffffff")))
 388   "Alist mapping symbol names to (FOREGROUND . BACKGROUND) colour pairs."
 389   :type '(alist :key-type symbol :value-type (cons color color)))
 390
 391 (defun mdw-set-frame-colour (colour &optional frame)
 392   (interactive "xColour name or (FOREGROUND . BACKGROUND) pair:
 393 ")
 394   (when (and colour (symbolp colour))
 395     (let ((entry (assq colour mdw-frame-colour-alist)))
 396       (unless entry (error "Unknown colour `%s'" colour))
 397       (setf colour (cdr entry))))
 398   (set-frame-parameter frame 'background-color (car colour))
 399   (set-frame-parameter frame 'foreground-color (cdr colour)))
 400
 401 ;; Window configuration switching.
 402
 403 (defvar mdw-current-window-configuration nil
 404   "The current window configuration register name, or `nil'.")
 405
 406 (defun mdw-switch-window-configuration (register &optional no-save)
 407   "Switch make REGISTER be the new current window configuration.
 408 If a current window configuration register is established, and
 409 NO-SAVE is nil, then save the current window configuration to
 410 that register first.
 411
 412 Signal an error if the new register contains something other than
 413 a window configuration.  If the register is unset then save the
 414 current window configuration to it immediately.
 415
 416 With one or three C-u, or an odd numeric prefix argument, set
 417 NO-SAVE, so the previous window configuration register is left
 418 unchanged.
 419
 420 With two or three C-u, or a prefix argument which is an odd
 421 multiple of 2, just clear the record of the current window
 422 configuration register, so that the next switch doesn't save the
 423 prevailing configuration."
 424   (interactive
 425    (let ((arg current-prefix-arg))
 426      (list (if (or (and (consp arg) (= (car arg) 16) (= (car arg) 64))
 427                    (and (integerp arg) (not (zerop (logand arg 2)))))
 428                nil
 429              (register-read-with-preview "Switch to window configuration: "))
 430            (or (and (consp arg) (= (car arg) 4) (= (car arg) 64))
 431                (and (integerp arg) (not (zerop (logand arg 1))))))))
 432
 433   (let ((previous mdw-current-window-configuration)
 434         (current-windows (list (current-window-configuration)
 435                                (point-marker)))
 436         (register-value (and register (get-register register))))
 437     (when (and mdw-current-window-configuration (not no-save))
 438       (set-register mdw-current-window-configuration current-windows))
 439     (cond ((null register)
 440            (setq mdw-current-window-configuration nil)
 441            (if previous
 442                (message "Left window configuration `%c'." previous)
 443              (message "Nothing to do!")))
 444           ((not (or (null register-value)
 445                     (and (consp register-value)
 446                          (window-configuration-p (car register-value))
 447                          (integer-or-marker-p (cadr register-value))
 448                          (null (cl-caddr register-value)))))
 449            (error "Register `%c' is not a window configuration" register))
 450           (t
 451            (cond ((null register-value)
 452                   (set-register register current-windows)
 453                   (message "Started new window configuration `%c'."
 454                            register))
 455                  (t
 456                   (set-window-configuration (car register-value))
 457                   (goto-char (cadr register-value))
 458                   (message "Switched to window configuration `%c'."
 459                            register)))
 460            (setq mdw-current-window-configuration register)))))
 461
 462 ;; Don't raise windows unless I say so.
 463
 464 (defcustom mdw-inhibit-raise-frame nil
 465   "Whether `raise-frame' should do nothing when the frame is mapped."
 466   :type 'boolean)
 467
 468 (defadvice raise-frame
 469     (around mdw-inhibit (&optional frame) activate compile)
 470   "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the
 471 frame is actually mapped on the screen."
 472   (if mdw-inhibit-raise-frame
 473       (make-frame-visible frame)
 474     ad-do-it))
 475
 476 (defmacro mdw-advise-to-inhibit-raise-frame (function)
 477   "Advise the FUNCTION not to raise frames, even if it wants to."
 478   `(defadvice ,function
 479        (around mdw-inhibit-raise (&rest hunoz) activate compile)
 480      "Don't raise the window unless you have to."
 481      (let ((mdw-inhibit-raise-frame t))
 482        ad-do-it)))
 483
 484 (mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus)
 485 (mdw-advise-to-inhibit-raise-frame appt-disp-window)
 486 (mdw-advise-to-inhibit-raise-frame mouse-select-window)
 487
 488 ;; Window selection for `display-buffer'.
 489
 490 (defvar mdw-designated-window nil
 491   "The window chosen by `mdw-designate-window', or nil.")
 492
 493 (defun mdw-designated-window-display-buffer-function (buffer not-this-window)
 494   "Display buffer function to use the designated window."
 495   (unless mdw-designated-window (error "No designated window!"))
 496   (prog1 mdw-designated-window
 497     (with-selected-window mdw-designated-window (switch-to-buffer buffer))
 498     (setq mdw-designated-window nil
 499           display-buffer-function nil)))
 500
 501 (defun mdw-display-buffer-in-designated-window (buffer alist)
 502   "Display function to use the designated window."
 503   (prog1 mdw-designated-window
 504     (when mdw-designated-window
 505       (with-selected-window mdw-designated-window
 506         (switch-to-buffer buffer nil t)))
 507     (setq mdw-designated-window nil)))
 508
 509 (defun mdw-designate-window (cancel)
 510   "Use the selected window for the next pop-up buffer.
 511 With a prefix argument, clear the designated window."
 512   (interactive "P")
 513   (let ((window (selected-window)))
 514     (cond (cancel
 515            (cond (mdw-designated-window
 516                   (setq mdw-designated-window nil)
 517                   (unless (mdw-emacs-version-p 24)
 518                     (setq display-buffer-function nil))
 519                   (message "Window designation cleared."))
 520                  (t
 521                   (message "No designated window active."))))
 522           ((window-dedicated-p window)
 523            (error "Window is dedicated to its buffer."))
 524           (t
 525            (setq mdw-designated-window window)
 526            (unless (mdw-emacs-version-p 24)
 527              (setq display-buffer-function
 528                      #'mdw-designated-window-display-buffer-function))
 529            (message "Window designated.")))))
 530
 531 (when (mdw-emacs-version-p 24)
 532   (setq display-buffer-base-action
 533           (let* ((action display-buffer-base-action)
 534                  (funcs (car action))
 535                  (alist (cdr action)))
 536             (cons (cons 'mdw-display-buffer-in-designated-window funcs)
 537                   alist))))
 538
 539 (defun mdw-clobber-other-windows-showing-buffer (buffer-or-name)
 540   "Arrange that no windows on other frames are showing BUFFER-OR-NAME."
 541   (interactive "bBuffer: ")
 542   (let ((home-frame (selected-frame))
 543         (buffer (get-buffer buffer-or-name))
 544         (safe-buffer (get-buffer "*scratch*")))
 545     (dolist (frame (frame-list))
 546       (unless (eq frame home-frame)
 547         (dolist (window (window-list frame))
 548           (when (eq (window-buffer window) buffer)
 549             (set-window-buffer window safe-buffer)))))))
 550
 551 (defvar mdw-inhibit-walk-windows nil
 552   "If non-nil, then `walk-windows' does nothing.
 553 This is used by advice on `switch-to-buffer-other-frame' to inhibit finding
 554 buffers in random frames.")
 555
 556 (setq display-buffer--other-frame-action
 557         '((display-buffer-reuse-window display-buffer-pop-up-frame)
 558           (reusable-frames . nil)
 559           (inhibit-same-window . t)))
 560
 561 (defadvice walk-windows (around mdw-inhibit activate)
 562   "If `mdw-inhibit-walk-windows' is non-nil, then do nothing."
 563   (and (not mdw-inhibit-walk-windows)
 564        ad-do-it))
 565
 566 (defadvice switch-to-buffer-other-frame
 567     (around mdw-always-new-frame activate)
 568   "Always make a new frame.
 569 Even if an existing window in some random frame looks tempting."
 570   (let ((mdw-inhibit-walk-windows t)) ad-do-it))
 571
 572 (defadvice display-buffer (before mdw-inhibit-other-frames activate)
 573   "Don't try to do anything fancy with other frames.
 574 Pretend they don't exist.  They might be on other display devices."
 575   (ad-set-arg 2 nil))
 576
 577 (setq even-window-sizes nil
 578       even-window-heights nil
 579       display-buffer-reuse-frames nil)
 580
 581 (defvar mdw-fallback-window-alist nil
 582   "Alist mapping frames to fallback windows.")
 583
 584 (defun mdw-cleanup-fallback-window-alist ()
 585   "Remove entries for dead frames and windows from the fallback alist."
 586   (let ((prev nil)
 587         (cursor mdw-fallback-window-alist))
 588     (while cursor
 589       (let* ((assoc (car cursor))
 590              (tail (cdr cursor)))
 591         (cond ((and (frame-live-p (car assoc))
 592                     (window-live-p (cdr assoc)))
 593                (setq prev cursor))
 594               ((null prev)
 595                (setq mdw-fallback-window-alist tail))
 596               (t
 597                (setcdr prev tail)))
 598         (setq cursor tail)))))
 599
 600 (defun mdw-set-fallback-window (cancel)
 601   "Prefer the selected window for pop-up buffers in this frame.
 602 With a prefix argument, clear the fallback window."
 603   (interactive "P")
 604   (let* ((frame (selected-frame)) (window (selected-window))
 605          (assoc (assq (selected-frame) mdw-fallback-window-alist)))
 606     (cond (cancel
 607            (cond (assoc
 608                   (setcdr assoc nil)
 609                   (message "Fallback window cleared."))
 610                  (t
 611                   (message "No fallback window active in this frame."))))
 612           ((window-dedicated-p window)
 613            (error "Window is dedicated to its buffer."))
 614           (t
 615            (if assoc (setcdr assoc window)
 616              (push (cons frame window) mdw-fallback-window-alist))
 617            (message "Fallback window set.")))
 618     (mdw-cleanup-fallback-window-alist)))
 619
 620 (defun mdw-last-window-in-frame-p (window)
 621   "Return whether WINDOW is the last in its frame."
 622   (catch 'done
 623     (while window
 624       (let ((next (window-next-sibling window)))
 625         (while (and next (window-minibuffer-p next))
 626           (setq next (window-next-sibling next)))
 627         (if next (throw 'done nil)))
 628       (setq window (window-parent window)))
 629     t))
 630
 631 (defun mdw-display-buffer-in-tolerable-window (buffer alist)
 632   "Try finding a tolerable window in which to display BUFFER.
 633 Begone, foul DWIMmerlaik!
 634
 635 This is all totally subject to arbitrary change in the future, but the
 636 emphasis is on predictability rather than crazy DWIMmery."
 637   (let* ((selected (selected-window)) chosen
 638          (fallback (assq (selected-frame) mdw-fallback-window-alist))
 639          (full-height-p (window-full-height-p selected))
 640          (full-width-p (window-full-width-p selected)))
 641     (cond
 642
 643      ((and fallback (window-live-p (cdr fallback)))
 644       ;; There's a fallback window set for this frame.  Use it.
 645
 646       (setq chosen (cdr fallback)
 647             selected nil)
 648       (display-buffer-record-window 'window chosen buffer))
 649
 650      ((and full-height-p full-width-p)
 651       ;; We're basically the only window in the frame.  If we want to get
 652       ;; anywhere, we'll have to split the window.
 653
 654       (let ((width (window-width selected))
 655             (preferred-width (mdw-preferred-column-width)))
 656         (if (and (>= width (mdw-frame-width-for-columns 2 preferred-width))
 657                  (mdw-frame-width-quantized-p width preferred-width))
 658             (setq chosen (split-window-right preferred-width))
 659           (setq chosen (split-window-below)))
 660         (display-buffer-record-window 'window chosen buffer)))
 661
 662      ((mdw-last-window-in-frame-p selected)
 663       ;; This is the last window in the frame.  I don't think I want to
 664       ;; clobber the first window, so rebound and clobber the previous one
 665       ;; instead.  (This obviously has the same effect if there are only two
 666       ;; windows, but seems more useful if there are three.)
 667
 668       (setq chosen (previous-window selected 'never nil))
 669       (display-buffer-record-window 'reuse chosen buffer))
 670
 671      (t
 672       ;; There's another window in front of us.  Let's use that one.
 673       (setq chosen (next-window selected 'never nil)))
 674       (display-buffer-record-window 'reuse chosen buffer))
 675
 676     (if (eq chosen selected)
 677         (error "Failed to select a different window!"))
 678
 679     (when chosen
 680       (with-selected-window chosen (switch-to-buffer buffer)))
 681     chosen))
 682
 683 ;; Hack the display actions so that they do something sensible.
 684 (setq display-buffer-fallback-action
 685         '((display-buffer--maybe-same-window
 686            display-buffer-reuse-window
 687            display-buffer-pop-up-window
 688            mdw-display-buffer-in-tolerable-window)))
 689
 690 ;;;--------------------------------------------------------------------------
 691 ;;; Calendar and diary hacking.
 692
 693 ;; Functions for sexp diary entries.
 694
 695 (defvar mdw-diary-for-org-mode-p nil
 696   "Display diary along with the agenda?")
 697
 698 (defun mdw-not-org-mode (form)
 699   "As FORM, but not in Org mode agenda."
 700   (and (not mdw-diary-for-org-mode-p)
 701        (eval form)))
 702
 703 (defun mdw-weekday (l)
 704   "Return non-nil if `date' falls on one of the days of the week in L.
 705 L is a list of day numbers (from 0 to 6 for Sunday through to
 706 Saturday) or symbols `sunday', `monday', etc. (or a mixture).  If
 707 the date stored in `date' falls on a listed day, then the
 708 function returns non-nil."
 709   (let ((d (calendar-day-of-week date)))
 710     (or (memq d l)
 711         (memq (nth d '(sunday monday tuesday wednesday
 712                               thursday friday saturday)) l))))
 713
 714 (defun mdw-discordian-date (date)
 715   "Return the Discordian calendar date corresponding to DATE.
 716
 717 The return value is (YOLD . st-tibs-day) or (YOLD SEASON DAYNUM DOW).
 718
 719 The original is by David Pearson.  I modified it to produce date components
 720 as output rather than a string."
 721   (let* ((days ["Sweetmorn" "Boomtime" "Pungenday"
 722                 "Prickle-Prickle" "Setting Orange"])
 723          (months ["Chaos" "Discord" "Confusion"
 724                   "Bureaucracy" "Aftermath"])
 725          (day-count [0 31 59 90 120 151 181 212 243 273 304 334])
 726          (year (- (calendar-extract-year date) 1900))
 727          (month (1- (calendar-extract-month date)))
 728          (day (1- (calendar-extract-day date)))
 729          (julian (+ (aref day-count month) day))
 730          (dyear (+ year 3066)))
 731     (if (and (= month 1) (= day 28))
 732         (cons dyear 'st-tibs-day)
 733       (list dyear
 734             (aref months (floor (/ julian 73)))
 735             (1+ (mod julian 73))
 736             (aref days (mod julian 5))))))
 737
 738 (defun mdw-diary-discordian-date ()
 739   "Convert the date in `date' to a string giving the Discordian date."
 740   (let* ((ddate (mdw-discordian-date date))
 741          (tail (format "in the YOLD %d" (car ddate))))
 742     (if (eq (cdr ddate) 'st-tibs-day)
 743         (format "St Tib's Day %s" tail)
 744       (let ((season (cadr ddate))
 745             (daynum (cl-caddr ddate))
 746             (dayname (cl-cadddr ddate)))
 747       (format "%s, the %d%s day of %s %s"
 748               dayname
 749               daynum
 750               (let ((ldig (mod daynum 10)))
 751                 (cond ((= ldig 1) "st")
 752                       ((= ldig 2) "nd")
 753                       ((= ldig 3) "rd")
 754                       (t "th")))
 755               season
 756               tail)))))
 757
 758 (defun mdw-todo (&optional when)
 759   "Return non-nil today, or on WHEN, whichever is later."
 760   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
 761         (d (calendar-absolute-from-gregorian date)))
 762     (if when
 763         (setq w (max w (calendar-absolute-from-gregorian
 764                         (cond
 765                          ((not european-calendar-style)
 766                           when)
 767                          ((> (car when) 100)
 768                           (list (nth 1 when)
 769                                 (nth 2 when)
 770                                 (nth 0 when)))
 771                          (t
 772                           (list (nth 1 when)
 773                                 (nth 0 when)
 774                                 (nth 2 when))))))))
 775     (eq w d)))
 776
 777 (defcustom diary-time-regexp nil
 778   "Regexp matching times in the diary buffer."
 779   :type 'regexp)
 780
 781 (defadvice diary-add-to-list (before mdw-trim-leading-space compile activate)
 782   "Trim leading space from the diary entry string."
 783   (save-match-data
 784     (let ((str (ad-get-arg 1))
 785           (done nil) old)
 786       (while (not done)
 787         (setq old str)
 788         (setq str (cond ((null str) nil)
 789                         ((string-match "\\(^\\|\n\\)[ \t]+" str)
 790                          (replace-match "\\1" nil nil str))
 791                         ((and mdw-diary-for-org-mode-p
 792                               (string-match (concat
 793                                              "\\(^\\|\n\\)"
 794                                              "\\(" diary-time-regexp
 795                                              "\\(-" diary-time-regexp "\\)?"
 796                                              "\\)"
 797                                              "\\(\t[ \t]*\\| [ \t]+\\)")
 798                                             str))
 799                          (replace-match "\\1\\2 " nil nil str))
 800                         ((and (not mdw-diary-for-org-mode-p)
 801                               (string-match "\\[\\[[^][]*]\\[\\([^][]*\\)]]"
 802                                             str))
 803                          (replace-match "\\1" nil nil str))
 804                         (t str)))
 805         (if (equal str old) (setq done t)))
 806       (ad-set-arg 1 str))))
 807
 808 ;;;--------------------------------------------------------------------------
 809 ;;; Org-mode hacking.
 810
 811 (defadvice org-agenda-list (around mdw-preserve-links activate)
 812   (let ((mdw-diary-for-org-mode-p t))
 813     ad-do-it))
 814
 815 (defadvice org-bbdb-anniversaries (after mdw-fixup-list compile activate)
 816   "Return a string rather than a list."
 817   (with-temp-buffer
 818     (let ((anyp nil))
 819       (dolist (e (let ((ee ad-return-value))
 820                    (if (atom ee) (list ee) ee)))
 821         (when e
 822           (when anyp (insert ?\n))
 823           (insert e)
 824           (setq anyp t)))
 825       (setq ad-return-value
 826               (and anyp (buffer-string))))))
 827
 828 ;; Fighting with Org-mode's evil key maps.
 829
 830 (defcustom mdw-evil-keymap-keys
 831   '(([S-up] . [?\C-c up])
 832     ([S-down] . [?\C-c down])
 833     ([S-left] . [?\C-c left])
 834     ([S-right] . [?\C-c right])
 835     (([M-up] [?\e up]) . [C-up])
 836     (([M-down] [?\e down]) . [C-down])
 837     (([M-left] [?\e left]) . [C-left])
 838     (([M-right] [?\e right]) . [C-right]))
 839   "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
 840 The value is an alist mapping evil keys (as a list, or singleton)
 841 to good keys (in the same form)."
 842   :type '(alist :key-type (choice key-sequence (repeat key-sequence))
 843                 :value-type key-sequence))
 844
 845 (defun mdw-clobber-evil-keymap (keymap)
 846   "Replace evil key bindings in the KEYMAP.
 847 Evil key bindings are defined in `mdw-evil-keymap-keys'."
 848   (dolist (entry mdw-evil-keymap-keys)
 849     (let ((binding nil)
 850           (keys (if (listp (car entry))
 851                     (car entry)
 852                   (list (car entry))))
 853           (replacements (if (listp (cdr entry))
 854                             (cdr entry)
 855                           (list (cdr entry)))))
 856       (catch 'found
 857         (dolist (key keys)
 858           (setq binding (lookup-key keymap key))
 859           (when binding
 860             (throw 'found nil))))
 861       (when binding
 862         (dolist (key keys)
 863           (define-key keymap key nil))
 864         (dolist (key replacements)
 865           (define-key keymap key binding))))))
 866
 867 (defcustom mdw-org-latex-defs
 868   '(("strayman"
 869      "\\documentclass{strayman}
 870 \\usepackage[utf8]{inputenc}
 871 \\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
 872 \\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
 873      ("\\section{%s}" . "\\section*{%s}")
 874      ("\\subsection{%s}" . "\\subsection*{%s}")
 875      ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
 876      ("\\paragraph{%s}" . "\\paragraph*{%s}")
 877      ("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
 878   "Additional LaTeX class definitions."
 879   :type '(alist :key-type string
 880                 :value-type (list string
 881                                   (alist :inline t
 882                                          :key-type string
 883                                          :value-type string))))
 884
 885 (setq org-emphasis-regexp-components
 886         '("- \t('\"{}"                  ; prematch
 887           "- \t.,:!?;'\")}\\["          ; postmatch
 888           " \t\r\n"                     ; /forbidden/ as border
 889           "."                           ; body regexp
 890           1))                           ; maximum newlines
 891
 892 (setq org-entities-user
 893         ;; NAME LATEX MATHP HTML ASCII LATIN1 UTF8
 894         '(("relax" "" nil "" "" "" "")))
 895
 896 (eval-after-load "org-latex"
 897   '(setq org-export-latex-classes
 898            (append mdw-org-latex-defs org-export-latex-classes)))
 899
 900 (eval-after-load "ox-latex"
 901   '(setq org-latex-classes (append mdw-org-latex-defs org-latex-classes)
 902          org-latex-caption-above nil
 903          org-latex-default-packages-alist '(("AUTO" "inputenc" t)
 904                                             ("T1" "fontenc" t)
 905                                             ("" "fixltx2e" nil)
 906                                             ("" "graphicx" t)
 907                                             ("" "longtable" nil)
 908                                             ("" "float" nil)
 909                                             ("" "wrapfig" nil)
 910                                             ("" "rotating" nil)
 911                                             ("normalem" "ulem" t)
 912                                             ("" "textcomp" t)
 913                                             ("" "marvosym" t)
 914                                             ("" "wasysym" t)
 915                                             ("" "amssymb" t)
 916                                             ("" "hyperref" nil)
 917                                             "\\tolerance=1000")))
 918
 919 (setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i"
 920       org-export-docbook-xsl-fo-proc-command "fop %i.safe %o"
 921       org-export-docbook-xslt-stylesheet
 922         "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl")
 923
 924 ;;;--------------------------------------------------------------------------
 925 ;;; Improved compilation machinery.
 926
 927 ;; Uprated version of M-x compile.
 928
 929 (setq compile-command
 930         (let ((ncpu (with-temp-buffer
 931                       (insert-file-contents "/proc/cpuinfo")
 932                       (buffer-string)
 933                       (count-matches "^processor\\s-*:"))))
 934           (format "nice make -j%d -k" (* 2 ncpu))))
 935
 936 (defun mdw-compilation-buffer-name (mode)
 937   (concat "*" (downcase mode) ": "
 938           (abbreviate-file-name default-directory) "*"))
 939 (setq compilation-buffer-name-function 'mdw-compilation-buffer-name)
 940
 941 (eval-after-load "compile"
 942   '(progn
 943      (define-key compilation-shell-minor-mode-map "\C-c\M-g" 'recompile)))
 944
 945 (defadvice compile (around hack-environment compile activate)
 946   "Hack the environment inherited by inferiors in the compilation."
 947   (let ((process-environment (copy-tree process-environment)))
 948     (setenv "LD_PRELOAD" nil)
 949     ad-do-it))
 950
 951 (defun mdw-compile (command &optional directory comint)
 952   "Initiate a compilation COMMAND, maybe in a different DIRECTORY.
 953 The DIRECTORY may be nil to not change.  If COMINT is t, then
 954 start an interactive compilation.
 955
 956 Interactively, prompt for the command if the variable
 957 `compilation-read-command' is non-nil, or if requested through
 958 the prefix argument.  Prompt for the directory, and run
 959 interactively, if requested through the prefix.
 960
 961 Use a prefix of 4, 6, 12, or 14, or type C-u between one and three times, to
 962 force prompting for a directory.
 963
 964 Use a prefix of 2, 6, 10, or 14, or type C-u three times, to force
 965 prompting for the command.
 966
 967 Use a prefix of 8, 10, 12, or 14, or type C-u twice or three times,
 968 to force interactive compilation."
 969   (interactive
 970    (let* ((prefix (prefix-numeric-value current-prefix-arg))
 971           (command (eval compile-command))
 972           (dir (and (cl-plusp (logand prefix #x54))
 973                     (read-directory-name "Compile in directory: "))))
 974      (list (if (or compilation-read-command
 975                    (cl-plusp (logand prefix #x42)))
 976                (compilation-read-command command)
 977              command)
 978            dir
 979            (cl-plusp (logand prefix #x58)))))
 980   (let ((default-directory (or directory default-directory)))
 981     (compile command comint)))
 982
 983 ;; Flymake support.
 984
 985 (defun mdw-find-build-dir (build-file)
 986   (catch 'found
 987     (let* ((src-dir (file-name-as-directory (expand-file-name ".")))
 988            (dir src-dir))
 989       (cl-loop
 990         (when (file-exists-p (concat dir build-file))
 991           (throw 'found dir))
 992         (let ((sub (expand-file-name (file-relative-name src-dir dir)
 993                                      (concat dir "build/"))))
 994           (catch 'give-up
 995             (cl-loop
 996               (when (file-exists-p (concat sub build-file))
 997                 (throw 'found sub))
 998               (when (string= sub dir) (throw 'give-up nil))
 999               (setq sub (file-name-directory (directory-file-name sub))))))
1000         (when (string= dir
1001                        (setq dir (file-name-directory
1002                                   (directory-file-name dir))))
1003           (throw 'found nil))))))
1004
1005 (defun mdw-flymake-make-init ()
1006   (let ((build-dir (mdw-find-build-dir "Makefile")))
1007     (and build-dir
1008          (let ((tmp-src (flymake-init-create-temp-buffer-copy
1009                          #'flymake-create-temp-inplace)))
1010            (flymake-get-syntax-check-program-args
1011             tmp-src build-dir t t
1012             #'flymake-get-make-cmdline)))))
1013
1014 (setq flymake-allowed-file-name-masks
1015         '(("\\.\\(?:[cC]\\|cc\\|cpp\\|cxx\\|c\\+\\+\\)\\'"
1016            mdw-flymake-make-init)
1017           ("\\.\\(?:[hH]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'"
1018            mdw-flymake-master-make-init)
1019           ("\\.p[lm]" flymake-perl-init)))
1020
1021 (setq flymake-mode-map
1022         (let ((map (if (boundp 'flymake-mode-map)
1023                        flymake-mode-map
1024                      (make-sparse-keymap))))
1025           (define-key map [?\C-c ?\C-f ?\C-p] 'flymake-goto-prev-error)
1026           (define-key map [?\C-c ?\C-f ?\C-n] 'flymake-goto-next-error)
1027           (define-key map [?\C-c ?\C-f ?\C-c] 'flymake-compile)
1028           (define-key map [?\C-c ?\C-f ?\C-k] 'flymake-stop-all-syntax-checks)
1029           (define-key map [?\C-c ?\C-f ?\C-e] 'flymake-popup-current-error-menu)
1030           map))
1031
1032 ;;;--------------------------------------------------------------------------
1033 ;;; Mail and news hacking.
1034
1035 (define-derived-mode  mdwmail-mode mail-mode "[mdw] mail"
1036   "Major mode for editing news and mail messages from external programs.
1037 Not much right now.  Just support for doing MailCrypt stuff."
1038   :syntax-table nil
1039   :abbrev-table nil
1040   (run-hooks 'mail-setup-hook))
1041
1042 (define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
1043
1044 (add-hook 'mdwail-mode-hook
1045           (lambda ()
1046             (set-buffer-file-coding-system 'utf-8)
1047             (make-local-variable 'paragraph-separate)
1048             (make-local-variable 'paragraph-start)
1049             (setq paragraph-start
1050                     (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
1051                             paragraph-start))
1052             (setq paragraph-separate
1053                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
1054                           paragraph-separate))))
1055
1056 ;; How to encrypt in mdwmail.
1057
1058 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
1059   (or start
1060       (setq start (save-excursion
1061                     (goto-char (point-min))
1062                     (or (search-forward "\n\n" nil t) (point-min)))))
1063   (or end
1064       (setq end (point-max)))
1065   (mc-encrypt-generic recip scm start end from sign))
1066
1067 ;; How to sign in mdwmail.
1068
1069 (defun mdwmail-mc-sign (key scm start end uclr)
1070   (or start
1071       (setq start (save-excursion
1072                     (goto-char (point-min))
1073                     (or (search-forward "\n\n" nil t) (point-min)))))
1074   (or end
1075       (setq end (point-max)))
1076   (mc-sign-generic key scm start end uclr))
1077
1078 ;; Some signature mangling.
1079
1080 (defun mdwmail-mangle-signature ()
1081   (save-excursion
1082     (goto-char (point-min))
1083     (perform-replace "\n-- \n" "\n-- " nil nil nil)))
1084 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
1085 (add-hook 'message-setup-hook 'mdwmail-mangle-signature)
1086
1087 ;; Insert my login name into message-ids, so I can score replies.
1088
1089 (defadvice message-unique-id (after mdw-user-name last activate compile)
1090   "Ensure that the user's name appears at the end of the message-id string,
1091 so that it can be used for convenient filtering."
1092   (setq ad-return-value (concat ad-return-value "." (user-login-name))))
1093
1094 ;; Tell my movemail hack where movemail is.
1095 ;;
1096 ;; This is needed to shup up warnings about LD_PRELOAD.
1097
1098 (let ((path exec-path))
1099   (while path
1100     (let ((try (expand-file-name "movemail" (car path))))
1101       (if (file-executable-p try)
1102           (setenv "REAL_MOVEMAIL" try))
1103       (setq path (cdr path)))))
1104
1105 ;; AUTHINFO GENERIC kludge.
1106
1107 (defcustom nntp-authinfo-generic nil
1108   "Set to the `NNTPAUTH' string to pass on to `authinfo-kludge'.
1109
1110 Use this to arrange for per-server settings."
1111   :type '(choice (const :tag "Use `NNTPAUTH' environment variable" nil)
1112                  string)
1113   :safe 'stringp)
1114
1115 (defun nntp-open-authinfo-kludge (buffer)
1116   "Open a connection to SERVER using `authinfo-kludge'."
1117   (let ((proc (start-process "nntpd" buffer
1118                              "env" (concat "NNTPAUTH="
1119                                            (or nntp-authinfo-generic
1120                                                (getenv "NNTPAUTH")
1121                                                (error "NNTPAUTH unset")))
1122                              "authinfo-kludge" nntp-address)))
1123     (set-buffer buffer)
1124     (nntp-wait-for-string "^\r*200")
1125     (beginning-of-line)
1126     (delete-region (point-min) (point))
1127     proc))
1128
1129 (eval-after-load "erc"
1130   '(load "~/.ercrc.el"))
1131
1132 ;; Heavy-duty Gnus patching.
1133
1134 (defun mdw-nnimap-transform-headers ()
1135   (goto-char (point-min))
1136   (let (article lines size string)
1137     (cl-block nil
1138       (while (not (eobp))
1139         (while (not (looking-at "\\* [0-9]+ FETCH"))
1140           (delete-region (point) (progn (forward-line 1) (point)))
1141           (when (eobp)
1142             (cl-return)))
1143         (goto-char (match-end 0))
1144         ;; Unfold quoted {number} strings.
1145         (while (re-search-forward
1146                 "[^]][ (]{\\([0-9]+\\)}\r?\n"
1147                 (save-excursion
1148                   ;; Start of the header section.
1149                   (or (re-search-forward "] {[0-9]+}\r?\n" nil t)
1150                       ;; Start of the next FETCH.
1151                       (re-search-forward "\\* [0-9]+ FETCH" nil t)
1152                       (point-max)))
1153                 t)
1154           (setq size (string-to-number (match-string 1)))
1155           (delete-region (+ (match-beginning 0) 2) (point))
1156           (setq string (buffer-substring (point) (+ (point) size)))
1157           (delete-region (point) (+ (point) size))
1158           (insert (format "%S" (subst-char-in-string ?\n ?\s string)))
1159           ;; [mdw] missing from upstream
1160           (backward-char 1))
1161         (beginning-of-line)
1162         (setq article
1163                 (and (re-search-forward "UID \\([0-9]+\\)"
1164                                         (line-end-position)
1165                                         t)
1166                      (match-string 1)))
1167         (setq lines nil)
1168         (setq size
1169                 (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
1170                                         (line-end-position)
1171                                         t)
1172                      (match-string 1)))
1173         (beginning-of-line)
1174         (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
1175           (let ((structure (ignore-errors
1176                              (read (current-buffer)))))
1177             (while (and (consp structure)
1178                         (not (atom (car structure))))
1179               (setq structure (car structure)))
1180             (setq lines (if (and
1181                              (stringp (car structure))
1182                              (equal (upcase (nth 0 structure)) "MESSAGE")
1183                              (equal (upcase (nth 1 structure)) "RFC822"))
1184                             (nth 9 structure)
1185                           (nth 7 structure)))))
1186         (delete-region (line-beginning-position) (line-end-position))
1187         (insert (format "211 %s Article retrieved." article))
1188         (forward-line 1)
1189         (when size
1190           (insert (format "Chars: %s\n" size)))
1191         (when lines
1192           (insert (format "Lines: %s\n" lines)))
1193         ;; Most servers have a blank line after the headers, but
1194         ;; Davmail doesn't.
1195         (unless (re-search-forward "^\r$\\|^)\r?$" nil t)
1196           (goto-char (point-max)))
1197         (delete-region (line-beginning-position) (line-end-position))
1198         (insert ".")
1199         (forward-line 1)))))
1200
1201 (eval-after-load 'nnimap
1202   '(defalias 'nnimap-transform-headers
1203      (symbol-function 'mdw-nnimap-transform-headers)))
1204
1205 (defadvice gnus-other-frame (around mdw-hack-frame-width compile activate)
1206   "Always arrange for mail/news frames to be 80 columns wide."
1207   (let ((default-frame-alist (cons `(width . ,(+ 80 mdw-frame-width-fudge))
1208                                    (delete* 'width default-frame-alist
1209                                             :key #'car))))
1210     ad-do-it))
1211
1212 ;; Preferred programs.
1213
1214 (setq mailcap-user-mime-data
1215         '(((type . "application/pdf") (viewer . "mupdf %s"))))
1216
1217 ;;;--------------------------------------------------------------------------
1218 ;;; Utility functions.
1219
1220 (or (fboundp 'line-number-at-pos)
1221     (defun line-number-at-pos (&optional pos)
1222       (let ((opoint (or pos (point))) start)
1223         (save-excursion
1224           (save-restriction
1225             (goto-char (point-min))
1226             (widen)
1227             (forward-line 0)
1228             (setq start (point))
1229             (goto-char opoint)
1230             (forward-line 0)
1231             (1+ (count-lines 1 (point))))))))
1232
1233 (defun mdw-uniquify-alist (&rest alists)
1234   "Return the concatenation of the ALISTS with duplicate elements removed.
1235 The first association with a given key prevails; others are
1236 ignored.  The input lists are not modified, although they'll
1237 probably become garbage."
1238   (and alists
1239        (let ((start-list (cons nil nil)))
1240          (mdw-do-uniquify start-list
1241                           start-list
1242                           (car alists)
1243                           (cdr alists)))))
1244
1245 (defun mdw-do-uniquify (done end l rest)
1246   "A helper function for mdw-uniquify-alist.
1247 The DONE argument is a list whose first element is `nil'.  It
1248 contains the uniquified alist built so far.  The leading `nil' is
1249 stripped off at the end of the operation; it's only there so that
1250 DONE always references a cons cell.  END refers to the final cons
1251 cell in the DONE list; it is modified in place each time to avoid
1252 the overheads of `append'ing all the time.  The L argument is the
1253 alist we're currently processing; the remaining alists are given
1254 in REST."
1255
1256   ;; There are several different cases to deal with here.
1257   (cond
1258
1259    ;; Current list isn't empty.  Add the first item to the DONE list if
1260    ;; there's not an item with the same KEY already there.
1261    (l (or (assoc (car (car l)) done)
1262           (progn
1263             (setcdr end (cons (car l) nil))
1264             (setq end (cdr end))))
1265       (mdw-do-uniquify done end (cdr l) rest))
1266
1267    ;; The list we were working on is empty.  Shunt the next list into the
1268    ;; current list position and go round again.
1269    (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
1270
1271    ;; Everything's done.  Remove the leading `nil' from the DONE list and
1272    ;; return it.  Finished!
1273    (t (cdr done))))
1274
1275 (defun date ()
1276   "Insert the current date in a pleasing way."
1277   (interactive)
1278   (insert (save-excursion
1279             (let ((buffer (get-buffer-create "*tmp*")))
1280               (unwind-protect (progn (set-buffer buffer)
1281                                      (erase-buffer)
1282                                      (shell-command "date +%Y-%m-%d" t)
1283                                      (goto-char (mark))
1284                                      (delete-char -1)
1285                                      (buffer-string))
1286                 (kill-buffer buffer))))))
1287
1288 (defun uuencode (file &optional name)
1289   "UUencodes a file, maybe calling it NAME, into the current buffer."
1290   (interactive "fInput file name: ")
1291
1292   ;; If NAME isn't specified, then guess from the filename.
1293   (if (not name)
1294       (setq name
1295             (substring file
1296                        (or (string-match "[^/]*$" file) 0))))
1297   (print (format "uuencode `%s' `%s'" file name))
1298
1299   ;; Now actually do the thing.
1300   (call-process "uuencode" file t nil name))
1301
1302 (defcustom np-file "~/.np"
1303   "Where the `now-playing' file is."
1304   :type 'file
1305   :safe 'stringp)
1306
1307 (defun np (&optional arg)
1308   "Grabs a `now-playing' string."
1309   (interactive)
1310   (save-excursion
1311     (or arg (progn
1312               (goto-char (point-max))
1313               (insert "\nNP: ")
1314               (insert-file-contents np-file)))))
1315
1316 (defun mdw-version-< (ver-a ver-b)
1317   "Answer whether VER-A is strictly earlier than VER-B.
1318 VER-A and VER-B are version numbers, which are strings containing digit
1319 sequences separated by `.'."
1320   (let* ((la (mapcar (lambda (x) (car (read-from-string x)))
1321                      (split-string ver-a "\\.")))
1322          (lb (mapcar (lambda (x) (car (read-from-string x)))
1323                      (split-string ver-b "\\."))))
1324     (catch 'done
1325       (while t
1326         (cond ((null la) (throw 'done lb))
1327               ((null lb) (throw 'done nil))
1328               ((< (car la) (car lb)) (throw 'done t))
1329               ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb)))
1330               (t (throw 'done nil)))))))
1331
1332 (defun mdw-check-autorevert ()
1333   "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
1334 This takes into consideration whether it's been found using
1335 tramp, which seems to get itself into a twist."
1336   (cond ((not (boundp 'global-auto-revert-ignore-buffer))
1337          nil)
1338         ((and (buffer-file-name)
1339               (fboundp 'tramp-tramp-file-p)
1340               (tramp-tramp-file-p (buffer-file-name)))
1341          (unless global-auto-revert-ignore-buffer
1342            (setq global-auto-revert-ignore-buffer 'tramp)))
1343         ((eq global-auto-revert-ignore-buffer 'tramp)
1344          (setq global-auto-revert-ignore-buffer nil))))
1345
1346 (defadvice find-file (after mdw-autorevert activate)
1347   (mdw-check-autorevert))
1348 (defadvice write-file (after mdw-autorevert activate)
1349   (mdw-check-autorevert))
1350
1351 (defun mdw-auto-revert ()
1352   "Recheck all of the autorevertable buffers, and update VC modelines."
1353   (interactive)
1354   (let ((auto-revert-check-vc-info t))
1355     (auto-revert-buffers)))
1356
1357 ;;;--------------------------------------------------------------------------
1358 ;;; Dired hacking.
1359
1360 (defadvice dired-maybe-insert-subdir
1361     (around mdw-marked-insertion first activate)
1362   "The DIRNAME may be a list of directory names to insert.
1363 Interactively, if files are marked, then insert all of them.
1364 With a numeric prefix argument, select that many entries near
1365 point; with a non-numeric prefix argument, prompt for listing
1366 options."
1367   (interactive
1368    (list (dired-get-marked-files nil
1369                                  (and (integerp current-prefix-arg)
1370                                       current-prefix-arg)
1371                                  #'file-directory-p)
1372          (and current-prefix-arg
1373               (not (integerp current-prefix-arg))
1374               (read-string "Switches for listing: "
1375                            (or dired-subdir-switches
1376                                dired-actual-switches)))))
1377   (let ((dirs (ad-get-arg 0)))
1378     (dolist (dir (if (listp dirs) dirs (list dirs)))
1379       (ad-set-arg 0 dir)
1380       ad-do-it)))
1381
1382 (defun mdw-dired-run (args &optional syncp)
1383   (interactive (let ((file (dired-get-filename t)))
1384                  (list (read-string (format "Arguments for %s: " file))
1385                        current-prefix-arg)))
1386   (funcall (if syncp 'shell-command 'async-shell-command)
1387            (concat (shell-quote-argument (dired-get-filename nil))
1388                    " " args)))
1389
1390 (defadvice dired-do-flagged-delete
1391     (around mdw-delete-if-prefix-argument activate compile)
1392   (let ((delete-by-moving-to-trash (and (null current-prefix-arg)
1393                                         delete-by-moving-to-trash)))
1394     ad-do-it))
1395
1396 (eval-after-load "dired"
1397   '(define-key dired-mode-map "X" 'mdw-dired-run))
1398
1399 ;;;--------------------------------------------------------------------------
1400 ;;; URL viewing.
1401
1402 (defun mdw-w3m-browse-url (url &optional new-session-p)
1403   "Invoke w3m on the URL in its current window, or at least a different one.
1404 If NEW-SESSION-P, start a new session."
1405   (interactive "sURL: \nP")
1406   (save-excursion
1407     (let ((window (selected-window)))
1408       (unwind-protect
1409           (progn
1410             (select-window (or (and (not new-session-p)
1411                                     (get-buffer-window "*w3m*"))
1412                                (progn
1413                                  (if (one-window-p t) (split-window))
1414                                  (get-lru-window))))
1415             (w3m-browse-url url new-session-p))
1416         (select-window window)))))
1417
1418 (eval-after-load 'w3m
1419   '(define-key w3m-mode-map [?\e ?\r] 'w3m-view-this-url-new-session))
1420
1421 (defcustom mdw-good-url-browsers
1422   '(browse-url-mozilla
1423     browse-url-generic
1424     (w3m . mdw-w3m-browse-url)
1425     browse-url-w3)
1426   "List of good browsers for mdw-good-url-browsers.
1427 Each item is a browser function name, or a cons (CHECK . FUNC).
1428 A symbol FOO stands for (FOO . FOO)."
1429   :type '(repeat (choice function (cons function function))))
1430
1431 (defun mdw-good-url-browser ()
1432   "Return a good URL browser.
1433 Trundle the list of such things, finding the first item for which
1434 CHECK is fboundp, and returning the correponding FUNC."
1435   (let ((bs mdw-good-url-browsers) b check func answer)
1436     (while (and bs (not answer))
1437       (setq b (car bs)
1438             bs (cdr bs))
1439       (if (consp b)
1440           (setq check (car b) func (cdr b))
1441         (setq check b func b))
1442       (if (fboundp check)
1443           (setq answer func)))
1444     answer))
1445
1446 (eval-after-load "w3m-search"
1447   '(progn
1448      (dolist
1449          (item
1450           '(("g" "Google" "http://www.google.co.uk/search?q=%s")
1451             ("gd" "Google Directory"
1452              "http://www.google.com/search?cat=gwd/Top&q=%s")
1453             ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
1454             ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
1455             ("gi" "Images" "http://images.google.com/images?q=%s")
1456             ("rfc" "RFC"
1457              "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
1458             ("wp" "Wikipedia"
1459              "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
1460             ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
1461             ("nc-wiki" "nCipher wiki"
1462              "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
1463             ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
1464             ("lp" "Launchpad bug by number"
1465              "https://bugs.launchpad.net/bugs/%s")
1466             ("lppkg" "Launchpad bugs by package"
1467              "https://bugs.launchpad.net/%s")
1468             ("msdn" "MSDN"
1469              "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
1470             ("debbug" "Debian bug by number"
1471              "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
1472             ("debbugpkg" "Debian bugs by package"
1473              "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
1474             ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
1475        (add-to-list 'w3m-search-engine-alist
1476                     (list (cadr item) (cl-caddr item) nil))
1477        (add-to-list 'w3m-uri-replace-alist
1478                     (list (concat "\\`" (car item) ":")
1479                           'w3m-search-uri-replace
1480                           (cadr item))))))
1481
1482 ;;;--------------------------------------------------------------------------
1483 ;;; Paragraph filling.
1484
1485 ;; Useful variables.
1486
1487 (defcustom mdw-fill-prefix nil
1488   "Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
1489 If there's no fill prefix currently set (by the `fill-prefix'
1490 variable) and there's a match from one of the regexps here, it
1491 gets used to set the fill-prefix for the current operation.
1492
1493 The variable is a list of items of the form `PATTERN . PREFIX'; if
1494 the PATTERN matches, the PREFIX is used to set the fill prefix.
1495
1496 A PATTERN is one of the following.
1497
1498   * STRING -- a regular expression, expected to match at point
1499   * (eval . FORM) -- a Lisp form which must evaluate non-nil
1500   * (if COND CONSEQ-PAT ALT-PAT) -- if COND evaluates non-nil, must match
1501     CONSEQ-PAT; otherwise must match ALT-PAT
1502   * (and PATTERN ...) -- must match all of the PATTERNs
1503   * (or PATTERN ...) -- must match at least one PATTERN
1504   * (not PATTERN) -- mustn't match (probably not useful)
1505
1506 A PREFIX is a list of the following kinds of things:
1507
1508   * STRING -- insert a literal string
1509   * (match . N) -- insert the thing matched by bracketed subexpression N
1510   * (pad . N) -- a string of whitespace the same width as subexpression N
1511   * (expr . FORM) -- the result of evaluating FORM
1512
1513 Information about `bracketed subexpressions' comes from the match data,
1514 as modified during matching.")
1515
1516 (make-variable-buffer-local 'mdw-fill-prefix)
1517
1518 (defcustom mdw-hanging-indents
1519   (concat "\\(\\("
1520             "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
1521             "[ \t]+"
1522           "\\)?\\)")
1523   "Standard regexp matching parts of a hanging indent.
1524 This is mainly useful in `auto-fill-mode'."
1525   :type 'regexp)
1526
1527 ;; Utility functions.
1528
1529 (defun mdw-maybe-tabify (s)
1530   "Tabify or untabify the string S, according to `indent-tabs-mode'."
1531   (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
1532     (with-temp-buffer
1533       (save-match-data
1534         (insert s "\n")
1535         (let ((start (point-min)) (end (point-max)))
1536           (funcall tabfun (point-min) (point-max))
1537           (setq s (buffer-substring (point-min) (1- (point-max)))))))))
1538
1539 (defun mdw-fill-prefix-match-p (pat)
1540   "Return non-nil if PAT matches at the current position."
1541   (cond ((stringp pat) (looking-at pat))
1542         ((not (consp pat)) (error "Unknown pattern item `%S'" pat))
1543         ((eq (car pat) 'eval) (eval (cdr pat)))
1544         ((eq (car pat) 'if)
1545          (if (or (null (cdr pat))
1546                  (null (cddr pat))
1547                  (null (cl-cdddr pat))
1548                  (cl-cddddr pat))
1549              (error "Invalid `if' pattern `%S'" pat))
1550          (mdw-fill-prefix-match-p (if (eval (cadr pat))
1551                                       (cl-caddr pat)
1552                                     (cl-cadddr pat))))
1553         ((eq (car pat) 'and)
1554          (let ((pats (cdr pat))
1555                (ok t))
1556            (while (and pats
1557                        (or (mdw-fill-prefix-match-p (car pats))
1558                            (setq ok nil)))
1559              (setq pats (cdr pats)))
1560            ok))
1561         ((eq (car pat) 'or)
1562          (let ((pats (cdr pat))
1563                (ok nil))
1564            (while (and pats
1565                        (or (not (mdw-fill-prefix-match-p (car pats)))
1566                            (progn (setq ok t) nil)))
1567              (setq pats (cdr pats)))
1568            ok))
1569         ((eq (car pat) 'not)
1570          (if (or (null (cdr pat)) (cddr pat))
1571              (error "Invalid `not' pattern `%S'" pat))
1572          (not (mdw-fill-prefix-match-p (car pats))))
1573         (t (error "Unknown pattern form `%S'" pat))))
1574
1575 (defun mdw-maybe-car (p)
1576   "If P is a pair, return (car P), otherwise just return P."
1577   (if (consp p) (car p) p))
1578
1579 (defun mdw-padding (s)
1580   "Return a string the same width as S but made entirely from whitespace."
1581   (let* ((l (length s)) (i 0) (n (make-string l ? )))
1582     (while (< i l)
1583       (if (= 9 (aref s i))
1584           (aset n i 9))
1585       (setq i (1+ i)))
1586     n))
1587
1588 (defun mdw-do-prefix-match (m)
1589   "Expand a dynamic prefix match element.
1590 See `mdw-fill-prefix' for details."
1591   (cond ((not (consp m)) (format "%s" m))
1592         ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
1593         ((eq (car m) 'pad) (mdw-padding (match-string
1594                                          (mdw-maybe-car (cdr m)))))
1595         ((eq (car m) 'eval) (eval (cdr m)))
1596         (t "")))
1597
1598 (defun mdw-examine-fill-prefixes (l)
1599   "Given a list of dynamic fill prefixes, pick one which matches
1600 context and return the static fill prefix to use.  Point must be
1601 at the start of a line, and match data must be saved."
1602   (let ((prefix nil))
1603     (while (cond ((null l) nil)
1604                  ((mdw-fill-prefix-match-p (caar l))
1605                   (setq prefix
1606                           (mdw-maybe-tabify
1607                            (apply #'concat
1608                                   (mapcar #'mdw-do-prefix-match
1609                                           (cdr (car l))))))
1610                   nil))
1611       (setq l (cdr l)))
1612     prefix))
1613
1614 (defun mdw-choose-dynamic-fill-prefix ()
1615   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
1616   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
1617         ((not mdw-fill-prefix) fill-prefix)
1618         (t (save-excursion
1619              (beginning-of-line)
1620              (save-match-data
1621                (mdw-examine-fill-prefixes mdw-fill-prefix))))))
1622
1623 (defadvice do-auto-fill (around mdw-dynamic-fill-prefix () activate compile)
1624   "Handle auto-filling, working out a dynamic fill prefix in the
1625 case where there isn't a sensible static one."
1626   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
1627     ad-do-it))
1628
1629 (defun mdw-fill-paragraph ()
1630   "Fill paragraph, getting a dynamic fill prefix."
1631   (interactive)
1632   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
1633     (fill-paragraph nil)))
1634
1635 (defun mdw-point-within-string-p ()
1636   "Return non-nil if point is within a string."
1637   (let ((state (syntax-ppss)))
1638     (elt state 3)))
1639
1640 (defun mdw-standard-fill-prefix (rx &optional mat)
1641   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
1642 This is just a short-cut for setting the thing by hand, and by
1643 design it doesn't cope with anything approximating a complicated
1644 case."
1645   (setq mdw-fill-prefix
1646           `(((if (mdw-point-within-string-p)
1647                  ,(concat "\\(\\s-*\\)" mdw-hanging-indents)
1648                ,(concat rx mdw-hanging-indents))
1649              (match . 1)
1650              (pad . ,(or mat 2))))))
1651
1652 ;;;--------------------------------------------------------------------------
1653 ;;; Printing.
1654
1655 ;; Teach PostScript about a condensed variant of Courier.  I'm using 85% of
1656 ;; the usual width, which happens to match `mdwfonts', and David Carlisle's
1657 ;; `pslatex'.  (Once upon a time, I used 80%, but decided consistency with
1658 ;; `pslatex' was useful.)
1659 (setq ps-user-defined-prologue "
1660 /CourierCondensed /Courier
1661 /CourierCondensed-Bold /Courier-Bold
1662 /CourierCondensed-Oblique /Courier-Oblique
1663 /CourierCondensed-BoldOblique /Courier-BoldOblique
1664   4 { findfont [0.85 0 0 1 0 0] makefont definefont pop } repeat
1665 ")
1666
1667 ;; Hack `ps-print''s settings.
1668 (eval-after-load 'ps-print
1669   '(progn
1670
1671      ;; Notice that the comment-delimiters should be in italics too.
1672      (cl-pushnew 'font-lock-comment-delimiter-face ps-italic-faces)
1673
1674      ;; Select more suitable colours for the main kinds of tokens.  The
1675      ;; colours set on the Emacs faces are chosen for use against a dark
1676      ;; background, and work very badly on white paper.
1677      (ps-extend-face '(font-lock-comment-face "darkgreen" nil italic))
1678      (ps-extend-face '(font-lock-comment-delimiter-face "darkgreen" nil italic))
1679      (ps-extend-face '(font-lock-string-face "RoyalBlue4" nil))
1680      (ps-extend-face '(mdw-punct-face "sienna" nil))
1681      (ps-extend-face '(mdw-number-face "OrangeRed3" nil))
1682
1683      ;; Teach `ps-print' about my condensed varsions of Courier.
1684      (setq ps-font-info-database
1685              (append '((CourierCondensed
1686                         (fonts (normal . "CourierCondensed")
1687                                (bold . "CourierCondensed-Bold")
1688                                (italic . "CourierCondensed-Oblique")
1689                                (bold-italic . "CourierCondensed-BoldOblique"))
1690                         (size . 10.0)
1691                         (line-height . 10.55)
1692                         (space-width . 5.1)
1693                         (avg-char-width . 5.1)))
1694                      (cl-remove 'CourierCondensed ps-font-info-database
1695                                 :key #'car)))))
1696
1697 ;; Arrange to strip overlays from the buffer before we print .  This will
1698 ;; prevent `flyspell' from interfering with the printout.  (It would be less
1699 ;; bad if `ps-print' could merge the `flyspell' overlay face with the
1700 ;; underlying `font-lock' face, but it can't (and that seems hard).  So
1701 ;; instead we have this hack.
1702 ;;
1703 ;; The basic trick is to copy the relevant text from the buffer being printed
1704 ;; into a temporary buffer and... just print that.  The text properties come
1705 ;; with the text and end up in the new buffer, and the overlays get lost
1706 ;; along the way.  Only problem is that the headers identifying the file
1707 ;; being printed get confused, so remember the original buffer and reinstate
1708 ;; it when constructing the headers.
1709 (defvar mdw-printing-buffer)
1710
1711 (defadvice ps-generate-header
1712     (around mdw-use-correct-buffer () activate compile)
1713   "Print the correct name of the buffer being printed."
1714   (with-current-buffer mdw-printing-buffer
1715     ad-do-it))
1716
1717 (defadvice ps-generate
1718     (around mdw-strip-overlays (buffer from to genfunc) activate compile)
1719   "Strip overlays -- in particular, from `flyspell' -- before printout."
1720   (with-temp-buffer
1721     (let ((mdw-printing-buffer buffer))
1722       (insert-buffer-substring buffer from to)
1723       (ad-set-arg 0 (current-buffer))
1724       (ad-set-arg 1 (point-min))
1725       (ad-set-arg 2 (point-max))
1726       ad-do-it)))
1727
1728 ;;;--------------------------------------------------------------------------
1729 ;;; Other common declarations.
1730
1731 ;; Common mode settings.
1732
1733 (defcustom mdw-auto-indent t
1734   "Whether to indent automatically after a newline."
1735   :type 'boolean
1736   :safe 'booleanp)
1737
1738 (defun mdw-whitespace-mode (&optional arg)
1739   "Turn on/off whitespace mode, but don't highlight trailing space."
1740   (interactive "P")
1741   (when (and (boundp 'whitespace-style)
1742              (fboundp 'whitespace-mode))
1743     (let ((whitespace-style (remove 'trailing whitespace-style)))
1744       (whitespace-mode arg))
1745     (setq show-trailing-whitespace whitespace-mode)))
1746
1747 (defvar mdw-do-misc-mode-hacking nil)
1748
1749 (defun mdw-misc-mode-config ()
1750   (and mdw-auto-indent
1751        (cond ((eq major-mode 'lisp-mode)
1752               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
1753              ((derived-mode-p 'slime-repl-mode 'asm-mode 'comint-mode)
1754               nil)
1755              (t
1756               (local-set-key "\C-m" 'newline-and-indent))))
1757   (set (make-local-variable 'mdw-do-misc-mode-hacking) t)
1758   (local-set-key [C-return] 'newline)
1759   (make-local-variable 'page-delimiter)
1760   (setq page-delimiter (concat       "^" "\f"
1761                                "\\|" "^"
1762                                      ".\\{0,4\\}"
1763                                      "-\\{5\\}"
1764                                      "\\(" " " ".*" " " "\\)?"
1765                                      "-+"
1766                                      ".\\{0,2\\}"
1767                                      "$"))
1768   (setq comment-column 40)
1769   (auto-fill-mode 1)
1770   (setq fill-column mdw-text-width)
1771   (flyspell-prog-mode)
1772   (and (fboundp 'gtags-mode)
1773        (gtags-mode))
1774   (if (fboundp 'hs-minor-mode)
1775       (trap (hs-minor-mode t))
1776     (outline-minor-mode t))
1777   (reveal-mode t)
1778   (trap (turn-on-font-lock)))
1779
1780 (defun mdw-post-local-vars-misc-mode-config ()
1781   (setq whitespace-line-column mdw-text-width)
1782   (when (and mdw-do-misc-mode-hacking
1783              (not buffer-read-only))
1784     (setq show-trailing-whitespace t)
1785     (mdw-whitespace-mode 1)))
1786 (add-hook 'hack-local-variables-hook 'mdw-post-local-vars-misc-mode-config)
1787
1788 (defmacro mdw-advise-update-angry-fruit-salad (&rest funcs)
1789   `(progn ,@(mapcar (lambda (func)
1790                       `(defadvice ,func
1791                            (after mdw-angry-fruit-salad activate)
1792                          (when mdw-do-misc-mode-hacking
1793                            (setq show-trailing-whitespace
1794                                  (not buffer-read-only))
1795                            (mdw-whitespace-mode (if buffer-read-only 0 1)))))
1796                     funcs)))
1797 (mdw-advise-update-angry-fruit-salad toggle-read-only
1798                                      read-only-mode
1799                                      view-mode
1800                                      view-mode-enable
1801                                      view-mode-disable)
1802
1803 (eval-after-load 'gtags
1804   '(progn
1805      (dolist (key '([mouse-2] [mouse-3]))
1806        (define-key gtags-mode-map key nil))
1807      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
1808      (define-key gtags-select-mode-map [C-S-mouse-2]
1809        'gtags-select-tag-by-event)
1810      (dolist (map (list gtags-mode-map gtags-select-mode-map))
1811        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
1812
1813 ;; Backup file handling.
1814
1815 (defcustom mdw-backup-disable-regexps nil
1816   "List of regular expressions: if a file name matches any of
1817 these then the file is not backed up."
1818   :type '(repeat regexp))
1819
1820 (defun mdw-backup-enable-predicate (name)
1821   "[mdw]'s default backup predicate.
1822 Allows a backup if the standard predicate would allow it, and it
1823 doesn't match any of the regular expressions in
1824 `mdw-backup-disable-regexps'."
1825   (and (normal-backup-enable-predicate name)
1826        (let ((answer t) (list mdw-backup-disable-regexps))
1827          (save-match-data
1828            (while list
1829              (if (string-match (car list) name)
1830                  (setq answer nil))
1831              (setq list (cdr list)))
1832            answer))))
1833 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
1834
1835 ;; Frame cleanup.
1836
1837 (defun mdw-last-one-out-turn-off-the-lights (frame)
1838   "Disconnect from an X display if this was the last frame on that display."
1839   (let ((frame-display (frame-parameter frame 'display)))
1840     (when (and frame-display
1841                (eq window-system 'x)
1842                (not (cl-some (lambda (fr)
1843                                (and (not (eq fr frame))
1844                                     (string= (frame-parameter fr 'display)
1845                                              frame-display)))
1846                              (frame-list))))
1847       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
1848 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
1849
1850 ;;;--------------------------------------------------------------------------
1851 ;;; Fullscreen-ness.
1852
1853 (defcustom mdw-full-screen-parameters
1854   '((menu-bar-lines . 0)
1855     ;;(vertical-scroll-bars . nil)
1856     )
1857   "Frame parameters to set when making a frame fullscreen."
1858   :type '(alist :key-type symbol))
1859
1860 (defcustom mdw-full-screen-save
1861   '(width height)
1862   "Extra frame parameters to save when setting fullscreen."
1863   :type '(repeat symbol))
1864
1865 (defun mdw-toggle-full-screen (&optional frame)
1866   "Show the FRAME fullscreen."
1867   (interactive)
1868   (when window-system
1869     (cond ((frame-parameter frame 'fullscreen)
1870            (set-frame-parameter frame 'fullscreen nil)
1871            (modify-frame-parameters
1872             nil
1873             (or (frame-parameter frame 'mdw-full-screen-saved)
1874                 (mapcar (lambda (assoc)
1875                           (assq (car assoc) default-frame-alist))
1876                         mdw-full-screen-parameters))))
1877           (t
1878            (let ((saved (mapcar (lambda (param)
1879                                   (cons param (frame-parameter frame param)))
1880                                 (append (mapcar #'car
1881                                                 mdw-full-screen-parameters)
1882                                         mdw-full-screen-save))))
1883              (set-frame-parameter frame 'mdw-full-screen-saved saved))
1884            (modify-frame-parameters frame mdw-full-screen-parameters)
1885            (set-frame-parameter frame 'fullscreen 'fullboth)))))
1886
1887 ;;;--------------------------------------------------------------------------
1888 ;;; General fontification.
1889
1890 (make-face 'mdw-virgin-face)
1891
1892 (defmacro mdw-define-face (name &rest body)
1893   "Define a face, and make sure it's actually set as the definition."
1894   (declare (indent 1)
1895            (debug 0))
1896   `(progn
1897      (copy-face 'mdw-virgin-face ',name)
1898      (defvar ,name ',name)
1899      (put ',name 'face-defface-spec ',body)
1900      (face-spec-set ',name ',body nil)))
1901
1902 (mdw-define-face default
1903   (((type w32)) :family "courier new" :height 85)
1904   (((type x)) :family "6x13" :foundry "trad" :height 130)
1905   (((type color)) :foreground "white" :background "black")
1906   (t nil))
1907 (mdw-define-face fixed-pitch
1908   (((type w32)) :family "courier new" :height 85)
1909   (((type x)) :family "6x13" :foundry "trad" :height 130)
1910   (t :foreground "white" :background "black"))
1911 (mdw-define-face fixed-pitch-serif
1912   (((type w32)) :family "courier new" :height 85 :weight bold)
1913   (((type x)) :family "6x13" :foundry "trad" :height 130 :weight bold)
1914   (t :foreground "white" :background "black" :weight bold))
1915 (mdw-define-face variable-pitch
1916   (((type x)) :family "helvetica" :height 120))
1917 (mdw-define-face region
1918   (((min-colors 64)) :background "grey30")
1919   (((class color)) :background "blue")
1920   (t :inverse-video t))
1921 (mdw-define-face error
1922   (((class color)) :background "red")
1923   (t :inverse-video t))
1924 (mdw-define-face match
1925   (((class color)) :background "blue")
1926   (t :inverse-video t))
1927 (mdw-define-face mc/cursor-face
1928   (((class color)) :background "red")
1929   (t :inverse-video t))
1930 (mdw-define-face minibuffer-prompt
1931   (t :weight bold))
1932 (mdw-define-face mode-line
1933   (((class color)) :foreground "blue" :background "yellow"
1934                    :box (:line-width 1 :style released-button))
1935   (t :inverse-video t))
1936 (mdw-define-face mode-line-inactive
1937   (((class color)) :foreground "yellow" :background "blue"
1938                    :box (:line-width 1 :style released-button))
1939   (t :inverse-video t))
1940 (mdw-define-face nobreak-space
1941   (((type tty)))
1942   (t :inherit escape-glyph :underline t))
1943 (mdw-define-face scroll-bar
1944   (t :foreground "black" :background "lightgrey"))
1945 (mdw-define-face fringe
1946   (t :foreground "yellow"))
1947 (mdw-define-face show-paren-match
1948   (((min-colors 64)) :background "darkgreen")
1949   (((class color)) :background "green")
1950   (t :underline t))
1951 (mdw-define-face show-paren-mismatch
1952   (((class color)) :background "red")
1953   (t :inverse-video t))
1954 (mdw-define-face highlight
1955   (((min-colors 64)) :background "DarkSeaGreen4")
1956   (((class color)) :background "cyan")
1957   (t :inverse-video t))
1958
1959 (mdw-define-face viper-minibuffer-emacs (t nil))
1960 (mdw-define-face viper-minibuffer-insert (t nil))
1961 (mdw-define-face viper-minibuffer-vi (t nil))
1962 (mdw-define-face viper-replace-overlay
1963   (((min-colors 64)) :background "darkred")
1964   (((class color)) :background "red")
1965   (t :inverse-video t))
1966 (mdw-define-face viper-search (t :inherit isearch))
1967
1968 (mdw-define-face compilation-error
1969   (((class color)) :foreground "red" :weight bold)
1970   (t :weight bold))
1971 (mdw-define-face compilation-warning
1972   (((class color)) :foreground "orange" :weight bold)
1973   (t :weight bold))
1974 (mdw-define-face compilation-info
1975   (((class color)) :foreground "green" :weight bold)
1976   (t :weight bold))
1977 (mdw-define-face compilation-line-number
1978   (t :weight bold))
1979 (mdw-define-face compilation-column-number
1980   (((min-colors 64)) :foreground "lightgrey"))
1981 (setq compilation-message-face 'mdw-virgin-face)
1982 (setq compilation-enter-directory-face 'font-lock-comment-face)
1983 (setq compilation-leave-directory-face 'font-lock-comment-face)
1984
1985 (mdw-define-face holiday-face
1986   (t :background "red"))
1987 (mdw-define-face calendar-today-face
1988   (t :foreground "yellow" :weight bold))
1989
1990 (mdw-define-face flyspell-incorrect
1991   (((type x)) :underline (:color "red" :style wave))
1992   (((class color)) :foreground "red" :underline t)
1993   (t :underline t))
1994 (mdw-define-face flyspell-duplicate
1995   (((type x)) :underline (:color "orange" :style wave))
1996   (((class color)) :foreground "orange" :underline t)
1997   (t :underline t))
1998
1999 (mdw-define-face comint-highlight-prompt
2000   (t :weight bold))
2001 (mdw-define-face comint-highlight-input
2002   (t nil))
2003
2004 (mdw-define-face Man-underline
2005   (((type tty)) :underline t)
2006   (t :slant italic))
2007
2008 (mdw-define-face ido-subdir
2009   (t :foreground "cyan" :weight bold))
2010
2011 (mdw-define-face dired-directory
2012   (t :foreground "cyan" :weight bold))
2013 (mdw-define-face dired-symlink
2014   (t :foreground "cyan"))
2015 (mdw-define-face dired-perm-write
2016   (t nil))
2017
2018 (mdw-define-face trailing-whitespace
2019   (((class color)) :background "red")
2020   (t :inverse-video t))
2021 (mdw-define-face whitespace-line
2022   (((class color)) :background "darkred")
2023   (t :inverse-video t))
2024 (mdw-define-face mdw-punct-face
2025   (((min-colors 64)) :foreground "burlywood2")
2026   (((class color)) :foreground "yellow"))
2027 (mdw-define-face mdw-number-face
2028   (t :foreground "yellow"))
2029 (mdw-define-face mdw-trivial-face)
2030 (mdw-define-face font-lock-function-name-face
2031   (t :slant italic))
2032 (mdw-define-face font-lock-keyword-face
2033   (t :weight bold))
2034 (mdw-define-face font-lock-constant-face
2035   (t :slant italic))
2036 (mdw-define-face font-lock-builtin-face
2037   (t :weight bold))
2038 (mdw-define-face font-lock-type-face
2039   (t :weight bold :slant italic))
2040 (mdw-define-face font-lock-reference-face
2041   (t :weight bold))
2042 (mdw-define-face font-lock-variable-name-face
2043   (t :slant italic))
2044 (mdw-define-face font-lock-comment-face
2045   (((min-colors 64)) :slant italic :foreground "SeaGreen1")
2046   (((class color)) :foreground "green")
2047   (t :weight bold))
2048 (mdw-define-face font-lock-comment-delimiter-face
2049   (t :inherit font-lock-comment-face))
2050 (mdw-define-face font-lock-string-face
2051   (((min-colors 64)) :foreground "SkyBlue1")
2052   (((class color)) :foreground "cyan")
2053   (t :weight bold))
2054 (mdw-define-face font-lock-doc-face
2055   (t :inherit font-lock-string-face))
2056
2057 (mdw-define-face message-separator
2058   (t :background "red" :foreground "white" :weight bold))
2059 (mdw-define-face message-cited-text
2060   (default :slant italic)
2061   (((min-colors 64)) :foreground "SkyBlue1")
2062   (((class color)) :foreground "cyan"))
2063 (mdw-define-face message-header-cc
2064   (default :slant italic)
2065   (((min-colors 64)) :foreground "SeaGreen1")
2066   (((class color)) :foreground "green"))
2067 (mdw-define-face message-header-newsgroups
2068   (default :slant italic)
2069   (((min-colors 64)) :foreground "SeaGreen1")
2070   (((class color)) :foreground "green"))
2071 (mdw-define-face message-header-subject
2072   (((min-colors 64)) :foreground "SeaGreen1")
2073   (((class color)) :foreground "green"))
2074 (mdw-define-face message-header-to
2075   (((min-colors 64)) :foreground "SeaGreen1")
2076   (((class color)) :foreground "green"))
2077 (mdw-define-face message-header-xheader
2078   (default :slant italic)
2079   (((min-colors 64)) :foreground "SeaGreen1")
2080   (((class color)) :foreground "green"))
2081 (mdw-define-face message-header-other
2082   (default :slant italic)
2083   (((min-colors 64)) :foreground "SeaGreen1")
2084   (((class color)) :foreground "green"))
2085 (mdw-define-face message-header-name
2086   (default :weight bold)
2087   (((min-colors 64)) :foreground "SeaGreen1")
2088   (((class color)) :foreground "green"))
2089
2090 (mdw-define-face which-func
2091   (t nil))
2092
2093 (mdw-define-face gnus-header-name
2094   (default :weight bold)
2095   (((min-colors 64)) :foreground "SeaGreen1")
2096   (((class color)) :foreground "green"))
2097 (mdw-define-face gnus-header-subject
2098   (((min-colors 64)) :foreground "SeaGreen1")
2099   (((class color)) :foreground "green"))
2100 (mdw-define-face gnus-header-from
2101   (((min-colors 64)) :foreground "SeaGreen1")
2102   (((class color)) :foreground "green"))
2103 (mdw-define-face gnus-header-to
2104   (((min-colors 64)) :foreground "SeaGreen1")
2105   (((class color)) :foreground "green"))
2106 (mdw-define-face gnus-header-content
2107   (default :slant italic)
2108   (((min-colors 64)) :foreground "SeaGreen1")
2109   (((class color)) :foreground "green"))
2110
2111 (mdw-define-face gnus-cite-1
2112   (((min-colors 64)) :foreground "SkyBlue1")
2113   (((class color)) :foreground "cyan"))
2114 (mdw-define-face gnus-cite-2
2115   (((min-colors 64)) :foreground "RoyalBlue2")
2116   (((class color)) :foreground "blue"))
2117 (mdw-define-face gnus-cite-3
2118   (((min-colors 64)) :foreground "MediumOrchid")
2119   (((class color)) :foreground "magenta"))
2120 (mdw-define-face gnus-cite-4
2121   (((min-colors 64)) :foreground "firebrick2")
2122   (((class color)) :foreground "red"))
2123 (mdw-define-face gnus-cite-5
2124   (((min-colors 64)) :foreground "burlywood2")
2125   (((class color)) :foreground "yellow"))
2126 (mdw-define-face gnus-cite-6
2127   (((min-colors 64)) :foreground "SeaGreen1")
2128   (((class color)) :foreground "green"))
2129 (mdw-define-face gnus-cite-7
2130   (((min-colors 64)) :foreground "SlateBlue1")
2131   (((class color)) :foreground "cyan"))
2132 (mdw-define-face gnus-cite-8
2133   (((min-colors 64)) :foreground "RoyalBlue2")
2134   (((class color)) :foreground "blue"))
2135 (mdw-define-face gnus-cite-9
2136   (((min-colors 64)) :foreground "purple2")
2137   (((class color)) :foreground "magenta"))
2138 (mdw-define-face gnus-cite-10
2139   (((min-colors 64)) :foreground "DarkOrange2")
2140   (((class color)) :foreground "red"))
2141 (mdw-define-face gnus-cite-11
2142   (t :foreground "grey"))
2143
2144 (mdw-define-face gnus-emphasis-underline
2145   (((type tty)) :underline t)
2146   (t :slant italic))
2147
2148 (mdw-define-face diff-header
2149   (t nil))
2150 (mdw-define-face diff-index
2151   (t :weight bold))
2152 (mdw-define-face diff-file-header
2153   (t :weight bold))
2154 (mdw-define-face diff-hunk-header
2155   (((min-colors 64)) :foreground "SkyBlue1")
2156   (((class color)) :foreground "cyan"))
2157 (mdw-define-face diff-function
2158   (default :weight bold)
2159   (((min-colors 64)) :foreground "SkyBlue1")
2160   (((class color)) :foreground "cyan"))
2161 (mdw-define-face diff-header
2162   (((min-colors 64)) :background "grey10"))
2163 (mdw-define-face diff-added
2164   (((class color)) :foreground "green"))
2165 (mdw-define-face diff-removed
2166   (((class color)) :foreground "red"))
2167 (mdw-define-face diff-context
2168   (t nil))
2169 (mdw-define-face diff-refine-change
2170   (((min-colors 64)) :background "RoyalBlue4")
2171   (t :underline t))
2172 (mdw-define-face diff-refine-removed
2173   (((min-colors 64)) :background "#500")
2174   (t :underline t))
2175 (mdw-define-face diff-refine-added
2176   (((min-colors 64)) :background "#050")
2177   (t :underline t))
2178
2179 (setq ediff-force-faces t)
2180 (mdw-define-face ediff-current-diff-A
2181   (((min-colors 64)) :background "darkred")
2182   (((class color)) :background "red")
2183   (t :inverse-video t))
2184 (mdw-define-face ediff-fine-diff-A
2185   (((min-colors 64)) :background "red3")
2186   (((class color)) :inverse-video t)
2187   (t :inverse-video nil))
2188 (mdw-define-face ediff-even-diff-A
2189   (((min-colors 64)) :background "#300"))
2190 (mdw-define-face ediff-odd-diff-A
2191   (((min-colors 64)) :background "#300"))
2192 (mdw-define-face ediff-current-diff-B
2193   (((min-colors 64)) :background "darkgreen")
2194   (((class color)) :background "magenta")
2195   (t :inverse-video t))
2196 (mdw-define-face ediff-fine-diff-B
2197   (((min-colors 64)) :background "green4")
2198   (((class color)) :inverse-video t)
2199   (t :inverse-video nil))
2200 (mdw-define-face ediff-even-diff-B
2201   (((min-colors 64)) :background "#020"))
2202 (mdw-define-face ediff-odd-diff-B
2203   (((min-colors 64)) :background "#020"))
2204 (mdw-define-face ediff-current-diff-C
2205   (((min-colors 64)) :background "darkblue")
2206   (((class color)) :background "blue")
2207   (t :inverse-video t))
2208 (mdw-define-face ediff-fine-diff-C
2209   (((min-colors 64)) :background "blue1")
2210   (((class color)) :inverse-video t)
2211   (t :inverse-video nil))
2212 (mdw-define-face ediff-even-diff-C
2213   (((min-colors 64)) :background "#004"))
2214 (mdw-define-face ediff-odd-diff-C
2215   (((min-colors 64)) :background "#004"))
2216 (mdw-define-face ediff-current-diff-Ancestor
2217   (((min-colors 64)) :background "#630")
2218   (((class color)) :background "blue")
2219   (t :inverse-video t))
2220 (mdw-define-face ediff-even-diff-Ancestor
2221   (((min-colors 64)) :background "#320"))
2222 (mdw-define-face ediff-odd-diff-Ancestor
2223   (((min-colors 64)) :background "#320"))
2224
2225 (mdw-define-face magit-hash
2226   (((min-colors 64)) :foreground "grey40")
2227   (((class color)) :foreground "blue"))
2228 (mdw-define-face magit-diff-hunk-heading
2229   (((min-colors 64)) :foreground "grey70" :background "grey25")
2230   (((class color)) :foreground "yellow"))
2231 (mdw-define-face magit-diff-hunk-heading-highlight
2232   (((min-colors 64)) :foreground "grey70" :background "grey35")
2233   (((class color)) :foreground "yellow" :background "blue"))
2234 (mdw-define-face magit-diff-added
2235   (((min-colors 64)) :foreground "#ddffdd" :background "#335533")
2236   (((class color)) :foreground "green"))
2237 (mdw-define-face magit-diff-added-highlight
2238   (((min-colors 64)) :foreground "#cceecc" :background "#336633")
2239   (((class color)) :foreground "green" :background "blue"))
2240 (mdw-define-face magit-diff-removed
2241   (((min-colors 64)) :foreground "#ffdddd" :background "#553333")
2242   (((class color)) :foreground "red"))
2243 (mdw-define-face magit-diff-removed-highlight
2244   (((min-colors 64)) :foreground "#eecccc" :background "#663333")
2245   (((class color)) :foreground "red" :background "blue"))
2246 (mdw-define-face magit-blame-heading
2247   (((min-colors 64)) :foreground "white" :background "grey25"
2248                      :weight normal :slant normal)
2249   (((class color)) :foreground "white" :background "blue"
2250                    :weight normal :slant normal))
2251 (mdw-define-face magit-blame-name
2252   (t :inherit magit-blame-heading :slant italic))
2253 (mdw-define-face magit-blame-date
2254   (((min-colors 64)) :inherit magit-blame-heading :foreground "grey60")
2255   (((class color)) :inherit magit-blame-heading :foreground "cyan"))
2256 (mdw-define-face magit-blame-summary
2257   (t :inherit magit-blame-heading :weight bold))
2258
2259 (mdw-define-face dylan-header-background
2260   (((min-colors 64)) :background "NavyBlue")
2261   (((class color)) :background "blue"))
2262
2263 (mdw-define-face erc-my-nick-face
2264   (t :foreground "yellow" :weight bold))
2265 (mdw-define-face erc-current-nick-face
2266   (t :foreground "yellow" :weight bold))
2267 (mdw-define-face erc-input-face
2268   (t :foreground "yellow"))
2269 (mdw-define-face erc-action-face
2270   ())
2271 (mdw-define-face erc-button
2272   (t :foreground "cyan" :underline t :weight semi-bold))
2273
2274 (mdw-define-face woman-bold
2275   (t :weight bold))
2276 (mdw-define-face woman-italic
2277   (t :slant italic))
2278
2279 (eval-after-load "rst"
2280   '(progn
2281      (mdw-define-face rst-level-1-face
2282        (t :foreground "SkyBlue1" :weight bold))
2283      (mdw-define-face rst-level-2-face
2284        (t :foreground "SeaGreen1" :weight bold))
2285      (mdw-define-face rst-level-3-face
2286        (t :weight bold))
2287      (mdw-define-face rst-level-4-face
2288        (t :slant italic))
2289      (mdw-define-face rst-level-5-face
2290        (t :underline t))
2291      (mdw-define-face rst-level-6-face
2292        ())))
2293
2294 (mdw-define-face p4-depot-added-face
2295   (t :foreground "green"))
2296 (mdw-define-face p4-depot-branch-op-face
2297   (t :foreground "yellow"))
2298 (mdw-define-face p4-depot-deleted-face
2299   (t :foreground "red"))
2300 (mdw-define-face p4-depot-unmapped-face
2301   (t :foreground "SkyBlue1"))
2302 (mdw-define-face p4-diff-change-face
2303   (t :foreground "yellow"))
2304 (mdw-define-face p4-diff-del-face
2305   (t :foreground "red"))
2306 (mdw-define-face p4-diff-file-face
2307   (t :foreground "SkyBlue1"))
2308 (mdw-define-face p4-diff-head-face
2309   (t :background "grey10"))
2310 (mdw-define-face p4-diff-ins-face
2311   (t :foreground "green"))
2312
2313 (mdw-define-face w3m-anchor-face
2314   (t :foreground "SkyBlue1" :underline t))
2315 (mdw-define-face w3m-arrived-anchor-face
2316   (t :foreground "SkyBlue1" :underline t))
2317
2318 (mdw-define-face whizzy-slice-face
2319   (t :background "grey10"))
2320 (mdw-define-face whizzy-error-face
2321   (t :background "darkred"))
2322
2323 ;; Ellipses used to indicate hidden text (and similar).
2324 (mdw-define-face mdw-ellipsis-face
2325   (((type tty)) :foreground "blue") (t :foreground "grey60"))
2326 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
2327       (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
2328       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
2329       (bar (make-glyph-code ?| mdw-ellipsis-face)))
2330   (set-display-table-slot standard-display-table 0 dollar)
2331   (set-display-table-slot standard-display-table 1 backslash)
2332   (set-display-table-slot standard-display-table 4
2333                           (vector dot dot dot))
2334   (set-display-table-slot standard-display-table 5 bar))
2335
2336 ;;;--------------------------------------------------------------------------
2337 ;;; Where is point?
2338
2339 (mdw-define-face mdw-point-overlay-face
2340   (((type graphic)))
2341   (((min-colors 64)) :background "darkblue")
2342   (((class color)) :background "blue")
2343   (((type tty) (class mono)) :inverse-video t))
2344
2345 (defcustom mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar)
2346   "Bitmaps to display in the left and right fringes in the current line."
2347   :type '(cons symbol symbol))
2348
2349 (defun mdw-configure-point-overlay ()
2350   (let ((ov (make-overlay 0 0)))
2351     (overlay-put ov 'priority 0)
2352     (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
2353            (left (car fringe)) (right (cdr fringe))
2354            (s ""))
2355       (when left
2356         (let ((ss "."))
2357           (put-text-property 0 1 'display `(left-fringe ,left) ss)
2358           (setq s (concat s ss))))
2359       (when right
2360         (let ((ss "."))
2361           (put-text-property 0 1 'display `(right-fringe ,right) ss)
2362           (setq s (concat s ss))))
2363       (when (or left right)
2364         (overlay-put ov 'before-string s)))
2365     (overlay-put ov 'face 'mdw-point-overlay-face)
2366     (delete-overlay ov)
2367     ov))
2368
2369 (defvar mdw-point-overlay (mdw-configure-point-overlay)
2370   "An overlay used for showing where point is in the selected window.")
2371 (defun mdw-reconfigure-point-overlay ()
2372   (interactive)
2373   (setq mdw-point-overlay (mdw-configure-point-overlay)))
2374
2375 (defun mdw-remove-point-overlay ()
2376   "Remove the current-point overlay."
2377   (delete-overlay mdw-point-overlay))
2378
2379 (defun mdw-update-point-overlay ()
2380   "Mark the current point position with an overlay."
2381   (if (not mdw-point-overlay-mode)
2382       (mdw-remove-point-overlay)
2383     (overlay-put mdw-point-overlay 'window (selected-window))
2384     (move-overlay mdw-point-overlay
2385                   (line-beginning-position)
2386                   (+ (line-end-position) 1))))
2387
2388 (defvar mdw-point-overlay-buffers nil
2389   "List of buffers using `mdw-point-overlay-mode'.")
2390
2391 (define-minor-mode mdw-point-overlay-mode
2392   "Indicate current line with an overlay."
2393   :global nil
2394   (let ((buffer (current-buffer)))
2395     (setq mdw-point-overlay-buffers
2396             (cl-mapcan (lambda (buf)
2397                          (if (and (buffer-live-p buf)
2398                                   (not (eq buf buffer)))
2399                              (list buf)))
2400                        mdw-point-overlay-buffers))
2401     (if mdw-point-overlay-mode
2402         (setq mdw-point-overlay-buffers
2403                 (cons buffer mdw-point-overlay-buffers))))
2404   (cond (mdw-point-overlay-buffers
2405          (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
2406          (add-hook 'post-command-hook 'mdw-update-point-overlay))
2407         (t
2408          (mdw-remove-point-overlay)
2409          (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
2410          (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
2411
2412 (define-globalized-minor-mode mdw-global-point-overlay-mode
2413   mdw-point-overlay-mode
2414   (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
2415
2416 (defvar mdw-terminal-title-alist nil)
2417 (defun mdw-update-terminal-title ()
2418   (when (let ((term (frame-parameter nil 'tty-type)))
2419           (and term (string-match "^xterm" term)))
2420     (let* ((tty (frame-parameter nil 'tty))
2421            (old (assoc tty mdw-terminal-title-alist))
2422            (new (format-mode-line frame-title-format)))
2423       (unless (and old (equal (cdr old) new))
2424         (if old (rplacd old new)
2425           (setq mdw-terminal-title-alist
2426                   (cons (cons tty new) mdw-terminal-title-alist)))
2427         (send-string-to-terminal (concat "\e]2;" new "\e\\"))))))
2428
2429 (add-hook 'post-command-hook 'mdw-update-terminal-title)
2430
2431 ;;;--------------------------------------------------------------------------
2432 ;;; Ediff hacking.
2433
2434 (defvar mdw-ediff-previous-windows)
2435 (defun mdw-ediff-setup ()
2436   (setq mdw-ediff-previous-windows (current-window-configuration)))
2437 (defun mdw-ediff-suspend-or-quit ()
2438   (set-window-configuration mdw-ediff-previous-windows))
2439 (add-hook 'ediff-before-setup-hook 'mdw-ediff-setup)
2440 (add-hook 'ediff-quit-hook 'mdw-ediff-suspend-or-quit t)
2441 (add-hook 'ediff-suspend-hook 'mdw-ediff-suspend-or-quit t)
2442
2443 ;;;--------------------------------------------------------------------------
2444 ;;; C programming configuration.
2445
2446 ;; Make C indentation nice.
2447
2448 (defun mdw-c-lineup-arglist (langelem)
2449   "Hack for DWIMmery in c-lineup-arglist."
2450   (if (save-excursion
2451         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
2452       0
2453     (c-lineup-arglist langelem)))
2454
2455 (defun mdw-c-indent-extern-mumble (langelem)
2456   "Indent `extern \"...\" {' lines."
2457   (save-excursion
2458     (back-to-indentation)
2459     (if (looking-at
2460          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
2461         c-basic-offset
2462       nil)))
2463
2464 (defun mdw-c-indent-arglist-nested (langelem)
2465   "Indent continued argument lists.
2466 If we've nested more than one argument list, then only introduce a single
2467 indentation anyway."
2468   (let ((context c-syntactic-context)
2469         (pos (c-langelem-2nd-pos c-syntactic-element))
2470         (should-indent-p t))
2471     (while (and context
2472                 (eq (caar context) 'arglist-cont-nonempty))
2473       (when (and (= (cl-caddr (pop context)) pos)
2474                  context
2475                  (memq (caar context) '(arglist-intro
2476                                         arglist-cont-nonempty)))
2477         (setq should-indent-p nil)))
2478     (if should-indent-p '+ 0)))
2479
2480 (defvar mdw-define-c-styles-hook nil
2481   "Hook run when `cc-mode' starts up to define styles.")
2482
2483 (defun mdw-merge-style-alists (first second)
2484   (let ((output nil))
2485     (dolist (item first)
2486       (let ((key (car item)) (value (cdr item)))
2487         (if (let* ((key-name (symbol-name key))
2488                    (key-len (length key-name)))
2489               (and (>= key-len 6)
2490                    (string= (substring key-name (- key-len 6)) "-alist")))
2491             (push (cons key
2492                         (mdw-merge-style-alists value
2493                                                 (cdr (assoc key second))))
2494                   output)
2495           (push item output))))
2496     (dolist (item second)
2497       (unless (assoc (car item) first)
2498         (push item output)))
2499     (nreverse output)))
2500
2501 (cl-defmacro mdw-define-c-style (name (&optional parent) &rest assocs)
2502   "Define a C style, called NAME (a symbol) based on PARENT, setting ASSOCs.
2503 A function, named `mdw-define-c-style/NAME', is defined to actually install
2504 the style using `c-add-style', and added to the hook
2505 `mdw-define-c-styles-hook'.  If CC Mode is already loaded, then the style is
2506 set."
2507   (declare (indent defun))
2508   (let* ((name-string (symbol-name name))
2509          (var (intern (concat "mdw-c-style/" name-string)))
2510          (func (intern (concat "mdw-define-c-style/" name-string))))
2511     `(progn
2512        (setq ,var
2513                ,(if (null parent)
2514                     `',assocs
2515                   (let ((parent-list (intern (concat "mdw-c-style/"
2516                                                      (symbol-name parent)))))
2517                     `(mdw-merge-style-alists ',assocs ,parent-list))))
2518        (defun ,func () (c-add-style ,name-string ,var))
2519        (and (featurep 'cc-mode) (,func))
2520        (add-hook 'mdw-define-c-styles-hook ',func)
2521        ',name)))
2522
2523 (eval-after-load "cc-mode"
2524   '(run-hooks 'mdw-define-c-styles-hook))
2525
2526 (mdw-define-c-style mdw-c ()
2527   (c-basic-offset . 2)
2528   (comment-column . 40)
2529   (c-class-key . "class")
2530   (c-backslash-column . 72)
2531   (c-label-minimum-indentation . 0)
2532   (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
2533                    (defun-open . (add 0 c-indent-one-line-block))
2534                    (arglist-cont-nonempty . mdw-c-lineup-arglist)
2535                    (topmost-intro . mdw-c-indent-extern-mumble)
2536                    (cpp-define-intro . 0)
2537                    (knr-argdecl . 0)
2538                    (inextern-lang . [0])
2539                    (label . 0)
2540                    (case-label . +)
2541                    (access-label . -)
2542                    (inclass . +)
2543                    (inline-open . ++)
2544                    (statement-cont . +)
2545                    (statement-case-intro . +)))
2546
2547 (mdw-define-c-style mdw-trustonic-c (mdw-c)
2548   (c-basic-offset . 4)
2549   (c-offsets-alist (access-label . -2)))
2550
2551 (mdw-define-c-style mdw-trustonic-alec-c (mdw-trustonic-c)
2552   (comment-column . 0)
2553   (c-indent-comment-alist (anchored-comment . (column . 0))
2554                           (end-block . (space . 1))
2555                           (cpp-end-block . (space . 1))
2556                           (other . (space . 1)))
2557   (c-offsets-alist (arglist-cont-nonempty . mdw-c-indent-arglist-nested)))
2558
2559 (defun mdw-set-default-c-style (modes style)
2560   "Update the default CC Mode style for MODES to be STYLE.
2561
2562 MODES may be a list of major mode names or a singleton.  STYLE is a style
2563 name, as a symbol."
2564   (let ((modes (if (listp modes) modes (list modes)))
2565         (style (symbol-name style)))
2566     (setq c-default-style
2567             (append (mapcar (lambda (mode)
2568                               (cons mode style))
2569                             modes)
2570                     (cl-remove-if (lambda (assoc)
2571                                     (memq (car assoc) modes))
2572                                   (if (listp c-default-style)
2573                                       c-default-style
2574                                     (list (cons 'other
2575                                                 c-default-style))))))))
2576 (setq c-default-style "mdw-c")
2577
2578 (mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c)
2579
2580 (defvar mdw-c-comment-fill-prefix
2581   `((,(concat "\\([ \t]*/?\\)"
2582               "\\(\\*\\|//\\)"
2583               "\\([ \t]*\\)"
2584               "\\([A-Za-z]+:[ \t]*\\)?"
2585               mdw-hanging-indents)
2586      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
2587   "Fill prefix matching C comments (both kinds).")
2588
2589 (defun mdw-fontify-c-and-c++ ()
2590
2591   ;; Fiddle with some syntax codes.
2592   (modify-syntax-entry ?* ". 23")
2593   (modify-syntax-entry ?/ ". 124b")
2594   (modify-syntax-entry ?\n "> b")
2595
2596   ;; Other stuff.
2597   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2598
2599   ;; Now define things to be fontified.
2600   (make-local-variable 'font-lock-keywords)
2601   (let ((c-keywords
2602          (mdw-regexps "alignas"          ;C11 macro, C++11
2603                       "alignof"          ;C++11
2604                       "and"              ;C++, C95 macro
2605                       "and_eq"           ;C++, C95 macro
2606                       "asm"              ;K&R, C++, GCC
2607                       "atomic"           ;C11 macro, C++11 template type
2608                       "auto"             ;K&R, C89
2609                       "bitand"           ;C++, C95 macro
2610                       "bitor"            ;C++, C95 macro
2611                       "bool"             ;C++, C99 macro
2612                       "break"            ;K&R, C89
2613                       "case"             ;K&R, C89
2614                       "catch"            ;C++
2615                       "char"             ;K&R, C89
2616                       "char16_t"         ;C++11, C11 library type
2617                       "char32_t"         ;C++11, C11 library type
2618                       "class"            ;C++
2619                       "complex"          ;C99 macro, C++ template type
2620                       "compl"            ;C++, C95 macro
2621                       "const"            ;C89
2622                       "constexpr"        ;C++11
2623                       "const_cast"       ;C++
2624                       "continue"         ;K&R, C89
2625                       "decltype"         ;C++11
2626                       "defined"          ;C89 preprocessor
2627                       "default"          ;K&R, C89
2628                       "delete"           ;C++
2629                       "do"               ;K&R, C89
2630                       "double"           ;K&R, C89
2631                       "dynamic_cast"     ;C++
2632                       "else"             ;K&R, C89
2633                       ;; "entry"         ;K&R -- never used
2634                       "enum"             ;C89
2635                       "explicit"         ;C++
2636                       "export"           ;C++
2637                       "extern"           ;K&R, C89
2638                       "float"            ;K&R, C89
2639                       "for"              ;K&R, C89
2640                       ;; "fortran"       ;K&R
2641                       "friend"           ;C++
2642                       "goto"             ;K&R, C89
2643                       "if"               ;K&R, C89
2644                       "imaginary"        ;C99 macro
2645                       "inline"           ;C++, C99, GCC
2646                       "int"              ;K&R, C89
2647                       "long"             ;K&R, C89
2648                       "mutable"          ;C++
2649                       "namespace"        ;C++
2650                       "new"              ;C++
2651                       "noexcept"         ;C++11
2652                       "noreturn"         ;C11 macro
2653                       "not"              ;C++, C95 macro
2654                       "not_eq"           ;C++, C95 macro
2655                       "nullptr"          ;C++11
2656                       "operator"         ;C++
2657                       "or"               ;C++, C95 macro
2658                       "or_eq"            ;C++, C95 macro
2659                       "private"          ;C++
2660                       "protected"        ;C++
2661                       "public"           ;C++
2662                       "register"         ;K&R, C89
2663                       "reinterpret_cast" ;C++
2664                       "restrict"         ;C99
2665                       "return"           ;K&R, C89
2666                       "short"            ;K&R, C89
2667                       "signed"           ;C89
2668                       "sizeof"           ;K&R, C89
2669                       "static"           ;K&R, C89
2670                       "static_assert"    ;C11 macro, C++11
2671                       "static_cast"      ;C++
2672                       "struct"           ;K&R, C89
2673                       "switch"           ;K&R, C89
2674                       "template"         ;C++
2675                       "throw"            ;C++
2676                       "try"              ;C++
2677                       "thread_local"     ;C11 macro, C++11
2678                       "typedef"          ;C89
2679                       "typeid"           ;C++
2680                       "typeof"           ;GCC
2681                       "typename"         ;C++
2682                       "union"            ;K&R, C89
2683                       "unsigned"         ;K&R, C89
2684                       "using"            ;C++
2685                       "virtual"          ;C++
2686                       "void"             ;C89
2687                       "volatile"         ;C89
2688                       "wchar_t"          ;C++, C89 library type
2689                       "while"            ;K&R, C89
2690                       "xor"              ;C++, C95 macro
2691                       "xor_eq"           ;C++, C95 macro
2692                       "_Alignas"         ;C11
2693                       "_Alignof"         ;C11
2694                       "_Atomic"          ;C11
2695                       "_Bool"            ;C99
2696                       "_Complex"         ;C99
2697                       "_Generic"         ;C11
2698                       "_Imaginary"       ;C99
2699                       "_Noreturn"        ;C11
2700                       "_Pragma"          ;C99 preprocessor
2701                       "_Static_assert"   ;C11
2702                       "_Thread_local"    ;C11
2703                       "__alignof__"      ;GCC
2704                       "__asm__"          ;GCC
2705                       "__attribute__"    ;GCC
2706                       "__complex__"      ;GCC
2707                       "__const__"        ;GCC
2708                       "__extension__"    ;GCC
2709                       "__imag__"         ;GCC
2710                       "__inline__"       ;GCC
2711                       "__label__"        ;GCC
2712                       "__real__"         ;GCC
2713                       "__signed__"       ;GCC
2714                       "__typeof__"       ;GCC
2715                       "__volatile__"     ;GCC
2716                       ))
2717         (c-builtins
2718          (mdw-regexps "false"            ;C++, C99 macro
2719                       "this"             ;C++
2720                       "true"             ;C++, C99 macro
2721                       ))
2722         (preprocessor-keywords
2723          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2724                       "ident" "if" "ifdef" "ifndef" "import" "include"
2725                       "line" "pragma" "unassert" "undef" "warning"))
2726         (objc-keywords
2727          (mdw-regexps "class" "defs" "encode" "end" "implementation"
2728                       "interface" "private" "protected" "protocol" "public"
2729                       "selector")))
2730
2731     (setq font-lock-keywords
2732             (list
2733
2734              ;; Fontify include files as strings.
2735              (list (concat "^[ \t]*\\#[ \t]*"
2736                            "\\(include\\|import\\)"
2737                            "[ \t]*\\(<[^>]+>?\\)")
2738                    '(2 font-lock-string-face))
2739
2740              ;; Preprocessor directives are `references'?.
2741              (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2742                            preprocessor-keywords
2743                            "\\)\\>\\|[0-9]+\\|$\\)\\)")
2744                    '(1 font-lock-keyword-face))
2745
2746              ;; Handle the keywords defined above.
2747              (list (concat "@\\<\\(" objc-keywords "\\)\\>")
2748                    '(0 font-lock-keyword-face))
2749
2750              (list (concat "\\<\\(" c-keywords "\\)\\>")
2751                    '(0 font-lock-keyword-face))
2752
2753              (list (concat "\\<\\(" c-builtins "\\)\\>")
2754                    '(0 font-lock-variable-name-face))
2755
2756              ;; Handle numbers too.
2757              ;;
2758              ;; This looks strange, I know.  It corresponds to the
2759              ;; preprocessor's idea of what a number looks like, rather than
2760              ;; anything sensible.
2761              (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2762                            "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2763                    '(0 mdw-number-face))
2764
2765              ;; And anything else is punctuation.
2766              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2767                    '(0 mdw-punct-face))))))
2768
2769 (define-derived-mode sod-mode c-mode "Sod"
2770   "Major mode for editing Sod code.")
2771 (push '("\\.sod$" . sod-mode) auto-mode-alist)
2772
2773 (dolist (hook '(c-mode-hook objc-mode-hook c++-mode-hook))
2774   (add-hook hook 'mdw-misc-mode-config t)
2775   (add-hook hook 'mdw-fontify-c-and-c++ t))
2776
2777 ;;;--------------------------------------------------------------------------
2778 ;;; AP calc mode.
2779
2780 (define-derived-mode apcalc-mode c-mode "AP Calc"
2781   "Major mode for editing Calc code.")
2782
2783 (defun mdw-fontify-apcalc ()
2784
2785   ;; Fiddle with some syntax codes.
2786   (modify-syntax-entry ?* ". 23")
2787   (modify-syntax-entry ?/ ". 14")
2788
2789   ;; Other stuff.
2790   (setq comment-start "/* ")
2791   (setq comment-end " */")
2792   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2793
2794   ;; Now define things to be fontified.
2795   (make-local-variable 'font-lock-keywords)
2796   (let ((c-keywords
2797          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
2798                       "do" "else" "exit" "for" "global" "goto" "help" "if"
2799                       "local" "mat" "obj" "print" "quit" "read" "return"
2800                       "show" "static" "switch" "while" "write")))
2801
2802     (setq font-lock-keywords
2803             (list
2804
2805              ;; Handle the keywords defined above.
2806              (list (concat "\\<\\(" c-keywords "\\)\\>")
2807                    '(0 font-lock-keyword-face))
2808
2809              ;; Handle numbers too.
2810              ;;
2811              ;; This looks strange, I know.  It corresponds to the
2812              ;; preprocessor's idea of what a number looks like, rather than
2813              ;; anything sensible.
2814              (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2815                            "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2816                    '(0 mdw-number-face))
2817
2818              ;; And anything else is punctuation.
2819              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2820                    '(0 mdw-punct-face))))))
2821
2822 (progn
2823   (add-hook 'apcalc-mode-hook 'mdw-misc-mode-config t)
2824   (add-hook 'apcalc-mode-hook 'mdw-fontify-apcalc t))
2825
2826 ;;;--------------------------------------------------------------------------
2827 ;;; Java programming configuration.
2828
2829 ;; Make indentation nice.
2830
2831 (mdw-define-c-style mdw-java ()
2832   (c-basic-offset . 2)
2833   (c-backslash-column . 72)
2834   (c-offsets-alist (substatement-open . 0)
2835                    (label . +)
2836                    (case-label . +)
2837                    (access-label . 0)
2838                    (inclass . +)
2839                    (statement-case-intro . +)))
2840 (mdw-set-default-c-style 'java-mode 'mdw-java)
2841
2842 ;; Declare Java fontification style.
2843
2844 (defun mdw-fontify-java ()
2845
2846   ;; Fiddle with some syntax codes.
2847   (modify-syntax-entry ?@ ".")
2848   (modify-syntax-entry ?@ "." font-lock-syntax-table)
2849
2850   ;; Other stuff.
2851   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2852
2853   ;; Now define things to be fontified.
2854   (make-local-variable 'font-lock-keywords)
2855   (let ((java-keywords
2856          (mdw-regexps "abstract" "assert"
2857                       "boolean" "break" "byte"
2858                       "case" "catch" "char" "class" "const" "continue"
2859                       "default" "do" "double"
2860                       "else" "enum" "extends"
2861                       "final" "finally" "float" "for"
2862                       "goto"
2863                       "if" "implements" "import" "instanceof" "int"
2864                       "interface"
2865                       "long"
2866                       "native" "new"
2867                       "package" "private" "protected" "public"
2868                       "return"
2869                       "short" "static" "strictfp" "switch" "synchronized"
2870                       "throw" "throws" "transient" "try"
2871                       "void" "volatile"
2872                       "while"))
2873
2874         (java-builtins
2875          (mdw-regexps "false" "null" "super" "this" "true")))
2876
2877     (setq font-lock-keywords
2878             (list
2879
2880              ;; Handle the keywords defined above.
2881              (list (concat "\\<\\(" java-keywords "\\)\\>")
2882                    '(0 font-lock-keyword-face))
2883
2884              ;; Handle the magic builtins defined above.
2885              (list (concat "\\<\\(" java-builtins "\\)\\>")
2886                    '(0 font-lock-variable-name-face))
2887
2888              ;; Handle numbers too.
2889              ;;
2890              ;; The following isn't quite right, but it's close enough.
2891              (list (concat "\\<\\("
2892                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2893                            "[0-9]+\\(\\.[0-9]*\\)?"
2894                            "\\([eE][-+]?[0-9]+\\)?\\)"
2895                            "[lLfFdD]?")
2896                    '(0 mdw-number-face))
2897
2898              ;; And anything else is punctuation.
2899              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2900                    '(0 mdw-punct-face))))))
2901
2902 (progn
2903   (add-hook 'java-mode-hook 'mdw-misc-mode-config t)
2904   (add-hook 'java-mode-hook 'mdw-fontify-java t))
2905
2906 ;;;--------------------------------------------------------------------------
2907 ;;; Javascript programming configuration.
2908
2909 (defun mdw-javascript-style ()
2910   (setq js-indent-level 2)
2911   (setq js-expr-indent-offset 0))
2912
2913 (defun mdw-fontify-javascript ()
2914
2915   ;; Other stuff.
2916   (mdw-javascript-style)
2917   (setq js-auto-indent-flag t)
2918
2919   ;; Now define things to be fontified.
2920   (make-local-variable 'font-lock-keywords)
2921   (let ((javascript-keywords
2922          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
2923                       "char" "class" "const" "continue" "debugger" "default"
2924                       "delete" "do" "double" "else" "enum" "export" "extends"
2925                       "final" "finally" "float" "for" "function" "goto" "if"
2926                       "implements" "import" "in" "instanceof" "int"
2927                       "interface" "let" "long" "native" "new" "package"
2928                       "private" "protected" "public" "return" "short"
2929                       "static" "super" "switch" "synchronized" "throw"
2930                       "throws" "transient" "try" "typeof" "var" "void"
2931                       "volatile" "while" "with" "yield"))
2932         (javascript-builtins
2933          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
2934                       "arguments" "this")))
2935
2936     (setq font-lock-keywords
2937             (list
2938
2939              ;; Handle the keywords defined above.
2940              (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
2941                    '(0 font-lock-keyword-face))
2942
2943              ;; Handle the predefined builtins defined above.
2944              (list (concat "\\_<\\(" javascript-builtins "\\)\\_>")
2945                    '(0 font-lock-variable-name-face))
2946
2947              ;; Handle numbers too.
2948              ;;
2949              ;; The following isn't quite right, but it's close enough.
2950              (list (concat "\\_<\\("
2951                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2952                            "[0-9]+\\(\\.[0-9]*\\)?"
2953                            "\\([eE][-+]?[0-9]+\\)?\\)"
2954                            "[lLfFdD]?")
2955                    '(0 mdw-number-face))
2956
2957              ;; And anything else is punctuation.
2958              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2959                    '(0 mdw-punct-face))))))
2960
2961 (progn
2962   (add-hook 'js-mode-hook 'mdw-misc-mode-config t)
2963   (add-hook 'js-mode-hook 'mdw-fontify-javascript t))
2964
2965 ;;;--------------------------------------------------------------------------
2966 ;;; Scala programming configuration.
2967
2968 (defun mdw-fontify-scala ()
2969
2970   ;; Comment filling.
2971   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2972
2973   ;; Define things to be fontified.
2974   (make-local-variable 'font-lock-keywords)
2975   (let ((scala-keywords
2976          (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
2977                       "extends" "final" "finally" "for" "forSome" "if"
2978                       "implicit" "import" "lazy" "match" "new" "object"
2979                       "override" "package" "private" "protected" "return"
2980                       "sealed" "throw" "trait" "try" "type" "val"
2981                       "var" "while" "with" "yield"))
2982         (scala-constants
2983          (mdw-regexps "false" "null" "super" "this" "true"))
2984         (punctuation "[-!%^&*=+:@#~/?\\|`]"))
2985
2986     (setq font-lock-keywords
2987             (list
2988
2989              ;; Magical identifiers between backticks.
2990              (list (concat "`\\([^`]+\\)`")
2991                    '(1 font-lock-variable-name-face))
2992
2993              ;; Handle the keywords defined above.
2994              (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
2995                    '(0 font-lock-keyword-face))
2996
2997              ;; Handle the constants defined above.
2998              (list (concat "\\_<\\(" scala-constants "\\)\\_>")
2999                    '(0 font-lock-variable-name-face))
3000
3001              ;; Magical identifiers between backticks.
3002              (list (concat "`\\([^`]+\\)`")
3003                    '(1 font-lock-variable-name-face))
3004
3005              ;; Handle numbers too.
3006              ;;
3007              ;; As usual, not quite right.
3008              (list (concat "\\_<\\("
3009                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3010                            "[0-9]+\\(\\.[0-9]*\\)?"
3011                            "\\([eE][-+]?[0-9]+\\)?\\)"
3012                            "[lLfFdD]?")
3013                    '(0 mdw-number-face))
3014
3015              ;; And everything else is punctuation.
3016              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3017                    '(0 mdw-punct-face)))
3018
3019           font-lock-syntactic-keywords
3020             (list
3021
3022              ;; Single quotes around characters.  But not when used to quote
3023              ;; symbol names.  Ugh.
3024              (list (concat "\\('\\)"
3025                            "\\(" "."
3026                            "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
3027                            "u+" "[0-9a-fA-F]\\{4\\}"
3028                            "\\|" "\\\\" "[0-7]\\{1,3\\}"
3029                            "\\|" "\\\\" "." "\\)"
3030                            "\\('\\)")
3031                    '(1 "\"")
3032                    '(4 "\""))))))
3033
3034 (progn
3035   (add-hook 'scala-mode-hook 'mdw-misc-mode-config t)
3036   (add-hook 'scala-mode-hook 'mdw-fontify-scala t))
3037
3038 ;;;--------------------------------------------------------------------------
3039 ;;; C# programming configuration.
3040
3041 ;; Make indentation nice.
3042
3043 (mdw-define-c-style mdw-csharp ()
3044   (c-basic-offset . 2)
3045   (c-backslash-column . 72)
3046   (c-offsets-alist (substatement-open . 0)
3047                    (label . 0)
3048                    (case-label . +)
3049                    (access-label . 0)
3050                    (inclass . +)
3051                    (statement-case-intro . +)))
3052 (mdw-set-default-c-style 'csharp-mode 'mdw-csharp)
3053
3054 ;; Declare C# fontification style.
3055
3056 (defun mdw-fontify-csharp ()
3057
3058   ;; Other stuff.
3059   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
3060
3061   ;; Now define things to be fontified.
3062   (make-local-variable 'font-lock-keywords)
3063   (let ((csharp-keywords
3064          (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
3065                       "char" "checked" "class" "const" "continue" "decimal"
3066                       "default" "delegate" "do" "double" "else" "enum"
3067                       "event" "explicit" "extern" "finally" "fixed" "float"
3068                       "for" "foreach" "goto" "if" "implicit" "in" "int"
3069                       "interface" "internal" "is" "lock" "long" "namespace"
3070                       "new" "object" "operator" "out" "override" "params"
3071                       "private" "protected" "public" "readonly" "ref"
3072                       "return" "sbyte" "sealed" "short" "sizeof"
3073                       "stackalloc" "static" "string" "struct" "switch"
3074                       "throw" "try" "typeof" "uint" "ulong" "unchecked"
3075                       "unsafe" "ushort" "using" "virtual" "void" "volatile"
3076                       "while" "yield"))
3077
3078         (csharp-builtins
3079          (mdw-regexps "base" "false" "null" "this" "true")))
3080
3081     (setq font-lock-keywords
3082             (list
3083
3084              ;; Handle the keywords defined above.
3085              (list (concat "\\<\\(" csharp-keywords "\\)\\>")
3086                    '(0 font-lock-keyword-face))
3087
3088              ;; Handle the magic builtins defined above.
3089              (list (concat "\\<\\(" csharp-builtins "\\)\\>")
3090                    '(0 font-lock-variable-name-face))
3091
3092              ;; Handle numbers too.
3093              ;;
3094              ;; The following isn't quite right, but it's close enough.
3095              (list (concat "\\<\\("
3096                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3097                            "[0-9]+\\(\\.[0-9]*\\)?"
3098                            "\\([eE][-+]?[0-9]+\\)?\\)"
3099                            "[lLfFdD]?")
3100                    '(0 mdw-number-face))
3101
3102              ;; And anything else is punctuation.
3103              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3104                    '(0 mdw-punct-face))))))
3105
3106 (define-derived-mode csharp-mode java-mode "C#"
3107   "Major mode for editing C# code.")
3108
3109 (add-hook 'csharp-mode-hook 'mdw-fontify-csharp t)
3110
3111 ;;;--------------------------------------------------------------------------
3112 ;;; F# programming configuration.
3113
3114 (setq fsharp-indent-offset 2)
3115
3116 (defun mdw-fontify-fsharp ()
3117
3118   (let ((punct "=<>+-*/|&%!@?"))
3119     (cl-do ((i 0 (1+ i)))
3120         ((>= i (length punct)))
3121       (modify-syntax-entry (aref punct i) ".")))
3122
3123   (modify-syntax-entry ?_ "_")
3124   (modify-syntax-entry ?( "(")
3125   (modify-syntax-entry ?) ")")
3126
3127   (setq indent-tabs-mode nil)
3128
3129   (let ((fsharp-keywords
3130          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
3131                       "begin" "break"
3132                       "checked" "class" "component" "const" "constraint"
3133                       "constructor" "continue"
3134                       "default" "delegate" "do" "done" "downcast" "downto"
3135                       "eager" "elif" "else" "end" "exception" "extern"
3136                       "finally" "fixed" "for" "fori" "fun" "function"
3137                       "functor"
3138                       "global"
3139                       "if" "in" "include" "inherit" "inline" "interface"
3140                       "internal"
3141                       "lazy" "let"
3142                       "match" "measure" "member" "method" "mixin" "module"
3143                       "mutable"
3144                       "namespace" "new"
3145                       "object" "of" "open" "or" "override"
3146                       "parallel" "params" "private" "process" "protected"
3147                       "public" "pure"
3148                       "rec" "recursive" "return"
3149                       "sealed" "sig" "static" "struct"
3150                       "tailcall" "then" "to" "trait" "try" "type"
3151                       "upcast" "use"
3152                       "val" "virtual" "void" "volatile"
3153                       "when" "while" "with"
3154                       "yield"))
3155
3156         (fsharp-builtins
3157          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
3158                       "base" "false" "null" "true"))
3159
3160         (bang-keywords
3161          (mdw-regexps "do" "let" "return" "use" "yield"))
3162
3163         (preprocessor-keywords
3164          (mdw-regexps "if" "indent" "else" "endif")))
3165
3166     (setq font-lock-keywords
3167             (list (list (concat "\\(^\\|[^\"]\\)"
3168                                 "\\(" "(\\*"
3169                                       "[^*]*\\*+"
3170                                       "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
3171                                       ")"
3172                                 "\\|"
3173                                       "//.*"
3174                                 "\\)")
3175                         '(2 font-lock-comment-face))
3176
3177                   (list (concat "'" "\\("
3178                                       "\\\\"
3179                                       "\\(" "[ntbr'\\]"
3180                                       "\\|" "[0-9][0-9][0-9]"
3181                                       "\\|" "u" "[0-9a-fA-F]\\{4\\}"
3182                                       "\\|" "U" "[0-9a-fA-F]\\{8\\}"
3183                                       "\\)"
3184                                     "\\|"
3185                                     "." "\\)" "'"
3186                                 "\\|"
3187                                 "\"" "[^\"\\]*"
3188                                       "\\(" "\\\\" "\\(.\\|\n\\)"
3189                                             "[^\"\\]*" "\\)*"
3190                                 "\\(\"\\|\\'\\)")
3191                         '(0 font-lock-string-face))
3192
3193                   (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
3194                                 "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
3195                                 "\\|"
3196                                 "\\_<\\(" fsharp-keywords "\\)\\_>")
3197                         '(0 font-lock-keyword-face))
3198                   (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
3199                         '(0 font-lock-variable-name-face))
3200
3201                   (list (concat "\\_<"
3202                                 "\\(" "0[bB][01]+" "\\|"
3203                                       "0[oO][0-7]+" "\\|"
3204                                       "0[xX][0-9a-fA-F]+" "\\)"
3205                                 "\\(" "lf\\|LF" "\\|"
3206                                       "[uU]?[ysnlL]?" "\\)"
3207                                 "\\|"
3208                                 "\\_<"
3209                                 "[0-9]+" "\\("
3210                                   "[mMQRZING]"
3211                                   "\\|"
3212                                   "\\(\\.[0-9]*\\)?"
3213                                   "\\([eE][-+]?[0-9]+\\)?"
3214                                   "[fFmM]?"
3215                                   "\\|"
3216                                   "[uU]?[ysnlL]?"
3217                                 "\\)")
3218                         '(0 mdw-number-face))
3219
3220                   (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3221                         '(0 mdw-punct-face))))))
3222
3223 (defun mdw-fontify-inferior-fsharp ()
3224   (mdw-fontify-fsharp)
3225   (setq font-lock-keywords
3226           (append (list (list "^[#-]" '(0 font-lock-comment-face))
3227                         (list "^>" '(0 font-lock-keyword-face)))
3228                   font-lock-keywords)))
3229
3230 (progn
3231   (add-hook 'fsharp-mode-hook 'mdw-misc-mode-config t)
3232   (add-hook 'fsharp-mode-hook 'mdw-fontify-fsharp t)
3233   (add-hook 'inferior-fsharp-mode-hooks 'mdw-fontify-inferior-fsharp t))
3234
3235 ;;;--------------------------------------------------------------------------
3236 ;;; Go programming configuration.
3237
3238 (defun mdw-fontify-go ()
3239
3240   (make-local-variable 'font-lock-keywords)
3241   (let ((go-keywords
3242          (mdw-regexps "break" "case" "chan" "const" "continue"
3243                       "default" "defer" "else" "fallthrough" "for"
3244                       "func" "go" "goto" "if" "import"
3245                       "interface" "map" "package" "range" "return"
3246                       "select" "struct" "switch" "type" "var"))
3247         (go-intrinsics
3248          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
3249                       "float32" "float64" "int" "uint8" "int16" "int32"
3250                       "int64" "rune" "string" "uint" "uint8" "uint16"
3251                       "uint32" "uint64" "uintptr" "void"
3252                       "false" "iota" "nil" "true"
3253                       "init" "main"
3254                       "append" "cap" "copy" "delete" "imag" "len" "make"
3255                       "new" "panic" "real" "recover")))
3256
3257     (setq font-lock-keywords
3258             (list
3259
3260              ;; Handle the keywords defined above.
3261              (list (concat "\\<\\(" go-keywords "\\)\\>")
3262                    '(0 font-lock-keyword-face))
3263              (list (concat "\\<\\(" go-intrinsics "\\)\\>")
3264                    '(0 font-lock-variable-name-face))
3265
3266              ;; Strings and characters.
3267              (list (concat "'"
3268                            "\\(" "[^\\']" "\\|"
3269                                  "\\\\"
3270                                  "\\(" "[abfnrtv\\'\"]" "\\|"
3271                                        "[0-7]\\{3\\}" "\\|"
3272                                        "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
3273                                        "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
3274                                        "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
3275                            "'"
3276                            "\\|"
3277                            "\""
3278                            "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
3279                            "\\(\"\\|$\\)"
3280                            "\\|"
3281                            "`" "[^`]+" "`")
3282                    '(0 font-lock-string-face))
3283
3284              ;; Handle numbers too.
3285              ;;
3286              ;; The following isn't quite right, but it's close enough.
3287              (list (concat "\\<\\("
3288                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3289                            "[0-9]+\\(\\.[0-9]*\\)?"
3290                            "\\([eE][-+]?[0-9]+\\)?\\)")
3291                    '(0 mdw-number-face))
3292
3293              ;; And anything else is punctuation.
3294              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3295                    '(0 mdw-punct-face))))))
3296 (progn
3297   (add-hook 'go-mode-hook 'mdw-misc-mode-config t)
3298   (add-hook 'go-mode-hook 'mdw-fontify-go t))
3299
3300 ;;;--------------------------------------------------------------------------
3301 ;;; Rust programming configuration.
3302
3303 (setq-default rust-indent-offset 2)
3304
3305 (defun mdw-self-insert-and-indent (count)
3306   (interactive "p")
3307   (self-insert-command count)
3308   (indent-according-to-mode))
3309
3310 (defun mdw-fontify-rust ()
3311
3312   ;; Hack syntax categories.
3313   (modify-syntax-entry ?$ ".")
3314   (modify-syntax-entry ?% ".")
3315   (modify-syntax-entry ?= ".")
3316
3317   ;; Fontify keywords and things.
3318   (make-local-variable 'font-lock-keywords)
3319   (let ((rust-keywords
3320          (mdw-regexps "abstract" "alignof" "as" "async" "await"
3321                       "become" "box" "break"
3322                       "const" "continue" "crate"
3323                       "do" "dyn"
3324                       "else" "enum" "extern"
3325                       "final" "fn" "for"
3326                       "if" "impl" "in"
3327                       "let" "loop"
3328                       "macro" "match" "mod" "move" "mut"
3329                       "offsetof" "override"
3330                       "priv" "proc" "pub" "pure"
3331                       "ref" "return"
3332                       "sizeof" "static" "struct" "super"
3333                       "trait" "try" "type" "typeof"
3334                       "union" "unsafe" "unsized" "use"
3335                       "virtual"
3336                       "where" "while"
3337                       "yield"))
3338         (rust-builtins
3339          (mdw-regexps "array" "pointer" "slice" "tuple"
3340                       "bool" "true" "false"
3341                       "f32" "f64"
3342                       "i8" "i16" "i32" "i64" "isize"
3343                       "u8" "u16" "u32" "u64" "usize"
3344                       "char" "str"
3345                       "self" "Self")))
3346     (setq font-lock-keywords
3347             (list
3348
3349              ;; Handle the keywords defined above.
3350              (list (concat "\\_<\\(" rust-keywords "\\)\\_>")
3351                    '(0 font-lock-keyword-face))
3352              (list (concat "\\_<\\(" rust-builtins "\\)\\_>")
3353                    '(0 font-lock-variable-name-face))
3354
3355              ;; Handle numbers too.
3356              (list (concat "\\_<\\("
3357                                  "[0-9][0-9_]*"
3358                                  "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
3359                                  "\\|" "\\.[0-9_]+"
3360                                  "\\)"
3361                                  "\\(f32\\|f64\\)?"
3362                            "\\|" "\\(" "[0-9][0-9_]*"
3363                                  "\\|" "0x[0-9a-fA-F_]+"
3364                                  "\\|" "0o[0-7_]+"
3365                                  "\\|" "0b[01_]+"
3366                                  "\\)"
3367                                  "\\([ui]\\(8\\|16\\|32\\|64\\|size\\)\\)?"
3368                            "\\)\\_>")
3369                    '(0 mdw-number-face))
3370
3371              ;; And anything else is punctuation.
3372              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3373                    '(0 mdw-punct-face)))
3374             font-lock-syntactic-face-function nil))
3375
3376   ;; Hack key bindings.
3377   (local-set-key [?{] 'mdw-self-insert-and-indent)
3378   (local-set-key [?}] 'mdw-self-insert-and-indent))
3379
3380 (progn
3381   (add-hook 'rust-mode-hook 'mdw-misc-mode-config t)
3382   (add-hook 'rust-mode-hook 'mdw-fontify-rust t))
3383
3384 ;;;--------------------------------------------------------------------------
3385 ;;; Awk programming configuration.
3386
3387 ;; Make Awk indentation nice.
3388
3389 (mdw-define-c-style mdw-awk ()
3390   (c-basic-offset . 2)
3391   (c-offsets-alist (substatement-open . 0)
3392                    (c-backslash-column . 72)
3393                    (statement-cont . 0)
3394                    (statement-case-intro . +)))
3395 (mdw-set-default-c-style 'awk-mode 'mdw-awk)
3396
3397 ;; Declare Awk fontification style.
3398
3399 (defun mdw-fontify-awk ()
3400
3401   ;; Miscellaneous fiddling.
3402   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3403
3404   ;; Now define things to be fontified.
3405   (make-local-variable 'font-lock-keywords)
3406   (let ((c-keywords
3407          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
3408                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
3409                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
3410                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
3411                       "atan2" "break" "close" "continue" "cos" "delete"
3412                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
3413                       "function" "gensub" "getline" "gsub" "if" "in"
3414                       "index" "int" "length" "log" "match" "next" "rand"
3415                       "return" "print" "printf" "sin" "split" "sprintf"
3416                       "sqrt" "srand" "strftime" "sub" "substr" "system"
3417                       "systime" "tolower" "toupper" "while")))
3418
3419     (setq font-lock-keywords
3420             (list
3421
3422              ;; Handle the keywords defined above.
3423              (list (concat "\\<\\(" c-keywords "\\)\\>")
3424                    '(0 font-lock-keyword-face))
3425
3426              ;; Handle numbers too.
3427              ;;
3428              ;; The following isn't quite right, but it's close enough.
3429              (list (concat "\\<\\("
3430                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3431                            "[0-9]+\\(\\.[0-9]*\\)?"
3432                            "\\([eE][-+]?[0-9]+\\)?\\)"
3433                            "[uUlL]*")
3434                    '(0 mdw-number-face))
3435
3436              ;; And anything else is punctuation.
3437              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3438                    '(0 mdw-punct-face))))))
3439
3440 (progn
3441   (add-hook 'awk-mode-hook 'mdw-misc-mode-config t)
3442   (add-hook 'awk-mode-hook 'mdw-fontify-awk t))
3443
3444 ;;;--------------------------------------------------------------------------
3445 ;;; Perl programming style.
3446
3447 ;; Perl indentation style.
3448
3449 (setq-default perl-indent-level 2)
3450
3451 (setq-default cperl-indent-level 2
3452               cperl-continued-statement-offset 2
3453               cperl-indent-region-fix-constructs nil
3454               cperl-continued-brace-offset 0
3455               cperl-brace-offset -2
3456               cperl-brace-imaginary-offset 0
3457               cperl-label-offset 0)
3458
3459 ;; Define perl fontification style.
3460
3461 (defun mdw-fontify-perl ()
3462
3463   ;; Miscellaneous fiddling.
3464   (modify-syntax-entry ?$ "\\")
3465   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
3466   (modify-syntax-entry ?: "." font-lock-syntax-table)
3467   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3468   (setq auto-fill-function #'do-auto-fill)
3469
3470   ;; Now define fontification things.
3471   (make-local-variable 'font-lock-keywords)
3472   (let ((perl-keywords
3473          (mdw-regexps "and"
3474                       "break"
3475                       "cmp" "continue"
3476                       "default" "do"
3477                       "else" "elsif" "eq"
3478                       "for" "foreach"
3479                       "ge" "given" "gt" "goto"
3480                       "if"
3481                       "last" "le" "local" "lt"
3482                       "my"
3483                       "ne" "next"
3484                       "or" "our"
3485                       "package"
3486                       "redo" "require" "return"
3487                       "sub"
3488                       "undef" "unless" "until" "use"
3489                       "when" "while")))
3490
3491     (setq font-lock-keywords
3492             (list
3493
3494              ;; Set up the keywords defined above.
3495              (list (concat "\\<\\(" perl-keywords "\\)\\>")
3496                    '(0 font-lock-keyword-face))
3497
3498              ;; At least numbers are simpler than C.
3499              (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3500                            "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
3501                            "\\([eE][-+]?[0-9_]+\\)?")
3502                    '(0 mdw-number-face))
3503
3504              ;; And anything else is punctuation.
3505              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3506                    '(0 mdw-punct-face))))))
3507
3508 (defun perl-number-tests (&optional arg)
3509   "Assign consecutive numbers to lines containing `#t'.  With ARG,
3510 strip numbers instead."
3511   (interactive "P")
3512   (save-excursion
3513     (goto-char (point-min))
3514     (let ((i 0) (fmt (if arg "" " %4d")))
3515       (while (search-forward "#t" nil t)
3516         (delete-region (point) (line-end-position))
3517         (setq i (1+ i))
3518         (insert (format fmt i)))
3519       (goto-char (point-min))
3520       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
3521           (replace-match (format "\\1%d" i))))))
3522
3523 (dolist (hook '(perl-mode-hook cperl-mode-hook))
3524   (add-hook hook 'mdw-misc-mode-config t)
3525   (add-hook hook 'mdw-fontify-perl t))
3526
3527 ;;;--------------------------------------------------------------------------
3528 ;;; Python programming style.
3529
3530 (setq-default py-indent-offset 2
3531               python-indent 2
3532               python-indent-offset 2
3533               python-fill-docstring-style 'symmetric)
3534
3535 (defun mdw-fontify-pythonic (keywords soft-keywords builtins)
3536
3537   ;; Miscellaneous fiddling.
3538   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3539   (setq indent-tabs-mode nil)
3540   (set (make-local-variable 'forward-sexp-function) nil)
3541
3542   ;; Now define fontification things.
3543   (make-local-variable 'font-lock-keywords)
3544   (setq font-lock-keywords
3545           (list
3546
3547            ;; Set up the keywords defined above.
3548            (list (concat "\\_<\\(" keywords "\\)\\_>")
3549                  '(0 font-lock-keyword-face))
3550            (list (concat "\\(^\\|[^.]\\)\\_<\\(" soft-keywords "\\)\\_>")
3551                  '(2 font-lock-keyword-face))
3552            (list (concat "\\(^\\|[^.]\\)\\_<\\(" builtins "\\)\\_>")
3553                  '(2 font-lock-variable-name-face))
3554            (list (concat "\\_<\\(__\\(\\sw+\\|\\s_+\\)+__\\)\\_>")
3555                  '(0 font-lock-variable-name-face))
3556
3557            ;; At least numbers are simpler than C.
3558            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO]?[0-7]+\\|[bB][01]+\\)\\|"
3559                          "\\_<[0-9][0-9]*\\(\\.[0-9]*\\)?"
3560                          "\\([eE][-+]?[0-9]+\\|[lL]\\)?")
3561                  '(0 mdw-number-face))
3562
3563            ;; And anything else is punctuation.
3564            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3565                  '(0 mdw-punct-face)))))
3566
3567 ;; Define Python fontification styles.
3568
3569 (defun mdw-fontify-python ()
3570   (mdw-fontify-pythonic
3571    (mdw-regexps "and" "as" "assert" "async" "await"
3572                 "break"
3573                 "class" "continue"
3574                 "def" "del"
3575                 "elif" "else" "except" ;"exec"
3576                 "finally" "for" "from"
3577                 "global"
3578                 "if" "import" "in" "is"
3579                 "lambda"
3580                 "nonlocal"
3581                 "not"
3582                 "or"
3583                 "pass" ;"print"
3584                 "raise" "return"
3585                 "try" ;"type"
3586                 "while" "with"
3587                 "yield")
3588
3589    (mdw-regexps "case"
3590                 "match")
3591
3592    (mdw-regexps "Ellipsis"
3593                 "False"
3594                 "None" "NotImplemented"
3595                 "True"
3596                 "__debug__"
3597
3598                 "BaseException"
3599                   "BaseExceptionGroup"
3600                   "Exception"
3601                     "StandardError"
3602                       "ArithmeticError"
3603                         "FloatingPointError"
3604                         "OverflowError"
3605                         "ZeroDivisionError"
3606                       "AssertionError"
3607                       "AttributeError"
3608                       "BufferError"
3609                       "EnvironmentError"
3610                         "IOError"
3611                         "OSError"
3612                           "BlockingIOError"
3613                           "ChildProcessError"
3614                           "ConnectionError"
3615                             "BrokenPipeError"
3616                             "ConnectionAbortedError"
3617                             "ConnectionRefusedError"
3618                             "ConnectionResetError"
3619                           "FileExistsError"
3620                           "FileNotFoundError"
3621                           "InterruptedError"
3622                           "IsADirectoryError"
3623                           "NotADirectoryError"
3624                           "PermissionError"
3625                           "TimeoutError"
3626                       "EOFError"
3627                       "ExceptionGroup"
3628                       "ImportError"
3629                         "ModuleNotFoundError"
3630                       "LookupError"
3631                         "IndexError"
3632                         "KeyError"
3633                       "MemoryError"
3634                       "NameError"
3635                         "UnboundLocalError"
3636                       "ReferenceError"
3637                       "RuntimeError"
3638                         "NotImplementedError"
3639                         "RecursionError"
3640                       "SyntaxError"
3641                         "IndentationError"
3642                           "TabError"
3643                       "SystemError"
3644                       "TypeError"
3645                       "ValueError"
3646                         "UnicodeError"
3647                           "UnicodeDecodeError"
3648                           "UnicodeEncodeError"
3649                           "UnicodeTranslateError"
3650                     "StopIteration"
3651                     "Warning"
3652                       "BytesWarning"
3653                       "DeprecationWarning"
3654                       "EncodingWarning"
3655                       "FutureWarning"
3656                       "ImportWarning"
3657                       "PendingDeprecationWarning"
3658                       "ResourceWarning"
3659                       "RuntimeWarning"
3660                       "SyntaxWarning"
3661                       "UnicodeWarning"
3662                       "UserWarning"
3663                   "GeneratorExit"
3664                   "KeyboardInterrupt"
3665                   "SystemExit"
3666
3667                 "abs" "absolute_import" "aiter"
3668                   "all" "anext" "any" "apply" "ascii"
3669                 "basestring" "bin" "bool" "breakpoint"
3670                   "buffer" "bytearray" "bytes"
3671                 "callable" "coerce" "chr" "classmethod"
3672                   "cmp" "compile" "complex"
3673                 "delattr" "dict" "dir" "divmod"
3674                 "enumerate" "eval" "exec" "execfile"
3675                 "file" "filter" "float" "format" "frozenset"
3676                 "getattr" "globals"
3677                 "hasattr" "hash" "help" "hex"
3678                 "id" "input" "int" "intern"
3679                   "isinstance" "issubclass" "iter"
3680                 "len" "list" "locals" "long"
3681                 "map" "max" "memoryview" "min"
3682                 "next"
3683                 "object" "oct" "open" "ord"
3684                 "pow" "print" "property"
3685                 "range" "raw_input" "reduce" "reload"
3686                   "repr" "reversed" "round"
3687                 "set" "setattr" "slice" "sorted"
3688                   "staticmethod" "str" "sum" "super"
3689                 "tuple" "type"
3690                 "unichr" "unicode"
3691                 "vars"
3692                 "xrange"
3693                 "zip"
3694                 "__import__")))
3695
3696 (defun mdw-fontify-pyrex ()
3697   (mdw-fontify-pythonic
3698    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
3699                 "ctypedef" "def" "del" "elif" "else" "enum" "except" "exec"
3700                 "extern" "finally" "for" "from" "global" "if"
3701                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
3702                 "property" "raise" "return" "struct" "try" "while" "with"
3703                 "yield")
3704    ""
3705    ""))
3706
3707 (define-derived-mode pyrex-mode python-mode "Pyrex"
3708   "Major mode for editing Pyrex source code")
3709 (setq auto-mode-alist
3710         (append '(("\\.pyx$" . pyrex-mode)
3711                   ("\\.pxd$" . pyrex-mode)
3712                   ("\\.pxi$" . pyrex-mode))
3713                 auto-mode-alist))
3714
3715 (progn
3716   (add-hook 'python-mode-hook 'mdw-misc-mode-config t)
3717   (add-hook 'python-mode-hook 'mdw-fontify-python t)
3718   (add-hook 'pyrex-mode-hook 'mdw-fontify-pyrex t))
3719
3720 ;;;--------------------------------------------------------------------------
3721 ;;; Lua programming style.
3722
3723 (setq-default lua-indent-level 2)
3724
3725 (defun mdw-fontify-lua ()
3726
3727   ;; Miscellaneous fiddling.
3728   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3729
3730   ;; Now define fontification things.
3731   (make-local-variable 'font-lock-keywords)
3732   (let ((lua-keywords
3733          (mdw-regexps "and" "break" "do" "else" "elseif" "end"
3734                       "false" "for" "function" "goto" "if" "in" "local"
3735                       "nil" "not" "or" "repeat" "return" "then" "true"
3736                       "until" "while")))
3737     (setq font-lock-keywords
3738             (list
3739
3740              ;; Set up the keywords defined above.
3741              (list (concat "\\_<\\(" lua-keywords "\\)\\_>")
3742                    '(0 font-lock-keyword-face))
3743
3744              ;; At least numbers are simpler than C.
3745              (list (concat "\\_<\\(" "0[xX]"
3746                                      "\\(" "[0-9a-fA-F]+"
3747                                            "\\(\\.[0-9a-fA-F]*\\)?"
3748                                      "\\|" "\\.[0-9a-fA-F]+"
3749                                      "\\)"
3750                                      "\\([pP][-+]?[0-9]+\\)?"
3751                                "\\|" "\\(" "[0-9]+"
3752                                            "\\(\\.[0-9]*\\)?"
3753                                      "\\|" "\\.[0-9]+"
3754                                      "\\)"
3755                                      "\\([eE][-+]?[0-9]+\\)?"
3756                                "\\)")
3757                    '(0 mdw-number-face))
3758
3759              ;; And anything else is punctuation.
3760              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3761                    '(0 mdw-punct-face))))))
3762
3763 (progn
3764   (add-hook 'lua-mode-hook 'mdw-misc-mode-config t)
3765   (add-hook 'lua-mode-hook 'mdw-fontify-lua t))
3766
3767 ;;;--------------------------------------------------------------------------
3768 ;;; Icon programming style.
3769
3770 ;; Icon indentation style.
3771
3772 (setq-default icon-brace-offset 0
3773               icon-continued-brace-offset 0
3774               icon-continued-statement-offset 2
3775               icon-indent-level 2)
3776
3777 ;; Define Icon fontification style.
3778
3779 (defun mdw-fontify-icon ()
3780
3781   ;; Miscellaneous fiddling.
3782   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3783
3784   ;; Now define fontification things.
3785   (make-local-variable 'font-lock-keywords)
3786   (let ((icon-keywords
3787          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
3788                       "end" "every" "fail" "global" "if" "initial"
3789                       "invocable" "link" "local" "next" "not" "of"
3790                       "procedure" "record" "repeat" "return" "static"
3791                       "suspend" "then" "to" "until" "while"))
3792         (preprocessor-keywords
3793          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
3794                       "include" "line" "undef")))
3795     (setq font-lock-keywords
3796             (list
3797
3798              ;; Set up the keywords defined above.
3799              (list (concat "\\<\\(" icon-keywords "\\)\\>")
3800                    '(0 font-lock-keyword-face))
3801
3802              ;; The things that Icon calls keywords.
3803              (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
3804
3805              ;; At least numbers are simpler than C.
3806              (list (concat "\\<[0-9]+"
3807                            "\\([rR][0-9a-zA-Z]+\\|"
3808                            "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
3809                            "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
3810                    '(0 mdw-number-face))
3811
3812              ;; Preprocessor.
3813              (list (concat "^[ \t]*$[ \t]*\\<\\("
3814                            preprocessor-keywords
3815                            "\\)\\>")
3816                    '(0 font-lock-keyword-face))
3817
3818              ;; And anything else is punctuation.
3819              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3820                    '(0 mdw-punct-face))))))
3821
3822 (progn
3823   (add-hook 'icon-mode-hook 'mdw-misc-mode-config t)
3824   (add-hook 'icon-mode-hook 'mdw-fontify-icon t))
3825
3826 ;;;--------------------------------------------------------------------------
3827 ;;; Fortran mode.
3828
3829 (defun mdw-fontify-fortran-common ()
3830   (let ((fortran-keywords
3831          (mdw-regexps "access"
3832                       "assign"
3833                       "associate"
3834                       "backspace"
3835                       "blank"
3836                       "block\\s-*data"
3837                       "call"
3838                       "case"
3839                       "character"
3840                       "class"
3841                       "close"
3842                       "common"
3843                       "complex"
3844                       "continue"
3845                       "critical"
3846                       "data"
3847                       "dimension"
3848                       "do"
3849                       "double\\s-*precision"
3850                       "else" "elseif" "elsewhere"
3851                       "end"
3852                         "endblock" "endblockdata"
3853                         "endcritical"
3854                         "enddo"
3855                         "endinterface"
3856                         "endmodule"
3857                         "endprocedure"
3858                         "endprogram"
3859                         "endselect"
3860                         "endsubmodule"
3861                         "endsubroutine"
3862                         "endtype"
3863                         "endwhere"
3864                         "endenum"
3865                         "end\\s-*file"
3866                         "endforall"
3867                         "endfunction"
3868                         "endif"
3869                       "entry"
3870                       "enum"
3871                       "equivalence"
3872                       "err"
3873                       "external"
3874                       "file"
3875                       "fmt"
3876                       "forall"
3877                       "form"
3878                       "format"
3879                       "function"
3880                       "go\\s-*to"
3881                       "if"
3882                       "implicit"
3883                       "in" "inout"
3884                       "inquire"
3885                       "include"
3886                       "integer"
3887                       "interface"
3888                       "intrinsic"
3889                       "iostat"
3890                       "len"
3891                       "logical"
3892                       "module"
3893                       "open"
3894                       "out"
3895                       "parameter"
3896                       "pause"
3897                       "procedure"
3898                       "program"
3899                       "precision"
3900                       "program"
3901                       "read"
3902                       "real"
3903                       "rec"
3904                       "recl"
3905                       "return"
3906                       "rewind"
3907                       "save"
3908                       "select" "selectcase" "selecttype"
3909                       "status"
3910                       "stop"
3911                       "submodule"
3912                       "subroutine"
3913                       "then"
3914                       "to"
3915                       "type"
3916                       "unit"
3917                       "where"
3918                       "write"))
3919         (fortran-operators (mdw-regexps "and"
3920                                         "eq"
3921                                         "eqv"
3922                                         "false"
3923                                         "ge"
3924                                         "gt"
3925                                         "le"
3926                                         "lt"
3927                                         "ne"
3928                                         "neqv"
3929                                         "not"
3930                                         "or"
3931                                         "true"))
3932         (fortran-intrinsics (mdw-regexps "abs" "dabs" "iabs" "cabs"
3933                                          "atan" "datan" "atan2" "datan2"
3934                                          "cmplx"
3935                                          "conjg"
3936                                          "cos" "dcos" "ccos"
3937                                          "dble"
3938                                          "dim" "idim"
3939                                          "exp" "dexp" "cexp"
3940                                          "float"
3941                                          "ifix"
3942                                          "aimag"
3943                                          "int" "aint" "idint"
3944                                          "alog" "dlog" "clog"
3945                                          "alog10" "dlog10"
3946                                          "max"
3947                                          "amax0" "amax1"
3948                                          "max0" "max1"
3949                                          "dmax1"
3950                                          "min"
3951                                          "amin0" "amin1"
3952                                          "min0" "min1"
3953                                          "dmin1"
3954                                          "mod" "amod" "dmod"
3955                                          "sin" "dsin" "csin"
3956                                          "sign" "isign" "dsign"
3957                                          "sngl"
3958                                          "sqrt" "dsqrt" "csqrt"
3959                                          "tanh"))
3960         (preprocessor-keywords
3961          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3962                       "ident" "if" "ifdef" "ifndef" "import" "include"
3963                       "line" "pragma" "unassert" "undef" "warning")))
3964     (setq font-lock-keywords-case-fold-search t
3965             font-lock-keywords
3966             (list
3967
3968              ;; Fontify include files as strings.
3969              (list (concat "^[ \t]*\\#[ \t]*" "include"
3970                            "[ \t]*\\(<[^>]+>?\\)")
3971                    '(1 font-lock-string-face))
3972
3973              ;; Preprocessor directives are `references'?.
3974              (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3975                            preprocessor-keywords
3976                            "\\)\\>\\|[0-9]+\\|$\\)\\)")
3977                    '(1 font-lock-keyword-face))
3978
3979              ;; Set up the keywords defined above.
3980              (list (concat "\\<\\(" fortran-keywords "\\)\\>")
3981                    '(0 font-lock-keyword-face))
3982
3983              ;; Set up the `.foo.' operators.
3984              (list (concat "\\.\\(" fortran-operators "\\)\\.")
3985                    '(0 font-lock-keyword-face))
3986
3987              ;; Set up the intrinsic functions.
3988              (list (concat "\\<\\(" fortran-intrinsics "\\)\\>")
3989                    '(0 font-lock-variable-name-face))
3990
3991              ;; Numbers.
3992              (list (concat       "\\(" "\\<" "[0-9]+" "\\(\\.[0-9]*\\)?"
3993                                  "\\|" "\\.[0-9]+"
3994                                  "\\)"
3995                                  "\\(" "[de]" "[+-]?" "[0-9]+" "\\)?"
3996                                  "\\(" "_" "\\sw+" "\\)?"
3997                            "\\|" "b'[01]*'" "\\|" "'[01]*'b"
3998                            "\\|" "b\"[01]*\"" "\\|" "\"[01]*\"b"
3999                            "\\|" "o'[0-7]*'" "\\|" "'[0-7]*'o"
4000                            "\\|" "o\"[0-7]*\"" "\\|" "\"[0-7]*\"o"
4001                            "\\|" "[xz]'[0-9a-f]*'" "\\|" "'[0-9a-f]*'[xz]"
4002                            "\\|" "[xz]\"[0-9a-f]*\"" "\\|" "\"[0-9a-f]*\"[xz]")
4003                    '(0 mdw-number-face))
4004
4005              ;; Any anything else is punctuation.
4006              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4007                    '(0 mdw-punct-face))))
4008
4009     (modify-syntax-entry ?/ "." font-lock-syntax-table)
4010     (modify-syntax-entry ?< ".")
4011     (modify-syntax-entry ?> ".")))
4012
4013 (defun mdw-fontify-fortran () (mdw-fontify-fortran-common))
4014 (defun mdw-fontify-f90 () (mdw-fontify-fortran-common))
4015
4016 (setq fortran-do-indent 2
4017       fortran-if-indent 2
4018       fortran-structure-indent 2
4019       fortran-comment-line-start "*"
4020       fortran-comment-indent-style 'relative
4021       fortran-continuation-string "&"
4022       fortran-continuation-indent 4)
4023
4024 (setq f90-do-indent 2
4025       f90-if-indent 2
4026       f90-program-indent 2
4027       f90-continuation-indent 4
4028       f90-smart-end-names nil
4029       f90-smart-end 'no-blink)
4030
4031 (progn
4032   (add-hook 'fortran-mode-hook 'mdw-misc-mode-config t)
4033   (add-hook 'fortran-mode-hook 'mdw-fontify-fortran t)
4034   (add-hook 'f90-mode-hook 'mdw-misc-mode-config t)
4035   (add-hook 'f90-mode-hook 'mdw-fontify-f90 t))
4036
4037 ;;;--------------------------------------------------------------------------
4038 ;;; Assembler mode.
4039
4040 (defun mdw-fontify-asm ()
4041   (modify-syntax-entry ?' "\"")
4042   (modify-syntax-entry ?. "w")
4043   (modify-syntax-entry ?\n ">")
4044   (setf fill-prefix nil)
4045   (modify-syntax-entry ?. "_")
4046   (modify-syntax-entry ?* ". 23")
4047   (modify-syntax-entry ?/ ". 124b")
4048   (modify-syntax-entry ?\n "> b")
4049   (local-set-key ";" 'self-insert-command)
4050   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
4051
4052 (defun mdw-asm-set-comment ()
4053   (modify-syntax-entry ?; "."
4054                        )
4055   (modify-syntax-entry asm-comment-char "< b")
4056   (setq comment-start (string asm-comment-char ? )))
4057 (add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
4058 (put 'asm-comment-char 'safe-local-variable 'characterp)
4059
4060 (progn
4061   (add-hook 'asm-mode-hook 'mdw-misc-mode-config t)
4062   (add-hook 'asm-mode-hook 'mdw-fontify-asm t))
4063
4064 ;;;--------------------------------------------------------------------------
4065 ;;; TCL configuration.
4066
4067 (setq-default tcl-indent-level 2)
4068
4069 (defun mdw-fontify-tcl ()
4070   (dolist (ch '(?$))
4071     (modify-syntax-entry ch "."))
4072   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
4073   (make-local-variable 'font-lock-keywords)
4074   (setq font-lock-keywords
4075           (list
4076            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
4077                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
4078                          "\\([eE][-+]?[0-9_]+\\)?")
4079                  '(0 mdw-number-face))
4080            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4081                  '(0 mdw-punct-face)))))
4082
4083 (progn
4084   (add-hook 'tcl-mode-hook 'mdw-misc-mode-config t)
4085   (add-hook 'tcl-mode-hook 'mdw-fontify-tcl t))
4086
4087 ;;;--------------------------------------------------------------------------
4088 ;;; Dylan programming configuration.
4089
4090 (defun mdw-fontify-dylan ()
4091
4092   (make-local-variable 'font-lock-keywords)
4093
4094   ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
4095   ;; hook, which undoes all of our configuration.
4096   (setq major-mode 'dylan-mode)
4097   (font-lock-set-defaults)
4098
4099   (let* ((word "[-_a-zA-Z!*@<>$%]+")
4100          (dylan-keywords (mdw-regexps
4101
4102                           "C-address" "C-callable-wrapper" "C-function"
4103                           "C-mapped-subtype" "C-pointer-type" "C-struct"
4104                           "C-subtype" "C-union" "C-variable"
4105
4106                           "above" "abstract" "afterwards" "all"
4107                           "begin" "below" "block" "by"
4108                           "case" "class" "cleanup" "constant" "create"
4109                           "define" "domain"
4110                           "else" "elseif" "end" "exception" "export"
4111                           "finally" "for" "from" "function"
4112                           "generic"
4113                           "handler"
4114                           "if" "in" "instance" "interface" "iterate"
4115                           "keyed-by"
4116                           "let" "library" "local"
4117                           "macro" "method" "module"
4118                           "otherwise"
4119                           "profiling"
4120                           "select" "slot" "subclass"
4121                           "table" "then" "to"
4122                           "unless" "until" "use"
4123                           "variable" "virtual"
4124                           "when" "while"))
4125          (sharp-keywords (mdw-regexps
4126                           "all-keys" "key" "next" "rest" "include"
4127                           "t" "f")))
4128     (setq font-lock-keywords
4129             (list (list (concat "\\<\\(" dylan-keywords
4130                                 "\\|" "with\\(out\\)?-" word
4131                                 "\\)\\>")
4132                         '(0 font-lock-keyword-face))
4133                   (list (concat "\\<" word ":" "\\|"
4134                                 "#\\(" sharp-keywords "\\)\\>")
4135                         '(0 font-lock-variable-name-face))
4136                   (list (concat "\\("
4137                                 "\\([-+]\\|\\<\\)[0-9]+" "\\("
4138                                   "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
4139                                   "\\|" "/[0-9]+"
4140                                 "\\)"
4141                                 "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
4142                                 "\\|" "#b[01]+"
4143                                 "\\|" "#o[0-7]+"
4144                                 "\\|" "#x[0-9a-zA-Z]+"
4145                                 "\\)\\>")
4146                         '(0 mdw-number-face))
4147                   (list (concat "\\("
4148                                 "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
4149                                 "\\_<[-+*/=<>:&|]+\\_>"
4150                                 "\\)")
4151                         '(0 mdw-punct-face))))))
4152
4153 (progn
4154   (add-hook 'dylan-mode-hook 'mdw-misc-mode-config t)
4155   (add-hook 'dylan-mode-hook 'mdw-fontify-dylan t))
4156
4157 ;;;--------------------------------------------------------------------------
4158 ;;; Algol 68 configuration.
4159
4160 (setq-default a68-indent-step 2)
4161
4162 (defun mdw-fontify-algol-68 ()
4163
4164   ;; Fix up the syntax table.
4165   (modify-syntax-entry ?# "!" a68-mode-syntax-table)
4166   (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
4167     (modify-syntax-entry ch "." a68-mode-syntax-table))
4168
4169   (make-local-variable 'font-lock-keywords)
4170
4171   (let ((not-comment
4172          (let ((word "COMMENT"))
4173            (cl-do ((regexp (concat "[^" (substring word 0 1) "]+")
4174                            (concat regexp "\\|"
4175                                    (substring word 0 i)
4176                                    "[^" (substring word i (1+ i)) "]"))
4177                    (i 1 (1+ i)))
4178                ((>= i (length word)) regexp)))))
4179     (setq font-lock-keywords
4180             (list (list (concat "\\<COMMENT\\>"
4181                                 "\\(" not-comment "\\)\\{0,5\\}"
4182                                 "\\(\\'\\|\\<COMMENT\\>\\)")
4183                         '(0 font-lock-comment-face))
4184                   (list (concat "\\<CO\\>"
4185                                 "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
4186                                 "\\($\\|\\<CO\\>\\)")
4187                         '(0 font-lock-comment-face))
4188                   (list "\\<[A-Z_]+\\>"
4189                         '(0 font-lock-keyword-face))
4190                   (list (concat "\\<"
4191                                 "[0-9]+"
4192                                 "\\(\\.[0-9]+\\)?"
4193                                 "\\([eE][-+]?[0-9]+\\)?"
4194                                 "\\>")
4195                         '(0 mdw-number-face))
4196                   (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
4197                         '(0 mdw-punct-face))))))
4198
4199 (dolist (hook '(a68-mode-hook a68-mode-hooks))
4200   (add-hook hook 'mdw-misc-mode-config t)
4201   (add-hook hook 'mdw-fontify-algol-68 t))
4202
4203 ;;;--------------------------------------------------------------------------
4204 ;;; REXX configuration.
4205
4206 (defun mdw-rexx-electric-* ()
4207   (interactive)
4208   (insert ?*)
4209   (rexx-indent-line))
4210
4211 (defun mdw-rexx-indent-newline-indent ()
4212   (interactive)
4213   (rexx-indent-line)
4214   (if abbrev-mode (expand-abbrev))
4215   (newline-and-indent))
4216
4217 (defun mdw-fontify-rexx ()
4218
4219   ;; Various bits of fiddling.
4220   (setq mdw-auto-indent nil)
4221   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
4222   (local-set-key [?*] 'mdw-rexx-electric-*)
4223   (dolist (ch '(?! ?? ?# ?@ ?$)) (modify-syntax-entry ch "w"))
4224   (dolist (ch '(?¬)) (modify-syntax-entry ch "."))
4225   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
4226
4227   ;; Set up keywords and things for fontification.
4228   (make-local-variable 'font-lock-keywords-case-fold-search)
4229   (setq font-lock-keywords-case-fold-search t)
4230
4231   (setq rexx-indent 2)
4232   (setq rexx-end-indent rexx-indent)
4233   (setq rexx-cont-indent rexx-indent)
4234
4235   (make-local-variable 'font-lock-keywords)
4236   (let ((rexx-keywords
4237          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
4238                       "else" "end" "engineering" "exit" "expose" "for"
4239                       "forever" "form" "fuzz" "if" "interpret" "iterate"
4240                       "leave" "linein" "name" "nop" "numeric" "off" "on"
4241                       "options" "otherwise" "parse" "procedure" "pull"
4242                       "push" "queue" "return" "say" "select" "signal"
4243                       "scientific" "source" "then" "trace" "to" "until"
4244                       "upper" "value" "var" "version" "when" "while"
4245                       "with"
4246
4247                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
4248                       "center" "center" "charin" "charout" "chars"
4249                       "compare" "condition" "copies" "c2d" "c2x"
4250                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
4251                       "errortext" "format" "fuzz" "insert" "lastpos"
4252                       "left" "length" "lineout" "lines" "max" "min"
4253                       "overlay" "pos" "queued" "random" "reverse" "right"
4254                       "sign" "sourceline" "space" "stream" "strip"
4255                       "substr" "subword" "symbol" "time" "translate"
4256                       "trunc" "value" "verify" "word" "wordindex"
4257                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
4258                       "x2d")))
4259
4260     (setq font-lock-keywords
4261             (list
4262
4263              ;; Set up the keywords defined above.
4264              (list (concat "\\<\\(" rexx-keywords "\\)\\>")
4265                    '(0 font-lock-keyword-face))
4266
4267              ;; Fontify all symbols the same way.
4268              (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
4269                            "[A-Za-z0-9.!?_#@$]+\\)")
4270                    '(0 font-lock-variable-name-face))
4271
4272              ;; And everything else is punctuation.
4273              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4274                    '(0 mdw-punct-face))))))
4275
4276 (progn
4277   (add-hook 'rexx-mode-hook 'mdw-misc-mode-config t)
4278   (add-hook 'rexx-mode-hook 'mdw-fontify-rexx t))
4279
4280 ;;;--------------------------------------------------------------------------
4281 ;;; Standard ML programming style.
4282
4283 (setq-default sml-nested-if-indent t
4284               sml-case-indent nil
4285               sml-indent-level 4
4286               sml-type-of-indent nil)
4287
4288 (defun mdw-fontify-sml ()
4289
4290   ;; Make underscore an honorary letter.
4291   (modify-syntax-entry ?' "w")
4292
4293   ;; Set fill prefix.
4294   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
4295
4296   ;; Now define fontification things.
4297   (make-local-variable 'font-lock-keywords)
4298   (let ((sml-keywords
4299          (mdw-regexps "abstype" "and" "andalso" "as"
4300                       "case"
4301                       "datatype" "do"
4302                       "else" "end" "eqtype" "exception"
4303                       "fn" "fun" "functor"
4304                       "handle"
4305                       "if" "in" "include" "infix" "infixr"
4306                       "let" "local"
4307                       "nonfix"
4308                       "of" "op" "open" "orelse"
4309                       "raise" "rec"
4310                       "sharing" "sig" "signature" "struct" "structure"
4311                       "then" "type"
4312                       "val"
4313                       "where" "while" "with" "withtype")))
4314
4315     (setq font-lock-keywords
4316             (list
4317
4318              ;; Set up the keywords defined above.
4319              (list (concat "\\<\\(" sml-keywords "\\)\\>")
4320                    '(0 font-lock-keyword-face))
4321
4322              ;; At least numbers are simpler than C.
4323              (list (concat "\\<\\~?"
4324                               "\\(0\\([wW]?[xX][0-9a-fA-F]+\\|"
4325                                      "[wW][0-9]+\\)\\|"
4326                                   "\\([0-9]+\\(\\.[0-9]+\\)?"
4327                                            "\\([eE]\\~?"
4328                                                   "[0-9]+\\)?\\)\\)")
4329                    '(0 mdw-number-face))
4330
4331              ;; And anything else is punctuation.
4332              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4333                    '(0 mdw-punct-face))))))
4334
4335 (progn
4336   (add-hook 'sml-mode-hook 'mdw-misc-mode-config t)
4337   (add-hook 'sml-mode-hook 'mdw-fontify-sml t))
4338
4339 ;;;--------------------------------------------------------------------------
4340 ;;; Haskell configuration.
4341
4342 (setq-default haskell-indent-offset 2)
4343 (setq haskell-doc-prettify-types nil
4344       haskell-interactive-popup-errors nil)
4345
4346 (defun mdw-fontify-haskell ()
4347
4348   ;; Fiddle with syntax table to get comments right.
4349   (modify-syntax-entry ?' "_")
4350   (modify-syntax-entry ?- ". 12")
4351   (modify-syntax-entry ?\n ">")
4352
4353   ;; Make punctuation be punctuation
4354   (let ((punct "=<>+-*/|&%!@?$.^:#`"))
4355     (cl-do ((i 0 (1+ i)))
4356         ((>= i (length punct)))
4357       (modify-syntax-entry (aref punct i) ".")))
4358
4359   ;; Set fill prefix.
4360   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
4361
4362   ;; Fiddle with fontification.
4363   (make-local-variable 'font-lock-keywords)
4364   (let ((haskell-keywords
4365          (mdw-regexps "as"
4366                       "case" "ccall" "class"
4367                       "data" "default" "deriving" "do"
4368                       "else" "exists"
4369                       "forall" "foreign"
4370                       "hiding"
4371                       "if" "import" "in" "infix" "infixl" "infixr" "instance"
4372                       "let"
4373                       "mdo" "module"
4374                       "newtype"
4375                       "of"
4376                       "proc"
4377                       "qualified"
4378                       "rec"
4379                       "safe" "stdcall"
4380                       "then" "type"
4381                       "unsafe"
4382                       "where"))
4383         (control-sequences
4384          (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
4385                       "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
4386                       "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
4387                       "SP" "STX" "SUB" "SYN" "US" "VT")))
4388
4389     (setq font-lock-keywords
4390             (list
4391              (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
4392                                 "\\(-+}\\|-*\\'\\)"
4393                            "\\|"
4394                            "--.*$")
4395                    '(0 font-lock-comment-face))
4396              (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
4397                    '(0 font-lock-keyword-face))
4398              (list (concat "'\\("
4399                            "[^\\]"
4400                            "\\|"
4401                            "\\\\"
4402                            "\\(" "[abfnrtv\\\"']" "\\|"
4403                                  "^" "\\(" control-sequences "\\|"
4404                                            "[]A-Z@[\\^_]" "\\)" "\\|"
4405                                  "\\|"
4406                                  "[0-9]+" "\\|"
4407                                  "[oO][0-7]+" "\\|"
4408                                  "[xX][0-9A-Fa-f]+"
4409                            "\\)"
4410                            "\\)'")
4411                    '(0 font-lock-string-face))
4412              (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
4413                    '(0 font-lock-variable-name-face))
4414              (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
4415                            "\\_<[0-9]+\\(\\.[0-9]*\\)?"
4416                            "\\([eE][-+]?[0-9]+\\)?")
4417                    '(0 mdw-number-face))
4418              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4419                    '(0 mdw-punct-face))))))
4420
4421 (progn
4422   (add-hook 'haskell-mode-hook 'mdw-misc-mode-config t)
4423   (add-hook 'haskell-mode-hook 'mdw-fontify-haskell t))
4424
4425 ;;;--------------------------------------------------------------------------
4426 ;;; Erlang configuration.
4427
4428 (setq-default erlang-electric-commands nil)
4429
4430 (defun mdw-fontify-erlang ()
4431
4432   ;; Set fill prefix.
4433   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
4434
4435   ;; Fiddle with fontification.
4436   (make-local-variable 'font-lock-keywords)
4437   (let ((erlang-keywords
4438          (mdw-regexps "after" "and" "andalso"
4439                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
4440                       "case" "catch" "cond"
4441                       "div" "end" "fun" "if" "let" "not"
4442                       "of" "or" "orelse"
4443                       "query" "receive" "rem" "try" "when" "xor")))
4444
4445     (setq font-lock-keywords
4446             (list
4447              (list "%.*$"
4448                    '(0 font-lock-comment-face))
4449              (list (concat "\\<\\(" erlang-keywords "\\)\\>")
4450                    '(0 font-lock-keyword-face))
4451              (list (concat "^-\\sw+\\>")
4452                    '(0 font-lock-keyword-face))
4453              (list "\\<[0-9]+\\(#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)?\\>"
4454                    '(0 mdw-number-face))
4455              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4456                    '(0 mdw-punct-face))))))
4457
4458 (progn
4459   (add-hook 'erlang-mode-hook 'mdw-misc-mode-config t)
4460   (add-hook 'erlang-mode-hook 'mdw-fontify-erlang t))
4461
4462 ;;;--------------------------------------------------------------------------
4463 ;;; Texinfo configuration.
4464
4465 (defun mdw-fontify-texinfo ()
4466
4467   ;; Set fill prefix.
4468   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
4469
4470   ;; Real fontification things.
4471   (make-local-variable 'font-lock-keywords)
4472   (setq font-lock-keywords
4473           (list
4474
4475            ;; Environment names are keywords.
4476            (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
4477                  '(2 font-lock-keyword-face))
4478
4479            ;; Unmark escaped magic characters.
4480            (list "\\(@\\)\\([@{}]\\)"
4481                  '(1 font-lock-keyword-face)
4482                  '(2 font-lock-variable-name-face))
4483
4484            ;; Make sure we get comments properly.
4485            (list "@c\\(omment\\)?\\( .*\\)?$"
4486                  '(0 font-lock-comment-face))
4487
4488            ;; Command names are keywords.
4489            (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
4490                  '(0 font-lock-keyword-face))
4491
4492            ;; Fontify TeX special characters as punctuation.
4493            (list "[{}]+"
4494                  '(0 mdw-punct-face)))))
4495
4496 (dolist (hook '(texinfo-mode-hook TeXinfo-mode-hook))
4497   (add-hook hook 'mdw-misc-mode-config t)
4498   (add-hook hook 'mdw-fontify-texinfo t))
4499
4500 ;;;--------------------------------------------------------------------------
4501 ;;; TeX and LaTeX configuration.
4502
4503 (setq-default LaTeX-table-label "tbl:"
4504               TeX-auto-untabify nil
4505               LaTeX-syntactic-comments nil
4506               LaTeX-fill-break-at-separators '(\\\[))
4507
4508 (defun mdw-fontify-tex ()
4509   (setq ispell-parser 'tex)
4510   (turn-on-reftex)
4511
4512   ;; Don't make maths into a string.
4513   (modify-syntax-entry ?$ ".")
4514   (modify-syntax-entry ?$ "." font-lock-syntax-table)
4515   (local-set-key [?$] 'self-insert-command)
4516
4517   ;; Make `tab' be useful, given that tab stops in TeX don't work well.
4518   (local-set-key "\C-\M-i" 'indent-relative)
4519   (setq indent-tabs-mode nil)
4520
4521   ;; Set fill prefix.
4522   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
4523
4524   ;; Real fontification things.
4525   (make-local-variable 'font-lock-keywords)
4526   (setq font-lock-keywords
4527           (list
4528
4529            ;; Environment names are keywords.
4530            (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
4531                          "{\\([^}\n]*\\)}")
4532                  '(2 font-lock-keyword-face))
4533
4534            ;; Suspended environment names are keywords too.
4535            (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
4536                          "{\\([^}\n]*\\)}")
4537                  '(3 font-lock-keyword-face))
4538
4539            ;; Command names are keywords.
4540            (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
4541                  '(0 font-lock-keyword-face))
4542
4543            ;; Handle @/.../ for italics.
4544            ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
4545            ;;     '(1 font-lock-keyword-face)
4546            ;;     '(3 font-lock-keyword-face))
4547
4548            ;; Handle @*...* for boldness.
4549            ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
4550            ;;     '(1 font-lock-keyword-face)
4551            ;;     '(3 font-lock-keyword-face))
4552
4553            ;; Handle @`...' for literal syntax things.
4554            ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
4555            ;;     '(1 font-lock-keyword-face)
4556            ;;     '(3 font-lock-keyword-face))
4557
4558            ;; Handle @<...> for nonterminals.
4559            ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
4560            ;;     '(1 font-lock-keyword-face)
4561            ;;     '(3 font-lock-keyword-face))
4562
4563            ;; Handle other @-commands.
4564            ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
4565            ;;     '(0 font-lock-keyword-face))
4566
4567            ;; Make sure we get comments properly.
4568            (list "%.*"
4569                  '(0 font-lock-comment-face))
4570
4571            ;; Fontify TeX special characters as punctuation.
4572            (list "[$^_{}#&]"
4573                  '(0 mdw-punct-face)))))
4574
4575 (setq TeX-install-font-lock 'tex-font-setup)
4576
4577 (eval-after-load 'font-latex
4578   '(defun font-latex-jit-lock-force-redisplay (buf start end)
4579      "Compatibility for Emacsen not offering `jit-lock-force-redisplay'."
4580      ;; The following block is an expansion of `jit-lock-force-redisplay'
4581      ;; and involved macros taken from CVS Emacs on 2007-04-28.
4582      (with-current-buffer buf
4583        (let ((modified (buffer-modified-p)))
4584          (unwind-protect
4585              (let ((buffer-undo-list t)
4586                    (inhibit-read-only t)
4587                    (inhibit-point-motion-hooks t)
4588                    (inhibit-modification-hooks t)
4589                    deactivate-mark
4590                    buffer-file-name
4591                    buffer-file-truename)
4592                (put-text-property start end 'fontified t))
4593            (unless modified
4594              (restore-buffer-modified-p nil)))))))
4595
4596 (setq TeX-output-view-style
4597         '(("^dvi$"
4598            ("^landscape$" "^pstricks$\\|^pst-\\|^psfrag$")
4599            "%(o?)dvips -t landscape %d -o && xdg-open %f")
4600           ("^dvi$" "^pstricks$\\|^pst-\\|^psfrag$"
4601            "%(o?)dvips %d -o && xdg-open %f")
4602           ("^dvi$"
4603            ("^a4\\(?:dutch\\|paper\\|wide\\)\\|sem-a4$" "^landscape$")
4604            "%(o?)xdvi %dS -paper a4r -s 0 %d")
4605           ("^dvi$" "^a4\\(?:dutch\\|paper\\|wide\\)\\|sem-a4$"
4606            "%(o?)xdvi %dS -paper a4 %d")
4607           ("^dvi$"
4608            ("^a5\\(?:comb\\|paper\\)$" "^landscape$")
4609            "%(o?)xdvi %dS -paper a5r -s 0 %d")
4610           ("^dvi$" "^a5\\(?:comb\\|paper\\)$" "%(o?)xdvi %dS -paper a5 %d")
4611           ("^dvi$" "^b5paper$" "%(o?)xdvi %dS -paper b5 %d")
4612           ("^dvi$" "^letterpaper$" "%(o?)xdvi %dS -paper us %d")
4613           ("^dvi$" "^legalpaper$" "%(o?)xdvi %dS -paper legal %d")
4614           ("^dvi$" "^executivepaper$" "%(o?)xdvi %dS -paper 7.25x10.5in %d")
4615           ("^dvi$" "." "%(o?)xdvi %dS %d")
4616           ("^pdf$" "." "xdg-open %o")
4617           ("^html?$" "." "sensible-browser %o")))
4618
4619 (setq TeX-view-program-list
4620         '(("mupdf" ("mupdf %o" (mode-io-correlate " %(outpage)")))))
4621
4622 (setq TeX-view-program-selection
4623         '(((output-dvi style-pstricks) "dvips and gv")
4624           (output-dvi "xdvi")
4625           (output-pdf "mupdf")
4626           (output-html "sensible-browser")))
4627
4628 (setq TeX-open-quote "\""
4629       TeX-close-quote "\"")
4630
4631 (setq reftex-use-external-file-finders t
4632       reftex-auto-recenter-toc t)
4633
4634 (setq reftex-label-alist
4635         '(("theorem" ?T "th:" "~\\ref{%s}" t ("theorems?" "th\\.") -2)
4636           ("axiom" ?A "ax:" "~\\ref{%s}" t ("axioms?" "ax\\.") -2)
4637           ("definition" ?D "def:" "~\\ref{%s}" t ("definitions?" "def\\.") -2)
4638           ("proposition" ?P "prop:" "~\\ref{%s}" t
4639            ("propositions?" "prop\\.") -2)
4640           ("lemma" ?L "lem:" "~\\ref{%s}" t ("lemmas?" "lem\\.") -2)
4641           ("example" ?X "eg:" "~\\ref{%s}" t ("examples?") -2)
4642           ("exercise" ?E "ex:" "~\\ref{%s}" t ("exercises?" "ex\\.") -2)
4643           ("enumerate" ?i "i:" "~\\ref{%s}" item ("items?"))))
4644 (setq reftex-section-prefixes
4645         '((0 . "part:")
4646           (1 . "ch:")
4647           (t . "sec:")))
4648
4649 (setq bibtex-field-delimiters 'double-quotes
4650       bibtex-align-at-equal-sign t
4651       bibtex-entry-format '(realign opts-or-alts required-fields
4652                             numerical-fields last-comma delimiters
4653                             unify-case sort-fields braces)
4654       bibtex-sort-ignore-string-entries nil
4655       bibtex-maintain-sorted-entries 'entry-class
4656       bibtex-include-OPTkey t
4657       bibtex-autokey-names-stretch 1
4658       bibtex-autokey-expand-strings t
4659       bibtex-autokey-name-separator "-"
4660       bibtex-autokey-year-length 4
4661       bibtex-autokey-titleword-separator "-"
4662       bibtex-autokey-name-year-separator "-"
4663       bibtex-autokey-year-title-separator ":")
4664
4665 (progn
4666   (dolist (hook '(tex-mode-hook latex-mode-hook
4667                                 TeX-mode-hook LaTeX-mode-hook))
4668     (add-hook hook 'mdw-misc-mode-config t)
4669     (add-hook hook 'mdw-fontify-tex t))
4670   (add-hook 'bibtex-mode-hook (lambda () (setq fill-column 76))))
4671
4672 ;;;--------------------------------------------------------------------------
4673 ;;; HTML, CSS, and other web foolishness.
4674
4675 (setq-default css-indent-offset 8)
4676
4677 ;;;--------------------------------------------------------------------------
4678 ;;; SGML hacking.
4679
4680 (setq-default psgml-html-build-new-buffer nil)
4681
4682 (defun mdw-sgml-mode ()
4683   (interactive)
4684   (sgml-mode)
4685   (mdw-standard-fill-prefix "")
4686   (make-local-variable 'sgml-delimiters)
4687   (setq sgml-delimiters
4688           '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
4689             "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT"
4690             "\"" "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]"
4691             "NESTC" "{" "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">"
4692             "PIO" "<?" "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" ","
4693             "STAGO" ":" "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
4694             "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE"
4695             "/>" "NULL" ""))
4696   (setq major-mode 'mdw-sgml-mode)
4697   (setq mode-name "[mdw] SGML")
4698   (run-hooks 'mdw-sgml-mode-hook))
4699
4700 ;;;--------------------------------------------------------------------------
4701 ;;; Configuration files.
4702
4703 (defcustom mdw-conf-quote-normal nil
4704   "Control syntax category of quote characters `\"' and `''.
4705 If this is `t', consider quote characters to be normal
4706 punctuation, as for `conf-quote-normal'.  If this is `nil' then
4707 leave quote characters as quotes.  If this is a list, then
4708 consider the quote characters in the list to be normal
4709 punctuation.  If this is a single quote character, then consider
4710 that character only to be normal punctuation."
4711   :type '(choice boolean character (repeat character))
4712   :safe 'mdw-conf-quote-normal-acceptable-value-p)
4713 (defun mdw-conf-quote-normal-acceptable-value-p (value)
4714   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
4715   (or (booleanp value)
4716       (cl-every (lambda (v) (memq v '(?\" ?')))
4717                 (if (listp value) value (list value)))))
4718
4719 (defun mdw-fix-up-quote ()
4720   "Apply the setting of `mdw-conf-quote-normal'."
4721   (let ((flag mdw-conf-quote-normal))
4722     (cond ((eq flag t)
4723            (conf-quote-normal t))
4724           ((not flag)
4725            nil)
4726           (t
4727            (let ((table (copy-syntax-table (syntax-table))))
4728              (dolist (ch (if (listp flag) flag (list flag)))
4729                (modify-syntax-entry ch "." table))
4730              (set-syntax-table table)
4731              (and font-lock-mode (font-lock-fontify-buffer)))))))
4732
4733 (progn
4734   (add-hook 'conf-mode-hook 'mdw-misc-mode-config t)
4735   (add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t))
4736
4737 ;;;--------------------------------------------------------------------------
4738 ;;; Shell scripts.
4739
4740 (defun mdw-setup-sh-script-mode ()
4741
4742   ;; Fetch the shell interpreter's name.
4743   (let ((shell-name sh-shell-file))
4744
4745     ;; Try reading the hash-bang line.
4746     (save-excursion
4747       (goto-char (point-min))
4748       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
4749           (setq shell-name (match-string 1))))
4750
4751     ;; Now try to set the shell.
4752     ;;
4753     ;; Don't let `sh-set-shell' bugger up my script.
4754     (let ((executable-set-magic #'(lambda (s &rest r) s)))
4755       (sh-set-shell shell-name)))
4756
4757   ;; Don't insert here-document scaffolding automatically.
4758   (local-set-key "<" 'self-insert-command)
4759
4760   ;; Now enable my keys and the fontification.
4761   (mdw-misc-mode-config)
4762
4763   ;; Set the indentation level correctly.
4764   (setq sh-indentation 2)
4765   (setq sh-basic-offset 2))
4766
4767 (setq sh-shell-file "/bin/sh")
4768
4769 ;; Awful hacking to override the shell detection for particular scripts.
4770 (defmacro define-custom-shell-mode (name shell)
4771   `(defun ,name ()
4772      (interactive)
4773      (set (make-local-variable 'sh-shell-file) ,shell)
4774      (sh-mode)))
4775 (define-custom-shell-mode bash-mode "/bin/bash")
4776 (define-custom-shell-mode rc-mode "/usr/bin/rc")
4777 (put 'sh-shell-file 'permanent-local t)
4778
4779 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
4780 (eval-after-load "sh-script"
4781   '(or (assq 'rc sh-mode-syntax-table-input)
4782        (let ((frag '(nil
4783                      ?# "<"
4784                      ?\n ">#"
4785                      ?\" "\"\""
4786                      ?\' "\"\'"
4787                      ?$ "'"
4788                      ?\` "."
4789                      ?! "_"
4790                      ?% "_"
4791                      ?. "_"
4792                      ?^ "_"
4793                      ?~ "_"
4794                      ?, "_"
4795                      ?= "."
4796                      ?< "."
4797                      ?> "."))
4798              (assoc (assq 'rc sh-mode-syntax-table-input)))
4799          (if assoc
4800              (rplacd assoc frag)
4801            (setq sh-mode-syntax-table-input
4802                    (cons (cons 'rc frag)
4803                          sh-mode-syntax-table-input))))))
4804
4805 (progn
4806   (add-hook 'sh-mode-hook 'mdw-misc-mode-config t)
4807   (add-hook 'sh-mode-hook 'mdw-setup-sh-script-mode t))
4808
4809 ;;;--------------------------------------------------------------------------
4810 ;;; Emacs shell mode.
4811
4812 (defun mdw-eshell-prompt ()
4813   (let ((left "[") (right "]"))
4814     (when (= (user-uid) 0)
4815       (setq left "«" right "»"))
4816     (concat left
4817             (save-match-data
4818               (replace-regexp-in-string "\\..*$" "" (system-name)))
4819             " "
4820             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
4821                    (home (expand-file-name "~")) (nhome (length home)))
4822               (if (and (>= npwd nhome)
4823                        (or (= nhome npwd)
4824                            (= (elt pwd nhome) ?/))
4825                        (string= (substring pwd 0 nhome) home))
4826                   (concat "~" (substring pwd (length home)))
4827                 pwd))
4828             right)))
4829 (setq-default eshell-prompt-function 'mdw-eshell-prompt)
4830 (setq-default eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
4831
4832 (defun eshell/e (file) (find-file file) nil)
4833 (defun eshell/ee (file) (find-file-other-window file) nil)
4834 (defun eshell/w3m (url) (w3m-goto-url url) nil)
4835
4836 (mdw-define-face eshell-prompt (t :weight bold))
4837 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
4838 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
4839 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
4840 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
4841 (mdw-define-face eshell-ls-executable (t :weight bold))
4842 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
4843 (mdw-define-face eshell-ls-readonly (t nil))
4844 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
4845
4846 (defun mdw-eshell-hack () (setenv "LD_PRELOAD" nil))
4847 (add-hook 'eshell-mode-hook 'mdw-eshell-hack)
4848
4849 ;;;--------------------------------------------------------------------------
4850 ;;; Messages-file mode.
4851
4852 (defun messages-mode-guts ()
4853   (setq messages-mode-syntax-table (make-syntax-table))
4854   (set-syntax-table messages-mode-syntax-table)
4855   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
4856   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
4857   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
4858   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
4859   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
4860   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
4861   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
4862   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
4863   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
4864   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
4865   (make-local-variable 'comment-start)
4866   (make-local-variable 'comment-end)
4867   (make-local-variable 'indent-line-function)
4868   (setq indent-line-function 'indent-relative)
4869   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
4870   (make-local-variable 'font-lock-defaults)
4871   (make-local-variable 'messages-mode-keywords)
4872   (let ((keywords
4873          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
4874                       "export" "enum" "fixed-octetstring" "flags"
4875                       "harmless" "map" "nested" "optional"
4876                       "optional-tagged" "package" "primitive"
4877                       "primitive-nullfree" "relaxed[ \t]+enum"
4878                       "set" "table" "tagged-optional"   "union"
4879                       "variadic" "vector" "version" "version-tag")))
4880     (setq messages-mode-keywords
4881             (list
4882              (list (concat "\\<\\(" keywords "\\)\\>:")
4883                    '(0 font-lock-keyword-face))
4884              '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
4885              '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
4886                (0 font-lock-variable-name-face))
4887              '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
4888              '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4889                (0 mdw-punct-face)))))
4890   (setq font-lock-defaults
4891           '(messages-mode-keywords nil nil nil nil))
4892   (run-hooks 'messages-file-hook))
4893
4894 (defun messages-mode ()
4895   (interactive)
4896   (fundamental-mode)
4897   (setq major-mode 'messages-mode)
4898   (setq mode-name "Messages")
4899   (messages-mode-guts)
4900   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
4901   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
4902   (setq comment-start "# ")
4903   (setq comment-end "")
4904   (run-hooks 'messages-mode-hook))
4905
4906 (defun cpp-messages-mode ()
4907   (interactive)
4908   (fundamental-mode)
4909   (setq major-mode 'cpp-messages-mode)
4910   (setq mode-name "CPP Messages")
4911   (messages-mode-guts)
4912   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
4913   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
4914   (setq comment-start "/* ")
4915   (setq comment-end " */")
4916   (let ((preprocessor-keywords
4917          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
4918                       "ident" "if" "ifdef" "ifndef" "import" "include"
4919                       "line" "pragma" "unassert" "undef" "warning")))
4920     (setq messages-mode-keywords
4921             (append (list (list (concat "^[ \t]*\\#[ \t]*"
4922                                         "\\(include\\|import\\)"
4923                                         "[ \t]*\\(<[^>]+\\(>\\)?\\)")
4924                                 '(2 font-lock-string-face))
4925                           (list (concat "^\\([ \t]*#[ \t]*\\(\\("
4926                                         preprocessor-keywords
4927                                         "\\)\\>\\|[0-9]+\\|$\\)\\)")
4928                                 '(1 font-lock-keyword-face)))
4929                     messages-mode-keywords)))
4930   (run-hooks 'cpp-messages-mode-hook))
4931
4932 (progn
4933   (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
4934   (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
4935   ;; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
4936   )
4937
4938 ;;;--------------------------------------------------------------------------
4939 ;;; Messages-file mode.
4940
4941 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
4942   "Face to use for subsittution directives.")
4943 (make-face 'mallow-driver-substitution-face)
4944 (defvar mallow-driver-text-face 'mallow-driver-text-face
4945   "Face to use for body text.")
4946 (make-face 'mallow-driver-text-face)
4947
4948 (defun mallow-driver-mode ()
4949   (interactive)
4950   (fundamental-mode)
4951   (setq major-mode 'mallow-driver-mode)
4952   (setq mode-name "Mallow driver")
4953   (setq mallow-driver-mode-syntax-table (make-syntax-table))
4954   (set-syntax-table mallow-driver-mode-syntax-table)
4955   (make-local-variable 'comment-start)
4956   (make-local-variable 'comment-end)
4957   (make-local-variable 'indent-line-function)
4958   (setq indent-line-function 'indent-relative)
4959   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
4960   (make-local-variable 'font-lock-defaults)
4961   (make-local-variable 'mallow-driver-mode-keywords)
4962   (let ((keywords
4963          (mdw-regexps "each" "divert" "file" "if"
4964                       "perl" "set" "string" "type" "write")))
4965     (setq mallow-driver-mode-keywords
4966             (list
4967              (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
4968                    '(0 font-lock-keyword-face))
4969              (list "^%\\s *\\(#.*\\)?$"
4970                    '(0 font-lock-comment-face))
4971              (list "^%"
4972                    '(0 font-lock-keyword-face))
4973              (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
4974              (list "\\${[^}]*}"
4975                    '(0 mallow-driver-substitution-face t)))))
4976   (setq font-lock-defaults
4977         '(mallow-driver-mode-keywords nil nil nil nil))
4978   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
4979   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
4980   (setq comment-start "%# ")
4981   (setq comment-end "")
4982   (run-hooks 'mallow-driver-mode-hook))
4983
4984 (progn
4985   (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t))
4986
4987 ;;;--------------------------------------------------------------------------
4988 ;;; NFast debugs.
4989
4990 (defun nfast-debug-mode ()
4991   (interactive)
4992   (fundamental-mode)
4993   (setq major-mode 'nfast-debug-mode)
4994   (setq mode-name "NFast debug")
4995   (setq messages-mode-syntax-table (make-syntax-table))
4996   (set-syntax-table messages-mode-syntax-table)
4997   (make-local-variable 'font-lock-defaults)
4998   (make-local-variable 'nfast-debug-mode-keywords)
4999   (setq truncate-lines t)
5000   (setq nfast-debug-mode-keywords
5001           (list
5002            '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
5003              (0 font-lock-keyword-face))
5004            (list (concat "^[ \t]+\\(\\("
5005                          "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
5006                          "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
5007                          "[ \t]+\\)*"
5008                          "[0-9a-fA-F]+\\)[ \t]*$")
5009                  '(0 mdw-number-face))
5010            '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
5011              (1 font-lock-keyword-face))
5012            '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
5013              (1 font-lock-warning-face))
5014            '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
5015              (1 nil))
5016            (list (concat "^[ \t]+\\.cmd=[ \t]+"
5017                          "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
5018                  '(1 font-lock-keyword-face))
5019            '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
5020            '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
5021            '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
5022            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
5023   (setq font-lock-defaults
5024           '(nfast-debug-mode-keywords nil nil nil nil))
5025   (run-hooks 'nfast-debug-mode-hook))
5026
5027 ;;;--------------------------------------------------------------------------
5028 ;;; Lispy languages.
5029
5030 ;; Unpleasant bodge.
5031 (unless (boundp 'slime-repl-mode-map)
5032   (setq slime-repl-mode-map (make-sparse-keymap)))
5033
5034 (defun mdw-indent-newline-and-indent ()
5035   (interactive)
5036   (indent-for-tab-command)
5037   (newline-and-indent))
5038
5039 (eval-after-load "cl-indent"
5040   '(progn
5041      (mapc #'(lambda (pair)
5042                (put (car pair)
5043                     'common-lisp-indent-function
5044                     (cdr pair)))
5045       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
5046         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
5047
5048 (defun mdw-common-lisp-indent ()
5049   (make-local-variable 'lisp-indent-function)
5050   (setq lisp-indent-function 'common-lisp-indent-function))
5051
5052 (defmacro mdw-advise-hyperspec-lookup (func args)
5053   `(defadvice ,func (around mdw-browse-w3m ,args activate compile)
5054      (if (fboundp 'w3m)
5055          (let ((browse-url-browser-function #'mdw-w3m-browse-url))
5056            ad-do-it)
5057        ad-do-it)))
5058 (mdw-advise-hyperspec-lookup common-lisp-hyperspec (symbol))
5059 (mdw-advise-hyperspec-lookup common-lisp-hyperspec-format (char))
5060 (mdw-advise-hyperspec-lookup common-lisp-hyperspec-lookup-reader-macro (char))
5061
5062 (defun mdw-fontify-lispy ()
5063
5064   ;; Set fill prefix.
5065   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
5066
5067   ;; Not much fontification needed.
5068   (make-local-variable 'font-lock-keywords)
5069     (setq font-lock-keywords
5070           (list (list (concat "\\("
5071                               "\\_<[-+]?"
5072                               "\\(" "[0-9]+/[0-9]+"
5073                               "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
5074                                           "\\.[0-9]+" "\\)"
5075                                     "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
5076                               "\\)"
5077                               "\\|"
5078                               "#"
5079                               "\\(" "x" "[-+]?"
5080                                     "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
5081                               "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
5082                               "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
5083                               "\\|" "[0-9]+" "r" "[-+]?"
5084                                     "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
5085                               "\\)"
5086                               "\\)\\_>")
5087                       '(0 mdw-number-face))
5088                 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
5089                       '(0 mdw-punct-face)))))
5090
5091 ;; Special indentation.
5092
5093 (defcustom mdw-lisp-loop-default-indent 2
5094   "Default indent for simple `loop' body."
5095   :type 'integer
5096   :safe 'integerp)
5097 (defcustom mdw-lisp-setf-value-indent 2
5098   "Default extra indent for `setf' values."
5099   :type 'integer :safe 'integerp)
5100
5101 (setq lisp-simple-loop-indentation 0
5102       lisp-loop-keyword-indentation 0
5103       lisp-loop-forms-indentation 2
5104       lisp-lambda-list-keyword-parameter-alignment t)
5105
5106 (defun mdw-indent-funcall
5107     (path state &optional indent-point sexp-column normal-indent)
5108   "Indent `funcall' more usefully.
5109 Essentially, treat `funcall foo' as a function name, and align the arguments
5110 to `foo'."
5111   (and (or (not (consp path)) (null (cadr path)))
5112        (save-excursion
5113          (goto-char (cadr state))
5114          (forward-char 1)
5115          (let ((start-line (line-number-at-pos)))
5116            (and (condition-case nil (progn (forward-sexp 3) t)
5117                   (scan-error nil))
5118                 (progn
5119                   (forward-sexp -1)
5120                   (and (= start-line (line-number-at-pos))
5121                        (current-column))))))))
5122 (progn
5123   (put 'funcall 'common-lisp-indent-function 'mdw-indent-funcall)
5124   (put 'funcall 'lisp-indent-function 'mdw-indent-funcall))
5125
5126 (defun mdw-indent-setf
5127     (path state &optional indent-point sexp-column normal-indent)
5128   "Indent `setf' more usefully.
5129 If the values aren't on the same lines as their variables then indent them
5130 by `mdw-lisp-setf-value-indent' spaces."
5131   (and (or (not (consp path)) (null (cadr path)))
5132        (let ((basic-indent (save-excursion
5133                              (goto-char (cadr state))
5134                              (forward-char 1)
5135                              (and (condition-case nil
5136                                       (progn (forward-sexp 2) t)
5137                                     (scan-error nil))
5138                                   (progn
5139                                     (forward-sexp -1)
5140                                     (current-column)))))
5141              (offset (if (consp path) (car path)
5142                        (catch 'done
5143                          (save-excursion
5144                            (let ((start path)
5145                                  (count 0))
5146                              (goto-char (cadr state))
5147                              (forward-char 1)
5148                              (while (< (point) start)
5149                                (condition-case nil (forward-sexp 1)
5150                                  (scan-error (throw 'done nil)))
5151                                (cl-incf count))
5152                              (1- count)))))))
5153          (and basic-indent offset
5154               (list (+ basic-indent
5155                        (if (cl-oddp offset) 0
5156                          mdw-lisp-setf-value-indent))
5157                     basic-indent)))))
5158 (progn
5159   (put 'setf 'common-lisp-indent-functopion 'mdw-indent-setf)
5160   (put 'psetf 'common-lisp-indent-function 'mdw-indent-setf)
5161   (put 'setq 'common-lisp-indent-function 'mdw-indent-setf)
5162   (put 'setf 'lisp-indent-function 'mdw-indent-setf)
5163   (put 'setq 'lisp-indent-function 'mdw-indent-setf)
5164   (put 'setq-local 'lisp-indent-function 'mdw-indent-setf)
5165   (put 'setq-default 'lisp-indent-function 'mdw-indent-setf))
5166
5167 (defadvice common-lisp-loop-part-indentation
5168     (around mdw-fix-loop-indentation (indent-point state) activate compile)
5169   "Improve `loop' indentation.
5170 If the first subform is on the same line as the `loop' keyword, then
5171 align the other subforms beneath it.  Otherwise, indent them
5172 `mdw-lisp-loop-default-indent' columns in from the opening parenthesis."
5173
5174   (let* ((loop-indentation (save-excursion
5175                              (goto-char (elt state 1))
5176                              (current-column))))
5177
5178     ;; Don't really care about this.
5179     (when (and (boundp 'lisp-indent-backquote-substitution-mode)
5180                (eq lisp-indent-backquote-substitution-mode 'corrected))
5181       (save-excursion
5182         (goto-char (elt state 1))
5183         (cl-incf loop-indentation
5184                    (cond ((eq (char-before) ?,) -1)
5185                          ((and (eq (char-before) ?@)
5186                                (progn (backward-char)
5187                                       (eq (char-before) ?,)))
5188                           -2)
5189                          (t 0)))))
5190
5191     ;; If the first loop item is on the same line as the `loop' itself then
5192     ;; use that as the baseline.  Otherwise advance by the default indent.
5193     (goto-char (cadr state))
5194     (forward-char 1)
5195     (let ((baseline-indent
5196            (if (= (line-number-at-pos)
5197                   (if (condition-case nil (progn (forward-sexp 2) t)
5198                         (scan-error nil))
5199                       (progn (forward-sexp -1) (line-number-at-pos))
5200                     -1))
5201                (current-column)
5202              (+ loop-indentation mdw-lisp-loop-default-indent))))
5203
5204       (goto-char indent-point)
5205       (beginning-of-line)
5206
5207       (setq ad-return-value
5208               (list
5209                (cond ((condition-case ()
5210                           (save-excursion
5211                             (goto-char (elt state 1))
5212                             (forward-char 1)
5213                             (forward-sexp 2)
5214                             (backward-sexp 1)
5215                             (not (looking-at "\\(:\\|\\sw\\)")))
5216                         (error nil))
5217                       (+ baseline-indent lisp-simple-loop-indentation))
5218                      ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
5219                       (+ baseline-indent lisp-loop-keyword-indentation))
5220                      (t
5221                       (+ baseline-indent lisp-loop-forms-indentation)))
5222
5223                ;; Tell the caller that the next line needs recomputation,
5224                ;; even though it doesn't start a sexp.
5225                loop-indentation)))))
5226
5227 ;; SLIME setup.
5228
5229 (defcustom mdw-friendly-name "[mdw]"
5230   "How I want to be addressed."
5231   :type 'string
5232   :safe 'stringp)
5233 (defadvice slime-user-first-name
5234     (around mdw-use-friendly-name compile activate)
5235   (if mdw-friendly-name (setq ad-return-value mdw-friendly-name)
5236     ad-do-it))
5237
5238 (eval-and-compile
5239   (trap
5240     (if (not mdw-fast-startup)
5241         (progn
5242           (require 'slime-autoloads)
5243           (slime-setup '(slime-autodoc slime-c-p-c))))))
5244
5245 (let ((stuff '((cmucl ("cmucl"))
5246                (sbcl ("sbcl") :coding-system utf-8-unix)
5247                (clisp ("clisp") :coding-system utf-8-unix))))
5248   (or (boundp 'slime-lisp-implementations)
5249       (setq slime-lisp-implementations nil))
5250   (while stuff
5251     (let* ((head (car stuff))
5252            (found (assq (car head) slime-lisp-implementations)))
5253       (setq stuff (cdr stuff))
5254       (if found
5255           (rplacd found (cdr head))
5256         (setq slime-lisp-implementations
5257                 (cons head slime-lisp-implementations))))))
5258 (setq slime-default-lisp 'sbcl)
5259
5260 ;; Hooks.
5261
5262 (progn
5263   (dolist (hook '(emacs-lisp-mode-hook
5264                   scheme-mode-hook
5265                   lisp-mode-hook
5266                   inferior-lisp-mode-hook
5267                   lisp-interaction-mode-hook
5268                   ielm-mode-hook
5269                   slime-repl-mode-hook))
5270     (add-hook hook 'mdw-misc-mode-config t)
5271     (add-hook hook 'mdw-fontify-lispy t))
5272   (add-hook 'lisp-mode-hook 'mdw-common-lisp-indent t)
5273   (add-hook 'inferior-lisp-mode-hook
5274             #'(lambda () (local-set-key "\C-m" 'comint-send-and-indent)) t))
5275
5276 ;;;--------------------------------------------------------------------------
5277 ;;; Other languages.
5278
5279 ;; Smalltalk.
5280
5281 (defun mdw-setup-smalltalk ()
5282   (and mdw-auto-indent
5283        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
5284   (make-local-variable 'mdw-auto-indent)
5285   (setq mdw-auto-indent nil)
5286   (local-set-key "\C-i" 'smalltalk-reindent))
5287
5288 (defun mdw-fontify-smalltalk ()
5289   (make-local-variable 'font-lock-keywords)
5290   (setq font-lock-keywords
5291           (list
5292            (list "\\<[A-Z][a-zA-Z0-9]*\\>"
5293                  '(0 font-lock-keyword-face))
5294            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
5295                          "[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
5296                          "\\([eE][-+]?[0-9_]+\\)?")
5297                  '(0 mdw-number-face))
5298            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
5299                  '(0 mdw-punct-face)))))
5300
5301 (progn
5302   (add-hook 'smalltalk-mode 'mdw-misc-mode-config t)
5303   (add-hook 'smalltalk-mode 'mdw-fontify-smalltalk t))
5304
5305 ;; m4.
5306
5307 (defun mdw-setup-m4 ()
5308
5309   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
5310   ;; annoying: fix it.
5311   (modify-syntax-entry ?{ "(")
5312   (modify-syntax-entry ?} ")")
5313
5314   ;; Fill prefix.
5315   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
5316
5317 (dolist (hook '(m4-mode-hook autoconf-mode-hook autotest-mode-hook))
5318   (add-hook hook #'mdw-misc-mode-config t)
5319   (add-hook hook #'mdw-setup-m4 t))
5320
5321 ;; Make.
5322
5323 (progn
5324   (add-hook 'makefile-mode-hook 'mdw-misc-mode-config t))
5325
5326 ;; nroff/troff.
5327
5328 (progn
5329   (add-hook 'nroff-mode-hook 'mdw-misc-mode-config t))
5330
5331 ;;;--------------------------------------------------------------------------
5332 ;;; Text mode.
5333
5334 (defun mdw-text-mode ()
5335   (setq fill-column 72)
5336   (flyspell-mode t)
5337   (mdw-standard-fill-prefix
5338    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
5339   (auto-fill-mode 1))
5340
5341 (eval-after-load "flyspell"
5342   '(define-key flyspell-mode-map "\C-\M-i" nil))
5343
5344 (progn
5345   (add-hook 'text-mode-hook 'mdw-text-mode t))
5346
5347 ;;;--------------------------------------------------------------------------
5348 ;;; Outline and hide/show modes.
5349
5350 (defun mdw-outline-collapse-all ()
5351   "Completely collapse everything in the entire buffer."
5352   (interactive)
5353   (save-excursion
5354     (goto-char (point-min))
5355     (while (< (point) (point-max))
5356       (hide-subtree)
5357       (forward-line))))
5358
5359 (setq hs-hide-comments-when-hiding-all nil)
5360
5361 (defadvice hs-hide-all (after hide-first-comment activate)
5362   (save-excursion (hs-hide-initial-comment-block)))
5363
5364 ;;;--------------------------------------------------------------------------
5365 ;;; Shell mode.
5366
5367 (defun mdw-sh-mode-setup ()
5368   (local-set-key [?\C-a] 'comint-bol)
5369   (add-hook 'comint-output-filter-functions
5370             'comint-watch-for-password-prompt))
5371
5372 (defun mdw-term-mode-setup ()
5373   (setq term-prompt-regexp shell-prompt-pattern)
5374   (make-local-variable 'mouse-yank-at-point)
5375   (make-local-variable 'transient-mark-mode)
5376   (setq mouse-yank-at-point t)
5377   (auto-fill-mode -1)
5378   (setq tab-width 8))
5379
5380 (defun comint-send-and-indent ()
5381   (interactive)
5382   (comint-send-input)
5383   (and mdw-auto-indent
5384        (indent-for-tab-command)))
5385
5386 (defadvice comint-line-beginning-position
5387     (around mdw-calculate-it-properly () activate compile)
5388   "Calculate the actual line start for multi-line input."
5389   (if (or comint-use-prompt-regexp
5390           (eq (field-at-pos (point)) 'output))
5391       ad-do-it
5392     (setq ad-return-value
5393             (constrain-to-field (line-beginning-position) (point)))))
5394
5395 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
5396 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
5397 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
5398 (defun term-send-meta-meta-something ()
5399   (interactive)
5400   (term-send-raw-string "\e\e")
5401   (term-send-raw))
5402 (eval-after-load 'term
5403   '(progn
5404      (define-key term-raw-map [?\e ?\e] nil)
5405      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
5406      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
5407      (define-key term-raw-map [M-right] 'term-send-meta-right)
5408      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
5409      (define-key term-raw-map [M-left] 'term-send-meta-left)
5410      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
5411
5412 (defadvice term-exec (before program-args-list compile activate)
5413   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
5414 This allows you to pass a list of arguments through `ansi-term'."
5415   (let ((program (ad-get-arg 2)))
5416     (if (listp program)
5417         (progn
5418           (ad-set-arg 2 (car program))
5419           (ad-set-arg 4 (cdr program))))))
5420
5421 (defadvice term-exec-1 (around hack-environment compile activate)
5422   "Hack the environment inherited by inferiors in the terminal."
5423   (let ((process-environment (copy-tree process-environment)))
5424     (setenv "LD_PRELOAD" nil)
5425     ad-do-it))
5426
5427 (defadvice shell (around hack-environment compile activate)
5428   "Hack the environment inherited by inferiors in the shell."
5429   (let ((process-environment (copy-tree process-environment)))
5430     (setenv "LD_PRELOAD" nil)
5431     ad-do-it))
5432
5433 (defun ssh (host)
5434   "Open a terminal containing an ssh session to the HOST."
5435   (interactive "sHost: ")
5436   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
5437
5438 (defcustom git-grep-command
5439   "env GIT_PAGER=cat git grep --no-color -nH -e "
5440   "The default command for \\[git-grep]."
5441   :type 'string)
5442
5443 (defvar git-grep-history nil)
5444
5445 (defun git-grep (command-args)
5446   "Run `git grep' with user-specified args and collect output in a buffer."
5447   (interactive
5448    (list (read-shell-command "Run git grep (like this): "
5449                              git-grep-command 'git-grep-history)))
5450   (let ((grep-use-null-device nil))
5451     (grep command-args)))
5452
5453 ;;;--------------------------------------------------------------------------
5454 ;;; Magit configuration.
5455
5456 (setq magit-diff-refine-hunk 't
5457       magit-view-git-manual-method 'man
5458       magit-log-margin '(nil age magit-log-margin-width t 18)
5459       magit-wip-after-save-local-mode-lighter ""
5460       magit-wip-after-apply-mode-lighter ""
5461       magit-wip-before-change-mode-lighter "")
5462 (eval-after-load "magit"
5463   '(progn (global-magit-file-mode 1)
5464           (magit-wip-after-save-mode 1)
5465           (magit-wip-after-apply-mode 1)
5466           (magit-wip-before-change-mode 1)
5467           (add-to-list 'magit-no-confirm 'safe-with-wip)
5468           (add-to-list 'magit-no-confirm 'trash)
5469           (push '(:eval (if (or magit-wip-after-save-local-mode
5470                                 magit-wip-after-apply-mode
5471                                 magit-wip-before-change-mode)
5472                             (format " wip:%s%s%s"
5473                                     (if magit-wip-after-apply-mode "A" "")
5474                                     (if magit-wip-before-change-mode "C" "")
5475                                     (if magit-wip-after-save-local-mode "S" ""))))
5476                 minor-mode-alist)
5477           (dolist (popup '(magit-diff-popup
5478                            magit-diff-refresh-popup
5479                            magit-diff-mode-refresh-popup
5480                            magit-revision-mode-refresh-popup))
5481             (magit-define-popup-switch popup ?R "Reverse diff" "-R"))
5482           (magit-define-popup-switch 'magit-rebase-popup ?r
5483                                      "Rebase merges" "--rebase-merges")))
5484
5485 (defadvice magit-wip-commit-buffer-file
5486     (around mdw-just-this-buffer activate compile)
5487   (let ((magit-save-repository-buffers nil)) ad-do-it))
5488
5489 (defadvice magit-discard
5490     (around mdw-delete-if-prefix-argument activate compile)
5491   (let ((magit-delete-by-moving-to-trash
5492          (and (null current-prefix-arg)
5493               magit-delete-by-moving-to-trash)))
5494     ad-do-it))
5495
5496 (setq magit-repolist-columns
5497         '(("Name" 16 magit-repolist-column-ident nil)
5498           ("Version" 18 magit-repolist-column-version nil)
5499           ("St" 2 magit-repolist-column-dirty nil)
5500           ("L<U" 3 mdw-repolist-column-unpulled-from-upstream nil)
5501           ("L>U" 3 mdw-repolist-column-unpushed-to-upstream nil)
5502           ("Path" 32 magit-repolist-column-path nil)))
5503
5504 (setq magit-repository-directories '(("~/etc/profile" . 0)
5505                                      ("~/src/" . 1)))
5506
5507 (defadvice magit-list-repos (around mdw-dirname () activate compile)
5508   "Make sure the returned names are directory names.
5509 Otherwise child processes get started in the wrong directory and
5510 there is sadness."
5511   (setq ad-return-value (mapcar #'file-name-as-directory ad-do-it)))
5512
5513 (defun mdw-repolist-column-unpulled-from-upstream (_id)
5514   "Insert number of upstream commits not in the current branch."
5515   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5516     (and upstream
5517          (let ((n (cadr (magit-rev-diff-count "HEAD" upstream))))
5518            (propertize (number-to-string n) 'face
5519                        (if (> n 0) 'bold 'shadow))))))
5520
5521 (defun mdw-repolist-column-unpushed-to-upstream (_id)
5522   "Insert number of commits in the current branch but not its upstream."
5523   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5524     (and upstream
5525          (let ((n (car (magit-rev-diff-count "HEAD" upstream))))
5526            (propertize (number-to-string n) 'face
5527                        (if (> n 0) 'bold 'shadow))))))
5528
5529 (defun mdw-try-smerge ()
5530   (save-excursion
5531     (goto-char (point-min))
5532     (when (re-search-forward "^<<<<<<< " nil t)
5533       (smerge-mode 1))))
5534 (add-hook 'find-file-hook 'mdw-try-smerge t)
5535
5536 (defcustom mdw-magit-new-window-modes
5537   '(magit-diff-mode
5538     magit-log-mode
5539     magit-process-mode
5540     magit-revision-mode
5541     magit-stash-mode
5542     magit-status-mode)
5543   "Magit modes which should cause a new window to be used."
5544   :type '(repeat symbol))
5545
5546 (defun mdw-display-magit-buffer (buffer)
5547   "Like `magit-display-buffer-traditional'.
5548 But uses `mdw-magit-new-window-modes' for its list of modes
5549 rather than baking the list into the function."
5550   (display-buffer buffer
5551                   (let ((mode (with-current-buffer buffer major-mode)))
5552                     (if (and (not mdw-designated-window)
5553                              (derived-mode-p 'magit-mode)
5554                              (mdw-submode-p mode 'magit-mode)
5555                              (not (memq mode mdw-magit-new-window-modes)))
5556                         '(display-buffer-same-window . nil)
5557                       nil))))
5558 (setq magit-display-buffer-function 'mdw-display-magit-buffer)
5559
5560 (defun mdw-display-magit-file-buffer (buffer)
5561   "Show a file buffer from a diff."
5562   (select-window (display-buffer buffer)))
5563 (setq magit-display-file-buffer-function 'mdw-display-magit-file-buffer)
5564
5565 ;;;--------------------------------------------------------------------------
5566 ;;; GUD, and especially GDB.
5567
5568 ;; Inhibit window dedication.  I mean, seriously, wtf?
5569 (defadvice gdb-display-buffer (after mdw-undedicated (buf) compile activate)
5570   "Don't make windows dedicated.  Seriously."
5571   (set-window-dedicated-p ad-return-value nil))
5572 (defadvice gdb-set-window-buffer
5573     (after mdw-undedicated (name &optional ignore-dedicated window)
5574      compile activate)
5575   "Don't make windows dedicated.  Seriously."
5576   (set-window-dedicated-p (or window (selected-window)) nil))
5577
5578 (defadvice gud-find-expr
5579     (around mdw-inhibit-read-only (&rest args) compile activate)
5580   "Inhibit errors caused by my setting of `comint-prompt-read-only'."
5581   (let ((inhibit-read-only t)) ad-do-it))
5582
5583 ;;;--------------------------------------------------------------------------
5584 ;;; SQL stuff.
5585
5586 (setq sql-postgres-options '("-n" "-P" "pager=off")
5587       sql-postgres-login-params
5588         '((user :default "mdw")
5589           (database :default "mdw")
5590           (server :default "db.distorted.org.uk")))
5591
5592 ;;;--------------------------------------------------------------------------
5593 ;;; Man pages.
5594
5595 ;; Turn off `noip' when running `man': it interferes with `man-db''s own
5596 ;; seccomp(2)-based sandboxing, which is (in this case, at least) strictly
5597 ;; better.
5598 (defadvice Man-getpage-in-background
5599     (around mdw-inhibit-noip (topic) compile activate)
5600   "Inhibit the `noip' preload hack when invoking `man'."
5601   (let* ((old-preload (getenv "LD_PRELOAD"))
5602          (preloads (and old-preload
5603                         (save-match-data (split-string old-preload ":"))))
5604          (any nil)
5605          (filtered nil))
5606     (save-match-data
5607       (while preloads
5608         (let ((item (pop preloads)))
5609           (if (string-match  "\\(/\\|^\\)noip\.so\\(:\\|$\\)" item)
5610               (setq any t)
5611             (push item filtered)))))
5612     (if any
5613         (unwind-protect
5614             (progn
5615               (setenv "LD_PRELOAD"
5616                       (and filtered
5617                            (with-output-to-string
5618                              (setq filtered (nreverse filtered))
5619                              (let ((first t))
5620                                (while filtered
5621                                  (if first (setq first nil)
5622                                    (write-char ?:))
5623                                  (write-string (pop filtered)))))))
5624               ad-do-it)
5625           (setenv "LD_PRELOAD" old-preload))
5626       ad-do-it)))
5627
5628 ;;;--------------------------------------------------------------------------
5629 ;;; MPC configuration.
5630
5631 (eval-when-compile (trap (require 'mpc)))
5632
5633 (setq mpc-browser-tags '(Artist|Composer|Performer Album|Playlist))
5634
5635 (defun mdw-mpc-now-playing ()
5636   (interactive)
5637   (require 'mpc)
5638   (save-excursion
5639     (set-buffer (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong"))))
5640     (mpc--status-callback))
5641   (let ((state (cdr (assq 'state mpc-status))))
5642     (cond ((member state '("stop"))
5643            (message "mpd stopped."))
5644           ((member state '("play" "pause"))
5645            (let* ((artist (cdr (assq 'Artist mpc-status)))
5646                   (album (cdr (assq 'Album mpc-status)))
5647                   (title (cdr (assq 'Title mpc-status)))
5648                   (file (cdr (assq 'file mpc-status)))
5649                   (duration-string (cdr (assq 'Time mpc-status)))
5650                   (time-string (cdr (assq 'time mpc-status)))
5651                   (time (and time-string
5652                              (string-to-number
5653                               (if (string-match ":" time-string)
5654                                   (substring time-string
5655                                              0 (match-beginning 0))
5656                                 (time-string)))))
5657                   (duration (and duration-string
5658                                  (string-to-number duration-string)))
5659                   (pos (and time duration
5660                             (format " [%d:%02d/%d:%02d]"
5661                                     (/ time 60) (mod time 60)
5662                                     (/ duration 60) (mod duration 60))))
5663                   (fmt (cond ((and artist title)
5664                               (format "`%s' by %s%s" title artist
5665                                       (if album (format ", from `%s'" album)
5666                                         "")))
5667                              (file
5668                               (format "`%s' (no tags)" file))
5669                              (t
5670                               "(no idea what's playing!)"))))
5671              (if (string= state "play")
5672                  (message "mpd playing %s%s" fmt (or pos ""))
5673                (message "mpd paused in %s%s" fmt (or pos "")))))
5674           (t
5675            (message "mpd in unknown state `%s'" state)))))
5676
5677 (defmacro mdw-define-mpc-wrapper (func bvl interactive &rest body)
5678   `(defun ,func ,bvl
5679      (interactive ,@interactive)
5680      (require 'mpc)
5681      ,@body
5682      (mdw-mpc-now-playing)))
5683
5684 (mdw-define-mpc-wrapper mdw-mpc-play-or-pause () nil
5685   (if (member (cdr (assq 'state (mpc-cmd-status))) '("play"))
5686       (mpc-pause)
5687     (mpc-play)))
5688
5689 (mdw-define-mpc-wrapper mdw-mpc-next () nil (mpc-next))
5690 (mdw-define-mpc-wrapper mdw-mpc-prev () nil (mpc-prev))
5691 (mdw-define-mpc-wrapper mdw-mpc-stop () nil (mpc-stop))
5692
5693 (defun mdw-mpc-louder (step)
5694   (interactive (list (if current-prefix-arg
5695                          (prefix-numeric-value current-prefix-arg)
5696                        +10)))
5697   (mpc-proc-cmd (format "volume %+d" step)))
5698
5699 (defun mdw-mpc-quieter (step)
5700   (interactive (list (if current-prefix-arg
5701                          (prefix-numeric-value current-prefix-arg)
5702                        +10)))
5703   (mpc-proc-cmd (format "volume %+d" (- step))))
5704
5705 (defun mdw-mpc-hack-lines (arg interactivep func)
5706   (if (and interactivep (use-region-p))
5707       (let ((from (region-beginning)) (to (region-end)))
5708         (goto-char from)
5709         (beginning-of-line)
5710         (funcall func)
5711         (forward-line)
5712         (while (< (point) to)
5713           (funcall func)
5714           (forward-line)))
5715     (let ((n (prefix-numeric-value arg)))
5716       (cond ((cl-minusp n)
5717              (unless (bolp)
5718                (beginning-of-line)
5719                (funcall func)
5720                (cl-incf n))
5721              (while (cl-minusp n)
5722                (forward-line -1)
5723                (funcall func)
5724                (cl-incf n)))
5725             (t
5726              (beginning-of-line)
5727              (while (cl-plusp n)
5728                (funcall func)
5729                (forward-line)
5730                (cl-decf n)))))))
5731
5732 (defun mdw-mpc-select-one ()
5733   (when (and (get-char-property (point) 'mpc-file)
5734              (not (get-char-property (point) 'mpc-select)))
5735     (mpc-select-toggle)))
5736
5737 (defun mdw-mpc-unselect-one ()
5738   (when (get-char-property (point) 'mpc-select)
5739     (mpc-select-toggle)))
5740
5741 (defun mdw-mpc-select (&optional arg interactivep)
5742   (interactive (list current-prefix-arg t))
5743   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5744
5745 (defun mdw-mpc-unselect (&optional arg interactivep)
5746   (interactive (list current-prefix-arg t))
5747   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-unselect-one))
5748
5749 (defun mdw-mpc-unselect-backwards (arg)
5750   (interactive "p")
5751   (mdw-mpc-hack-lines (- arg) t 'mdw-mpc-unselect-one))
5752
5753 (defun mdw-mpc-unselect-all ()
5754   (interactive)
5755   (setq mpc-select nil)
5756   (mpc-selection-refresh))
5757
5758 (defun mdw-mpc-next-line (arg)
5759   (interactive "p")
5760   (beginning-of-line)
5761   (forward-line arg))
5762
5763 (defun mdw-mpc-previous-line (arg)
5764   (interactive "p")
5765   (beginning-of-line)
5766   (forward-line (- arg)))
5767
5768 (defun mdw-mpc-playlist-add (&optional arg interactivep)
5769   (interactive (list current-prefix-arg t))
5770   (let ((mpc-select mpc-select))
5771     (when (or arg (and interactivep (use-region-p)))
5772       (setq mpc-select nil)
5773       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5774     (setq mpc-select (reverse mpc-select))
5775     (mpc-playlist-add)))
5776
5777 (defun mdw-mpc-playlist-delete (&optional arg interactivep)
5778   (interactive (list current-prefix-arg t))
5779   (setq mpc-select (nreverse mpc-select))
5780   (mpc-select-save
5781     (when (or arg (and interactivep (use-region-p)))
5782       (setq mpc-select nil)
5783       (mpc-selection-refresh)
5784       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5785       (mpc-playlist-delete)))
5786
5787 (defun mdw-mpc-hack-tagbrowsers ()
5788   (setq-local mode-line-format
5789                 '("%e"
5790                   mode-line-frame-identification
5791                   mode-line-buffer-identification)))
5792 (add-hook 'mpc-tagbrowser-mode-hook 'mdw-mpc-hack-tagbrowsers)
5793
5794 (defun mdw-mpc-hack-songs ()
5795   (setq-local header-line-format
5796               ;; '("MPC " mpc-volume " " mpc-current-song)
5797               (list (propertize " " 'display '(space :align-to 0))
5798                     ;; 'mpc-songs-format-description
5799                     '(:eval
5800                       (let ((deactivate-mark) (hscroll (window-hscroll)))
5801                         (with-temp-buffer
5802                           (mpc-format mpc-songs-format 'self hscroll)
5803                           ;; That would be simpler than the hscroll handling in
5804                           ;; mpc-format, but currently move-to-column does not
5805                           ;; recognize :space display properties.
5806                           ;; (move-to-column hscroll)
5807                           ;; (delete-region (point-min) (point))
5808                           (buffer-string)))))))
5809 (add-hook 'mpc-songs-mode-hook 'mdw-mpc-hack-songs)
5810
5811 (eval-after-load "mpc"
5812   '(progn
5813      (define-key mpc-mode-map "m" 'mdw-mpc-select)
5814      (define-key mpc-mode-map "u" 'mdw-mpc-unselect)
5815      (define-key mpc-mode-map "\177" 'mdw-mpc-unselect-backwards)
5816      (define-key mpc-mode-map "\e\177" 'mdw-mpc-unselect-all)
5817      (define-key mpc-mode-map "n" 'mdw-mpc-next-line)
5818      (define-key mpc-mode-map "p" 'mdw-mpc-previous-line)
5819      (define-key mpc-mode-map "/" 'mpc-songs-search)
5820      (setq mpc-songs-mode-map (make-sparse-keymap))
5821      (set-keymap-parent mpc-songs-mode-map mpc-mode-map)
5822      (define-key mpc-songs-mode-map "l" 'mpc-playlist)
5823      (define-key mpc-songs-mode-map "+" 'mdw-mpc-playlist-add)
5824      (define-key mpc-songs-mode-map "-" 'mdw-mpc-playlist-delete)
5825      (define-key mpc-songs-mode-map "\r" 'mpc-songs-jump-to)))
5826
5827 ;;;--------------------------------------------------------------------------
5828 ;;; Inferior Emacs Lisp.
5829
5830 (setq comint-prompt-read-only t)
5831
5832 (eval-after-load "comint"
5833   '(progn
5834      (define-key comint-mode-map "\C-w" 'comint-kill-region)
5835      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
5836
5837 (eval-after-load "ielm"
5838   '(progn
5839      (define-key ielm-map "\C-w" 'comint-kill-region)
5840      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
5841
5842 ;;;----- That's all, folks --------------------------------------------------
5843
5844 (provide 'dot-emacs)