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 ;; Width configuration.
 126
 127 (defcustom mdw-column-width
 128   (string-to-number (or (mdw-config 'emacs-width) "77"))
 129   "Width of Emacs columns."
 130   :type 'integer)
 131 (defcustom mdw-text-width mdw-column-width
 132   "Expected width of text within columns."
 133   :type 'integer
 134   :safe 'integerp)
 135
 136 ;; Local variables hacking.
 137
 138 (defun run-local-vars-mode-hook ()
 139   "Run a hook for the major-mode after local variables have been processed."
 140   (run-hooks (intern (concat (symbol-name major-mode)
 141                              "-local-variables-hook"))))
 142 (add-hook 'hack-local-variables-hook 'run-local-vars-mode-hook)
 143
 144 ;; Set up the load path convincingly.
 145
 146 (dolist (dir (append (and (boundp 'debian-emacs-flavor)
 147                           (list (concat "/usr/share/"
 148                                         (symbol-name debian-emacs-flavor)
 149                                         "/site-lisp")))))
 150   (dolist (sub (directory-files dir t))
 151     (when (and (file-accessible-directory-p sub)
 152                (not (member sub load-path)))
 153       (setq load-path (nconc load-path (list sub))))))
 154
 155 ;; Is an Emacs library available?
 156
 157 (defun library-exists-p (name)
 158   "Return non-nil if NAME is an available library.
 159 Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
 160 load path.  The non-nil value is the filename we found for the
 161 library."
 162   (let ((path load-path) elt (foundp nil))
 163     (while (and path (not foundp))
 164       (setq elt (car path))
 165       (setq path (cdr path))
 166       (setq foundp (or (let ((file (concat elt "/" name ".elc")))
 167                          (and (file-exists-p file) file))
 168                        (let ((file (concat elt "/" name ".el")))
 169                          (and (file-exists-p file) file)))))
 170     foundp))
 171
 172 (defun maybe-autoload (symbol file &optional docstring interactivep type)
 173   "Set an autoload if the file actually exists."
 174   (and (library-exists-p file)
 175        (autoload symbol file docstring interactivep type)))
 176
 177 (defun mdw-kick-menu-bar (&optional frame)
 178   "Regenerate FRAME's menu bar so it doesn't have empty menus."
 179   (interactive)
 180   (unless frame (setq frame (selected-frame)))
 181   (let ((old (frame-parameter frame 'menu-bar-lines)))
 182     (set-frame-parameter frame 'menu-bar-lines 0)
 183     (set-frame-parameter frame 'menu-bar-lines old)))
 184
 185 ;; Page motion.
 186
 187 (defun mdw-fixup-page-position ()
 188   (unless (eq (char-before (point)) ?\f)
 189     (forward-line 0)))
 190
 191 (defadvice backward-page (after mdw-fixup compile activate)
 192   (mdw-fixup-page-position))
 193 (defadvice forward-page (after mdw-fixup compile activate)
 194   (mdw-fixup-page-position))
 195
 196 ;; Splitting windows.
 197
 198 (unless (fboundp 'scroll-bar-columns)
 199   (defun scroll-bar-columns (side)
 200     (cond ((eq side 'left) 0)
 201           (window-system 3)
 202           (t 1))))
 203 (unless (fboundp 'fringe-columns)
 204   (defun fringe-columns (side)
 205     (cond ((not window-system) 0)
 206           ((eq side 'left) 1)
 207           (t 2))))
 208
 209 (defun mdw-horizontal-window-overhead ()
 210   "Computes the horizontal window overhead.
 211 This is the number of columns used by fringes, scroll bars and other such
 212 cruft."
 213   (if (not window-system)
 214       1
 215     (let ((tot 0))
 216       (dolist (what '(scroll-bar fringe))
 217         (dolist (side '(left right))
 218           (cl-incf tot
 219                    (funcall (intern (concat (symbol-name what) "-columns"))
 220                             side))))
 221       tot)))
 222
 223 (defun mdw-split-window-horizontally (&optional width)
 224   "Split a window horizontally.
 225 Without a numeric argument, split the window approximately in
 226 half.  With a numeric argument WIDTH, allocate WIDTH columns to
 227 the left-hand window (if positive) or -WIDTH columns to the
 228 right-hand window (if negative).  Space for scroll bars and
 229 fringes is not taken out of the allowance for WIDTH, unlike
 230 \\[split-window-horizontally]."
 231   (interactive "P")
 232   (split-window-horizontally
 233    (cond ((null width) nil)
 234          ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
 235          ((< width 0) width))))
 236
 237 (defun mdw-preferred-column-width ()
 238   "Return the preferred column width."
 239   (if (and window-system (mdw-emacs-version-p 22)) mdw-column-width
 240     (1+ mdw-column-width)))
 241
 242 (defun mdw-divvy-window (&optional width)
 243   "Split a wide window into appropriate widths."
 244   (interactive "P")
 245   (setq width (if width (prefix-numeric-value width)
 246                 (mdw-preferred-column-width)))
 247   (let* ((win (selected-window))
 248          (sb-width (mdw-horizontal-window-overhead))
 249          (c (/ (+ (window-width) sb-width)
 250                (+ width sb-width))))
 251     (while (> c 1)
 252       (setq c (1- c))
 253       (split-window-horizontally (+ width sb-width))
 254       (other-window 1))
 255     (select-window win)))
 256
 257 (defun mdw-frame-width-quantized-p (frame-width column-width)
 258   "Return whether the FRAME-WIDTH was chosen specifically for COLUMN-WIDTH."
 259   (let ((sb-width (mdw-horizontal-window-overhead)))
 260     (zerop (mod (+ frame-width sb-width)
 261                 (+ column-width sb-width)))))
 262
 263 (defun mdw-frame-width-for-columns (columns width)
 264   "Return the preferred width for a frame with so many COLUMNS of WIDTH."
 265   (let ((sb-width (mdw-horizontal-window-overhead)))
 266     (- (* columns (+ width sb-width))
 267        sb-width)))
 268
 269 (defun mdw-set-frame-width (columns &optional width)
 270   "Set the current frame to be the correct width for COLUMNS columns.
 271
 272 If WIDTH is non-nil, then it provides the width for the new columns.  (This
 273 can be set interactively with a prefix argument.)"
 274   (interactive "nColumns:
 275 P")
 276   (setq width (if width (prefix-numeric-value width)
 277                 (mdw-preferred-column-width)))
 278   (set-frame-width (selected-frame)
 279                    (mdw-frame-width-for-columns columns width))
 280   (mdw-divvy-window width))
 281
 282 (defcustom mdw-frame-width-fudge
 283   (cond ((<= emacs-major-version 20) 1)
 284         ((= emacs-major-version 26) 3)
 285         (t 0))
 286   "The number of extra columns to add to the desired frame width.
 287
 288 This is sadly necessary because Emacs 26 is broken in this regard."
 289   :type 'integer)
 290
 291 (defcustom mdw-frame-colour-alist
 292   '((black . ("#000000" . "#ffffff"))
 293     (red . ("#2a0000" . "#ffffff"))
 294     (green . ("#002a00" . "#ffffff"))
 295     (blue . ("#00002a" . "#ffffff")))
 296   "Alist mapping symbol names to (FOREGROUND . BACKGROUND) colour pairs."
 297   :type '(alist :key-type symbol :value-type (cons color color)))
 298
 299 (defun mdw-set-frame-colour (colour &optional frame)
 300   (interactive "xColour name or (FOREGROUND . BACKGROUND) pair:
 301 ")
 302   (when (and colour (symbolp colour))
 303     (let ((entry (assq colour mdw-frame-colour-alist)))
 304       (unless entry (error "Unknown colour `%s'" colour))
 305       (setf colour (cdr entry))))
 306   (set-frame-parameter frame 'background-color (car colour))
 307   (set-frame-parameter frame 'foreground-color (cdr colour)))
 308
 309 ;; Window configuration switching.
 310
 311 (defvar mdw-current-window-configuration nil
 312   "The current window configuration register name, or `nil'.")
 313
 314 (defun mdw-switch-window-configuration (register &optional no-save)
 315   "Switch make REGISTER be the new current window configuration.
 316 If a current window configuration register is established, and
 317 NO-SAVE is nil, then save the current window configuration to
 318 that register first.
 319
 320 Signal an error if the new register contains something other than
 321 a window configuration.  If the register is unset then save the
 322 current window configuration to it immediately.
 323
 324 With one or three C-u, or an odd numeric prefix argument, set
 325 NO-SAVE, so the previous window configuration register is left
 326 unchanged.
 327
 328 With two or three C-u, or a prefix argument which is an odd
 329 multiple of 2, just clear the record of the current window
 330 configuration register, so that the next switch doesn't save the
 331 prevailing configuration."
 332   (interactive
 333    (let ((arg current-prefix-arg))
 334      (list (if (or (and (consp arg) (= (car arg) 16) (= (car arg) 64))
 335                    (and (integerp arg) (not (zerop (logand arg 2)))))
 336                nil
 337              (register-read-with-preview "Switch to window configuration: "))
 338            (or (and (consp arg) (= (car arg) 4) (= (car arg) 64))
 339                (and (integerp arg) (not (zerop (logand arg 1))))))))
 340
 341   (let ((previous mdw-current-window-configuration)
 342         (current-windows (list (current-window-configuration)
 343                                (point-marker)))
 344         (register-value (and register (get-register register))))
 345     (when (and mdw-current-window-configuration (not no-save))
 346       (set-register mdw-current-window-configuration current-windows))
 347     (cond ((null register)
 348            (setq mdw-current-window-configuration nil)
 349            (if previous
 350                (message "Left window configuration `%c'." previous)
 351              (message "Nothing to do!")))
 352           ((not (or (null register-value)
 353                     (and (consp register-value)
 354                          (window-configuration-p (car register-value))
 355                          (integer-or-marker-p (cadr register-value))
 356                          (null (cl-caddr register-value)))))
 357            (error "Register `%c' is not a window configuration" register))
 358           (t
 359            (cond ((null register-value)
 360                   (set-register register current-windows)
 361                   (message "Started new window configuration `%c'."
 362                            register))
 363                  (t
 364                   (set-window-configuration (car register-value))
 365                   (goto-char (cadr register-value))
 366                   (message "Switched to window configuration `%c'."
 367                            register)))
 368            (setq mdw-current-window-configuration register)))))
 369
 370 ;; Don't raise windows unless I say so.
 371
 372 (defcustom mdw-inhibit-raise-frame nil
 373   "Whether `raise-frame' should do nothing when the frame is mapped."
 374   :type 'boolean)
 375
 376 (defadvice raise-frame
 377     (around mdw-inhibit (&optional frame) activate compile)
 378   "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the
 379 frame is actually mapped on the screen."
 380   (if mdw-inhibit-raise-frame
 381       (make-frame-visible frame)
 382     ad-do-it))
 383
 384 (defmacro mdw-advise-to-inhibit-raise-frame (function)
 385   "Advise the FUNCTION not to raise frames, even if it wants to."
 386   `(defadvice ,function
 387        (around mdw-inhibit-raise (&rest hunoz) activate compile)
 388      "Don't raise the window unless you have to."
 389      (let ((mdw-inhibit-raise-frame t))
 390        ad-do-it)))
 391
 392 (mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus)
 393 (mdw-advise-to-inhibit-raise-frame appt-disp-window)
 394 (mdw-advise-to-inhibit-raise-frame mouse-select-window)
 395
 396 ;; Bug fix for markdown-mode, which breaks point positioning during
 397 ;; `query-replace'.
 398 (defadvice markdown-check-change-for-wiki-link
 399     (around mdw-save-match activate compile)
 400   "Save match data around the `markdown-mode' `after-change-functions' hook."
 401   (save-match-data ad-do-it))
 402
 403 ;; Bug fix for `bbdb-canonicalize-address': on Emacs 24, `run-hook-with-args'
 404 ;; always returns nil, with the result that all email addresses are lost.
 405 ;; Replace the function entirely.
 406 (defadvice bbdb-canonicalize-address
 407     (around mdw-bug-fix activate compile)
 408   "Don't use `run-hook-with-args', because that doesn't work."
 409   (let ((net (ad-get-arg 0)))
 410
 411     ;; Make sure this is a proper hook list.
 412     (if (functionp bbdb-canonicalize-net-hook)
 413         (setq bbdb-canonicalize-net-hook (list bbdb-canonicalize-net-hook)))
 414
 415     ;; Iterate over the hooks until things converge.
 416     (let ((donep nil))
 417       (while (not donep)
 418         (let (next (changep nil)
 419               hook (hooks bbdb-canonicalize-net-hook))
 420           (while hooks
 421             (setq hook (pop hooks))
 422             (setq next (funcall hook net))
 423             (if (not (equal next net))
 424                 (setq changep t
 425                       net next)))
 426           (setq donep (not changep)))))
 427     (setq ad-return-value net)))
 428
 429 ;; Transient mark mode hacks.
 430
 431 (defadvice exchange-point-and-mark
 432     (around mdw-highlight (&optional arg) activate compile)
 433   "Maybe don't actually exchange point and mark.
 434 If `transient-mark-mode' is on and the mark is inactive, then
 435 just activate it.  A non-trivial prefix argument will force the
 436 usual behaviour.  A trivial prefix argument (i.e., just C-u) will
 437 activate the mark and temporarily enable `transient-mark-mode' if
 438 it's currently off."
 439   (cond ((or mark-active
 440              (and (not transient-mark-mode) (not arg))
 441              (and arg (or (not (consp arg))
 442                           (not (= (car arg) 4)))))
 443          ad-do-it)
 444         (t
 445          (or transient-mark-mode (setq transient-mark-mode 'only))
 446          (set-mark (mark t)))))
 447
 448 ;; Functions for sexp diary entries.
 449
 450 (defvar mdw-diary-for-org-mode-p nil
 451   "Display diary along with the agenda?")
 452
 453 (defun mdw-not-org-mode (form)
 454   "As FORM, but not in Org mode agenda."
 455   (and (not mdw-diary-for-org-mode-p)
 456        (eval form)))
 457
 458 (defun mdw-weekday (l)
 459   "Return non-nil if `date' falls on one of the days of the week in L.
 460 L is a list of day numbers (from 0 to 6 for Sunday through to
 461 Saturday) or symbols `sunday', `monday', etc. (or a mixture).  If
 462 the date stored in `date' falls on a listed day, then the
 463 function returns non-nil."
 464   (let ((d (calendar-day-of-week date)))
 465     (or (memq d l)
 466         (memq (nth d '(sunday monday tuesday wednesday
 467                               thursday friday saturday)) l))))
 468
 469 (defun mdw-discordian-date (date)
 470   "Return the Discordian calendar date corresponding to DATE.
 471
 472 The return value is (YOLD . st-tibs-day) or (YOLD SEASON DAYNUM DOW).
 473
 474 The original is by David Pearson.  I modified it to produce date components
 475 as output rather than a string."
 476   (let* ((days ["Sweetmorn" "Boomtime" "Pungenday"
 477                 "Prickle-Prickle" "Setting Orange"])
 478          (months ["Chaos" "Discord" "Confusion"
 479                   "Bureaucracy" "Aftermath"])
 480          (day-count [0 31 59 90 120 151 181 212 243 273 304 334])
 481          (year (- (calendar-extract-year date) 1900))
 482          (month (1- (calendar-extract-month date)))
 483          (day (1- (calendar-extract-day date)))
 484          (julian (+ (aref day-count month) day))
 485          (dyear (+ year 3066)))
 486     (if (and (= month 1) (= day 28))
 487         (cons dyear 'st-tibs-day)
 488       (list dyear
 489             (aref months (floor (/ julian 73)))
 490             (1+ (mod julian 73))
 491             (aref days (mod julian 5))))))
 492
 493 (defun mdw-diary-discordian-date ()
 494   "Convert the date in `date' to a string giving the Discordian date."
 495   (let* ((ddate (mdw-discordian-date date))
 496          (tail (format "in the YOLD %d" (car ddate))))
 497     (if (eq (cdr ddate) 'st-tibs-day)
 498         (format "St Tib's Day %s" tail)
 499       (let ((season (cadr ddate))
 500             (daynum (cl-caddr ddate))
 501             (dayname (cl-cadddr ddate)))
 502       (format "%s, the %d%s day of %s %s"
 503               dayname
 504               daynum
 505               (let ((ldig (mod daynum 10)))
 506                 (cond ((= ldig 1) "st")
 507                       ((= ldig 2) "nd")
 508                       ((= ldig 3) "rd")
 509                       (t "th")))
 510               season
 511               tail)))))
 512
 513 (defun mdw-todo (&optional when)
 514   "Return non-nil today, or on WHEN, whichever is later."
 515   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
 516         (d (calendar-absolute-from-gregorian date)))
 517     (if when
 518         (setq w (max w (calendar-absolute-from-gregorian
 519                         (cond
 520                          ((not european-calendar-style)
 521                           when)
 522                          ((> (car when) 100)
 523                           (list (nth 1 when)
 524                                 (nth 2 when)
 525                                 (nth 0 when)))
 526                          (t
 527                           (list (nth 1 when)
 528                                 (nth 0 when)
 529                                 (nth 2 when))))))))
 530     (eq w d)))
 531
 532 (defadvice org-agenda-list (around mdw-preserve-links activate)
 533   (let ((mdw-diary-for-org-mode-p t))
 534     ad-do-it))
 535
 536 (defcustom diary-time-regexp nil
 537   "Regexp matching times in the diary buffer."
 538   :type 'regexp)
 539
 540 (defadvice diary-add-to-list (before mdw-trim-leading-space compile activate)
 541   "Trim leading space from the diary entry string."
 542   (save-match-data
 543     (let ((str (ad-get-arg 1))
 544           (done nil) old)
 545       (while (not done)
 546         (setq old str)
 547         (setq str (cond ((null str) nil)
 548                         ((string-match "\\(^\\|\n\\)[ \t]+" str)
 549                          (replace-match "\\1" nil nil str))
 550                         ((and mdw-diary-for-org-mode-p
 551                               (string-match (concat
 552                                              "\\(^\\|\n\\)"
 553                                              "\\(" diary-time-regexp
 554                                              "\\(-" diary-time-regexp "\\)?"
 555                                              "\\)"
 556                                              "\\(\t[ \t]*\\| [ \t]+\\)")
 557                                             str))
 558                          (replace-match "\\1\\2 " nil nil str))
 559                         ((and (not mdw-diary-for-org-mode-p)
 560                               (string-match "\\[\\[[^][]*]\\[\\([^][]*\\)]]"
 561                                             str))
 562                          (replace-match "\\1" nil nil str))
 563                         (t str)))
 564         (if (equal str old) (setq done t)))
 565       (ad-set-arg 1 str))))
 566
 567 (defadvice org-bbdb-anniversaries (after mdw-fixup-list compile activate)
 568   "Return a string rather than a list."
 569   (with-temp-buffer
 570     (let ((anyp nil))
 571       (dolist (e (let ((ee ad-return-value))
 572                    (if (atom ee) (list ee) ee)))
 573         (when e
 574           (when anyp (insert ?\n))
 575           (insert e)
 576           (setq anyp t)))
 577       (setq ad-return-value
 578               (and anyp (buffer-string))))))
 579
 580 ;; Fighting with Org-mode's evil key maps.
 581
 582 (defcustom mdw-evil-keymap-keys
 583   '(([S-up] . [?\C-c up])
 584     ([S-down] . [?\C-c down])
 585     ([S-left] . [?\C-c left])
 586     ([S-right] . [?\C-c right])
 587     (([M-up] [?\e up]) . [C-up])
 588     (([M-down] [?\e down]) . [C-down])
 589     (([M-left] [?\e left]) . [C-left])
 590     (([M-right] [?\e right]) . [C-right]))
 591   "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
 592 The value is an alist mapping evil keys (as a list, or singleton)
 593 to good keys (in the same form)."
 594   :type '(alist :key-type (choice key-sequence (repeat key-sequence))
 595                 :value-type key-sequence))
 596
 597 (defun mdw-clobber-evil-keymap (keymap)
 598   "Replace evil key bindings in the KEYMAP.
 599 Evil key bindings are defined in `mdw-evil-keymap-keys'."
 600   (dolist (entry mdw-evil-keymap-keys)
 601     (let ((binding nil)
 602           (keys (if (listp (car entry))
 603                     (car entry)
 604                   (list (car entry))))
 605           (replacements (if (listp (cdr entry))
 606                             (cdr entry)
 607                           (list (cdr entry)))))
 608       (catch 'found
 609         (dolist (key keys)
 610           (setq binding (lookup-key keymap key))
 611           (when binding
 612             (throw 'found nil))))
 613       (when binding
 614         (dolist (key keys)
 615           (define-key keymap key nil))
 616         (dolist (key replacements)
 617           (define-key keymap key binding))))))
 618
 619 (defcustom mdw-org-latex-defs
 620   '(("strayman"
 621      "\\documentclass{strayman}
 622 \\usepackage[utf8]{inputenc}
 623 \\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
 624 \\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
 625      ("\\section{%s}" . "\\section*{%s}")
 626      ("\\subsection{%s}" . "\\subsection*{%s}")
 627      ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
 628      ("\\paragraph{%s}" . "\\paragraph*{%s}")
 629      ("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
 630   "Additional LaTeX class definitions."
 631   :type '(alist :key-type string
 632                 :value-type (list string
 633                                   (alist :inline t
 634                                          :key-type string
 635                                          :value-type string))))
 636
 637 (setq org-emphasis-regexp-components
 638         '("- \t('\"{}"                  ; prematch
 639           "- \t.,:!?;'\")}\\["          ; postmatch
 640           " \t\r\n"                     ; /forbidden/ as border
 641           "."                           ; body regexp
 642           1))                           ; maximum newlines
 643
 644 (setq org-entities-user
 645         ;; NAME LATEX MATHP HTML ASCII LATIN1 UTF8
 646         '(("relax" "" nil "" "" "" "")))
 647
 648 (eval-after-load "org-latex"
 649   '(setq org-export-latex-classes
 650            (append mdw-org-latex-defs org-export-latex-classes)))
 651
 652 (eval-after-load "ox-latex"
 653   '(setq org-latex-classes (append mdw-org-latex-defs org-latex-classes)
 654          org-latex-caption-above nil
 655          org-latex-default-packages-alist '(("AUTO" "inputenc" t)
 656                                             ("T1" "fontenc" t)
 657                                             ("" "fixltx2e" nil)
 658                                             ("" "graphicx" t)
 659                                             ("" "longtable" nil)
 660                                             ("" "float" nil)
 661                                             ("" "wrapfig" nil)
 662                                             ("" "rotating" nil)
 663                                             ("normalem" "ulem" t)
 664                                             ("" "textcomp" t)
 665                                             ("" "marvosym" t)
 666                                             ("" "wasysym" t)
 667                                             ("" "amssymb" t)
 668                                             ("" "hyperref" nil)
 669                                             "\\tolerance=1000")))
 670
 671 (setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i"
 672       org-export-docbook-xsl-fo-proc-command "fop %i.safe %o"
 673       org-export-docbook-xslt-stylesheet
 674         "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl")
 675
 676 ;; Glasses.
 677
 678 (setq glasses-separator "-"
 679       glasses-separate-parentheses-p nil
 680       glasses-uncapitalize-p t)
 681
 682 ;; Some hacks to do with window placement.
 683
 684 (defvar mdw-designated-window nil
 685   "The window chosen by `mdw-designate-window', or nil.")
 686
 687 (defun mdw-designated-window-display-buffer-function (buffer not-this-window)
 688   "Display buffer function to use the designated window."
 689   (unless mdw-designated-window (error "No designated window!"))
 690   (prog1 mdw-designated-window
 691     (with-selected-window mdw-designated-window (switch-to-buffer buffer))
 692     (setq mdw-designated-window nil
 693           display-buffer-function nil)))
 694
 695 (defun mdw-display-buffer-in-designated-window (buffer alist)
 696   "Display function to use the designated window."
 697   (prog1 mdw-designated-window
 698     (when mdw-designated-window
 699       (with-selected-window mdw-designated-window
 700         (switch-to-buffer buffer nil t)))
 701     (setq mdw-designated-window nil)))
 702
 703 (defun mdw-designate-window (cancel)
 704   "Use the selected window for the next pop-up buffer.
 705 With a prefix argument, clear the designated window."
 706   (interactive "P")
 707   (let ((window (selected-window)))
 708     (cond (cancel
 709            (cond (mdw-designated-window
 710                   (setq mdw-designated-window nil)
 711                   (unless (mdw-emacs-version-p 24)
 712                     (setq display-buffer-function nil))
 713                   (message "Window designation cleared."))
 714                  (t
 715                   (message "No designated window active."))))
 716           ((window-dedicated-p window)
 717            (error "Window is dedicated to its buffer."))
 718           (t
 719            (setq mdw-designated-window window)
 720            (unless (mdw-emacs-version-p 24)
 721              (setq display-buffer-function
 722                      #'mdw-designated-window-display-buffer-function))
 723            (message "Window designated.")))))
 724
 725 (when (mdw-emacs-version-p 24)
 726   (setq display-buffer-base-action
 727           (let* ((action display-buffer-base-action)
 728                  (funcs (car action))
 729                  (alist (cdr action)))
 730             (cons (cons 'mdw-display-buffer-in-designated-window funcs)
 731                   alist))))
 732
 733 (defun mdw-clobber-other-windows-showing-buffer (buffer-or-name)
 734   "Arrange that no windows on other frames are showing BUFFER-OR-NAME."
 735   (interactive "bBuffer: ")
 736   (let ((home-frame (selected-frame))
 737         (buffer (get-buffer buffer-or-name))
 738         (safe-buffer (get-buffer "*scratch*")))
 739     (dolist (frame (frame-list))
 740       (unless (eq frame home-frame)
 741         (dolist (window (window-list frame))
 742           (when (eq (window-buffer window) buffer)
 743             (set-window-buffer window safe-buffer)))))))
 744
 745 (defvar mdw-inhibit-walk-windows nil
 746   "If non-nil, then `walk-windows' does nothing.
 747 This is used by advice on `switch-to-buffer-other-frame' to inhibit finding
 748 buffers in random frames.")
 749
 750 (setq display-buffer--other-frame-action
 751         '((display-buffer-reuse-window display-buffer-pop-up-frame)
 752           (reusable-frames . nil)
 753           (inhibit-same-window . t)))
 754
 755 (defadvice walk-windows (around mdw-inhibit activate)
 756   "If `mdw-inhibit-walk-windows' is non-nil, then do nothing."
 757   (and (not mdw-inhibit-walk-windows)
 758        ad-do-it))
 759
 760 (defadvice switch-to-buffer-other-frame
 761     (around mdw-always-new-frame activate)
 762   "Always make a new frame.
 763 Even if an existing window in some random frame looks tempting."
 764   (let ((mdw-inhibit-walk-windows t)) ad-do-it))
 765
 766 (defadvice display-buffer (before mdw-inhibit-other-frames activate)
 767   "Don't try to do anything fancy with other frames.
 768 Pretend they don't exist.  They might be on other display devices."
 769   (ad-set-arg 2 nil))
 770
 771 (setq even-window-sizes nil
 772       even-window-heights nil
 773       display-buffer-reuse-frames nil)
 774
 775 (defvar mdw-fallback-window-alist nil
 776   "Alist mapping frames to fallback windows.")
 777
 778 (defun mdw-cleanup-fallback-window-alist ()
 779   "Remove entries for dead frames and windows from the fallback alist."
 780   (let ((prev nil)
 781         (cursor mdw-fallback-window-alist))
 782     (while cursor
 783       (let* ((assoc (car cursor))
 784              (tail (cdr cursor)))
 785         (cond ((and (frame-live-p (car assoc))
 786                     (window-live-p (cdr assoc)))
 787                (setq prev cursor))
 788               ((null prev)
 789                (setq mdw-fallback-window-alist tail))
 790               (t
 791                (setcdr prev tail)))
 792         (setq cursor tail)))))
 793
 794 (defun mdw-set-fallback-window (cancel)
 795   "Prefer the selected window for pop-up buffers in this frame.
 796 With a prefix argument, clear the fallback window."
 797   (interactive "P")
 798   (let* ((frame (selected-frame)) (window (selected-window))
 799          (assoc (assq (selected-frame) mdw-fallback-window-alist)))
 800     (cond (cancel
 801            (cond (assoc
 802                   (setcdr assoc nil)
 803                   (message "Fallback window cleared."))
 804                  (t
 805                   (message "No fallback window active in this frame."))))
 806           ((window-dedicated-p window)
 807            (error "Window is dedicated to its buffer."))
 808           (t
 809            (if assoc (setcdr assoc window)
 810              (push (cons frame window) mdw-fallback-window-alist))
 811            (message "Fallback window set.")))
 812     (mdw-cleanup-fallback-window-alist)))
 813
 814 (defun mdw-last-window-in-frame-p (window)
 815   "Return whether WINDOW is the last in its frame."
 816   (catch 'done
 817     (while window
 818       (let ((next (window-next-sibling window)))
 819         (while (and next (window-minibuffer-p next))
 820           (setq next (window-next-sibling next)))
 821         (if next (throw 'done nil)))
 822       (setq window (window-parent window)))
 823     t))
 824
 825 (defun mdw-display-buffer-in-tolerable-window (buffer alist)
 826   "Try finding a tolerable window in which to display BUFFER.
 827 Begone, foul DWIMmerlaik!
 828
 829 This is all totally subject to arbitrary change in the future, but the
 830 emphasis is on predictability rather than crazy DWIMmery."
 831   (let* ((selected (selected-window)) chosen
 832          (fallback (assq (selected-frame) mdw-fallback-window-alist))
 833          (full-height-p (window-full-height-p selected))
 834          (full-width-p (window-full-width-p selected)))
 835     (cond
 836
 837      ((and fallback (window-live-p (cdr fallback)))
 838       ;; There's a fallback window set for this frame.  Use it.
 839
 840       (setq chosen (cdr fallback)
 841             selected nil)
 842       (display-buffer-record-window 'window chosen buffer))
 843
 844      ((and full-height-p full-width-p)
 845       ;; We're basically the only window in the frame.  If we want to get
 846       ;; anywhere, we'll have to split the window.
 847
 848       (let ((width (window-width selected))
 849             (preferred-width (mdw-preferred-column-width)))
 850         (if (and (>= width (mdw-frame-width-for-columns 2 preferred-width))
 851                  (mdw-frame-width-quantized-p width preferred-width))
 852             (setq chosen (split-window-right preferred-width))
 853           (setq chosen (split-window-below)))
 854         (display-buffer-record-window 'window chosen buffer)))
 855
 856      ((mdw-last-window-in-frame-p selected)
 857       ;; This is the last window in the frame.  I don't think I want to
 858       ;; clobber the first window, so rebound and clobber the previous one
 859       ;; instead.  (This obviously has the same effect if there are only two
 860       ;; windows, but seems more useful if there are three.)
 861
 862       (setq chosen (previous-window selected 'never nil))
 863       (display-buffer-record-window 'reuse chosen buffer))
 864
 865      (t
 866       ;; There's another window in front of us.  Let's use that one.
 867       (setq chosen (next-window selected 'never nil)))
 868       (display-buffer-record-window 'reuse chosen buffer))
 869
 870     (if (eq chosen selected)
 871         (error "Failed to select a different window!"))
 872
 873     (when chosen
 874       (with-selected-window chosen (switch-to-buffer buffer)))
 875     chosen))
 876
 877 ;; Hack the display actions so that they do something sensible.
 878 (setq display-buffer-fallback-action
 879         '((display-buffer--maybe-same-window
 880            display-buffer-reuse-window
 881            display-buffer-pop-up-window
 882            mdw-display-buffer-in-tolerable-window)))
 883
 884 ;; Rename buffers along with files.
 885
 886 (defvar mdw-inhibit-rename-buffer nil
 887   "If non-nil, `rename-file' won't rename the buffer visiting the file.")
 888
 889 (defmacro mdw-advise-to-inhibit-rename-buffer (function)
 890   "Advise FUNCTION to set `mdw-inhibit-rename-buffer' while it runs.
 891
 892 This will prevent `rename-file' from renaming the buffer."
 893   `(defadvice ,function (around mdw-inhibit-rename-buffer compile activate)
 894      "Don't rename the buffer when renaming the underlying file."
 895      (let ((mdw-inhibit-rename-buffer t))
 896        ad-do-it)))
 897 (mdw-advise-to-inhibit-rename-buffer recode-file-name)
 898 (mdw-advise-to-inhibit-rename-buffer set-visited-file-name)
 899 (mdw-advise-to-inhibit-rename-buffer backup-buffer)
 900
 901 (defadvice rename-file (after mdw-rename-buffers (from to &optional forcep)
 902                         compile activate)
 903   "If a buffer is visiting the file, rename it to match the new name.
 904
 905 Don't do this if `mdw-inhibit-rename-buffer' is non-nil."
 906   (unless mdw-inhibit-rename-buffer
 907     (let ((buffer (get-file-buffer from)))
 908       (when buffer
 909         (let ((to (if (not (string= (file-name-nondirectory to) "")) to
 910                     (concat to (file-name-nondirectory from)))))
 911           (with-current-buffer buffer
 912             (set-visited-file-name to nil t)))))))
 913
 914 ;;;--------------------------------------------------------------------------
 915 ;;; Improved compilation machinery.
 916
 917 ;; Uprated version of M-x compile.
 918
 919 (setq compile-command
 920         (format "nice %smake -j%d -k"
 921                 (if (executable-find "ionice") "ionice -c3 " "")
 922                 (let ((ncpu (with-temp-buffer
 923                               (insert-file-contents "/proc/cpuinfo")
 924                               (buffer-string)
 925                               (count-matches "^processor\\s-*:"))))
 926                   (ceiling (* 3 ncpu) 2))))
 927
 928 (defun mdw-compilation-buffer-name (mode)
 929   (concat "*" (downcase mode) ": "
 930           (abbreviate-file-name default-directory) "*"))
 931 (setq compilation-buffer-name-function 'mdw-compilation-buffer-name)
 932
 933 (eval-after-load "compile"
 934   '(progn
 935      (define-key compilation-shell-minor-mode-map "\C-c\M-g" 'recompile)))
 936
 937 (defadvice compile (around hack-environment compile activate)
 938   "Hack the environment inherited by inferiors in the compilation."
 939   (let ((process-environment (copy-tree process-environment)))
 940     (setenv "LD_PRELOAD" nil)
 941     ad-do-it))
 942
 943 (defun mdw-compile (command &optional directory comint)
 944   "Initiate a compilation COMMAND, maybe in a different DIRECTORY.
 945 The DIRECTORY may be nil to not change.  If COMINT is t, then
 946 start an interactive compilation.
 947
 948 Interactively, prompt for the command if the variable
 949 `compilation-read-command' is non-nil, or if requested through
 950 the prefix argument.  Prompt for the directory, and run
 951 interactively, if requested through the prefix.
 952
 953 Use a prefix of 4, 6, 12, or 14, or type C-u between one and three times, to
 954 force prompting for a directory.
 955
 956 Use a prefix of 2, 6, 10, or 14, or type C-u three times, to force
 957 prompting for the command.
 958
 959 Use a prefix of 8, 10, 12, or 14, or type C-u twice or three times,
 960 to force interactive compilation."
 961   (interactive
 962    (let* ((prefix (prefix-numeric-value current-prefix-arg))
 963           (command (eval compile-command))
 964           (dir (and (cl-plusp (logand prefix #x54))
 965                     (read-directory-name "Compile in directory: "))))
 966      (list (if (or compilation-read-command
 967                    (cl-plusp (logand prefix #x42)))
 968                (compilation-read-command command)
 969              command)
 970            dir
 971            (cl-plusp (logand prefix #x58)))))
 972   (let ((default-directory (or directory default-directory)))
 973     (compile command comint)))
 974
 975 ;; Flymake support.
 976
 977 (defun mdw-find-build-dir (build-file)
 978   (catch 'found
 979     (let* ((src-dir (file-name-as-directory (expand-file-name ".")))
 980            (dir src-dir))
 981       (cl-loop
 982         (when (file-exists-p (concat dir build-file))
 983           (throw 'found dir))
 984         (let ((sub (expand-file-name (file-relative-name src-dir dir)
 985                                      (concat dir "build/"))))
 986           (catch 'give-up
 987             (cl-loop
 988               (when (file-exists-p (concat sub build-file))
 989                 (throw 'found sub))
 990               (when (string= sub dir) (throw 'give-up nil))
 991               (setq sub (file-name-directory (directory-file-name sub))))))
 992         (when (string= dir
 993                        (setq dir (file-name-directory
 994                                   (directory-file-name dir))))
 995           (throw 'found nil))))))
 996
 997 (defun mdw-flymake-make-init ()
 998   (let ((build-dir (mdw-find-build-dir "Makefile")))
 999     (and build-dir
1000          (let ((tmp-src (flymake-init-create-temp-buffer-copy
1001                          #'flymake-create-temp-inplace)))
1002            (flymake-get-syntax-check-program-args
1003             tmp-src build-dir t t
1004             #'flymake-get-make-cmdline)))))
1005
1006 (setq flymake-allowed-file-name-masks
1007         '(("\\.\\(?:[cC]\\|cc\\|cpp\\|cxx\\|c\\+\\+\\)\\'"
1008            mdw-flymake-make-init)
1009           ("\\.\\(?:[hH]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'"
1010            mdw-flymake-master-make-init)
1011           ("\\.p[lm]" flymake-perl-init)))
1012
1013 (setq flymake-mode-map
1014         (let ((map (if (boundp 'flymake-mode-map)
1015                        flymake-mode-map
1016                      (make-sparse-keymap))))
1017           (define-key map [?\C-c ?\C-f ?\C-p] 'flymake-goto-prev-error)
1018           (define-key map [?\C-c ?\C-f ?\C-n] 'flymake-goto-next-error)
1019           (define-key map [?\C-c ?\C-f ?\C-c] 'flymake-compile)
1020           (define-key map [?\C-c ?\C-f ?\C-k] 'flymake-stop-all-syntax-checks)
1021           (define-key map [?\C-c ?\C-f ?\C-e] 'flymake-popup-current-error-menu)
1022           map))
1023
1024 ;;;--------------------------------------------------------------------------
1025 ;;; Mail and news hacking.
1026
1027 (define-derived-mode  mdwmail-mode mail-mode "[mdw] mail"
1028   "Major mode for editing news and mail messages from external programs.
1029 Not much right now.  Just support for doing MailCrypt stuff."
1030   :syntax-table nil
1031   :abbrev-table nil
1032   (run-hooks 'mail-setup-hook))
1033
1034 (define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
1035
1036 (add-hook 'mdwail-mode-hook
1037           (lambda ()
1038             (set-buffer-file-coding-system 'utf-8)
1039             (make-local-variable 'paragraph-separate)
1040             (make-local-variable 'paragraph-start)
1041             (setq paragraph-start
1042                     (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
1043                             paragraph-start))
1044             (setq paragraph-separate
1045                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
1046                           paragraph-separate))))
1047
1048 ;; How to encrypt in mdwmail.
1049
1050 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
1051   (or start
1052       (setq start (save-excursion
1053                     (goto-char (point-min))
1054                     (or (search-forward "\n\n" nil t) (point-min)))))
1055   (or end
1056       (setq end (point-max)))
1057   (mc-encrypt-generic recip scm start end from sign))
1058
1059 ;; How to sign in mdwmail.
1060
1061 (defun mdwmail-mc-sign (key scm start end uclr)
1062   (or start
1063       (setq start (save-excursion
1064                     (goto-char (point-min))
1065                     (or (search-forward "\n\n" nil t) (point-min)))))
1066   (or end
1067       (setq end (point-max)))
1068   (mc-sign-generic key scm start end uclr))
1069
1070 ;; Some signature mangling.
1071
1072 (defun mdwmail-mangle-signature ()
1073   (save-excursion
1074     (goto-char (point-min))
1075     (perform-replace "\n-- \n" "\n-- " nil nil nil)))
1076 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
1077 (add-hook 'message-setup-hook 'mdwmail-mangle-signature)
1078
1079 ;; Insert my login name into message-ids, so I can score replies.
1080
1081 (defadvice message-unique-id (after mdw-user-name last activate compile)
1082   "Ensure that the user's name appears at the end of the message-id string,
1083 so that it can be used for convenient filtering."
1084   (setq ad-return-value (concat ad-return-value "." (user-login-name))))
1085
1086 ;; Tell my movemail hack where movemail is.
1087 ;;
1088 ;; This is needed to shup up warnings about LD_PRELOAD.
1089
1090 (let ((path exec-path))
1091   (while path
1092     (let ((try (expand-file-name "movemail" (car path))))
1093       (if (file-executable-p try)
1094           (setenv "REAL_MOVEMAIL" try))
1095       (setq path (cdr path)))))
1096
1097 ;; AUTHINFO GENERIC kludge.
1098
1099 (defcustom nntp-authinfo-generic nil
1100   "Set to the `NNTPAUTH' string to pass on to `authinfo-kludge'.
1101
1102 Use this to arrange for per-server settings."
1103   :type '(choice (const :tag "Use `NNTPAUTH' environment variable" nil)
1104                  string)
1105   :safe 'stringp)
1106
1107 (defun nntp-open-authinfo-kludge (buffer)
1108   "Open a connection to SERVER using `authinfo-kludge'."
1109   (let ((proc (start-process "nntpd" buffer
1110                              "env" (concat "NNTPAUTH="
1111                                            (or nntp-authinfo-generic
1112                                                (getenv "NNTPAUTH")
1113                                                (error "NNTPAUTH unset")))
1114                              "authinfo-kludge" nntp-address)))
1115     (set-buffer buffer)
1116     (nntp-wait-for-string "^\r*200")
1117     (beginning-of-line)
1118     (delete-region (point-min) (point))
1119     proc))
1120
1121 (eval-after-load "erc"
1122   '(load "~/.ercrc.el"))
1123
1124 ;; Heavy-duty Gnus patching.
1125
1126 (defun mdw-nnimap-transform-headers ()
1127   (goto-char (point-min))
1128   (let (article lines size string)
1129     (cl-block nil
1130       (while (not (eobp))
1131         (while (not (looking-at "\\* [0-9]+ FETCH"))
1132           (delete-region (point) (progn (forward-line 1) (point)))
1133           (when (eobp)
1134             (cl-return)))
1135         (goto-char (match-end 0))
1136         ;; Unfold quoted {number} strings.
1137         (while (re-search-forward
1138                 "[^]][ (]{\\([0-9]+\\)}\r?\n"
1139                 (save-excursion
1140                   ;; Start of the header section.
1141                   (or (re-search-forward "] {[0-9]+}\r?\n" nil t)
1142                       ;; Start of the next FETCH.
1143                       (re-search-forward "\\* [0-9]+ FETCH" nil t)
1144                       (point-max)))
1145                 t)
1146           (setq size (string-to-number (match-string 1)))
1147           (delete-region (+ (match-beginning 0) 2) (point))
1148           (setq string (buffer-substring (point) (+ (point) size)))
1149           (delete-region (point) (+ (point) size))
1150           (insert (format "%S" (subst-char-in-string ?\n ?\s string)))
1151           ;; [mdw] missing from upstream
1152           (backward-char 1))
1153         (beginning-of-line)
1154         (setq article
1155                 (and (re-search-forward "UID \\([0-9]+\\)"
1156                                         (line-end-position)
1157                                         t)
1158                      (match-string 1)))
1159         (setq lines nil)
1160         (setq size
1161                 (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
1162                                         (line-end-position)
1163                                         t)
1164                      (match-string 1)))
1165         (beginning-of-line)
1166         (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
1167           (let ((structure (ignore-errors
1168                              (read (current-buffer)))))
1169             (while (and (consp structure)
1170                         (not (atom (car structure))))
1171               (setq structure (car structure)))
1172             (setq lines (if (and
1173                              (stringp (car structure))
1174                              (equal (upcase (nth 0 structure)) "MESSAGE")
1175                              (equal (upcase (nth 1 structure)) "RFC822"))
1176                             (nth 9 structure)
1177                           (nth 7 structure)))))
1178         (delete-region (line-beginning-position) (line-end-position))
1179         (insert (format "211 %s Article retrieved." article))
1180         (forward-line 1)
1181         (when size
1182           (insert (format "Chars: %s\n" size)))
1183         (when lines
1184           (insert (format "Lines: %s\n" lines)))
1185         ;; Most servers have a blank line after the headers, but
1186         ;; Davmail doesn't.
1187         (unless (re-search-forward "^\r$\\|^)\r?$" nil t)
1188           (goto-char (point-max)))
1189         (delete-region (line-beginning-position) (line-end-position))
1190         (insert ".")
1191         (forward-line 1)))))
1192
1193 (eval-after-load 'nnimap
1194   '(defalias 'nnimap-transform-headers
1195      (symbol-function 'mdw-nnimap-transform-headers)))
1196
1197 (defadvice gnus-other-frame (around mdw-hack-frame-width compile activate)
1198   "Always arrange for mail/news frames to be 80 columns wide."
1199   (let ((default-frame-alist (cons `(width . ,(+ 80 mdw-frame-width-fudge))
1200                                    (delete* 'width default-frame-alist
1201                                             :key #'car))))
1202     ad-do-it))
1203
1204 ;; Preferred programs.
1205
1206 (setq mailcap-user-mime-data
1207         '(((type . "application/pdf") (viewer . "mupdf %s"))))
1208
1209 ;;;--------------------------------------------------------------------------
1210 ;;; Utility functions.
1211
1212 (or (fboundp 'line-number-at-pos)
1213     (defun line-number-at-pos (&optional pos)
1214       (let ((opoint (or pos (point))) start)
1215         (save-excursion
1216           (save-restriction
1217             (goto-char (point-min))
1218             (widen)
1219             (forward-line 0)
1220             (setq start (point))
1221             (goto-char opoint)
1222             (forward-line 0)
1223             (1+ (count-lines 1 (point))))))))
1224
1225 (defun mdw-uniquify-alist (&rest alists)
1226   "Return the concatenation of the ALISTS with duplicate elements removed.
1227 The first association with a given key prevails; others are
1228 ignored.  The input lists are not modified, although they'll
1229 probably become garbage."
1230   (and alists
1231        (let ((start-list (cons nil nil)))
1232          (mdw-do-uniquify start-list
1233                           start-list
1234                           (car alists)
1235                           (cdr alists)))))
1236
1237 (defun mdw-do-uniquify (done end l rest)
1238   "A helper function for mdw-uniquify-alist.
1239 The DONE argument is a list whose first element is `nil'.  It
1240 contains the uniquified alist built so far.  The leading `nil' is
1241 stripped off at the end of the operation; it's only there so that
1242 DONE always references a cons cell.  END refers to the final cons
1243 cell in the DONE list; it is modified in place each time to avoid
1244 the overheads of `append'ing all the time.  The L argument is the
1245 alist we're currently processing; the remaining alists are given
1246 in REST."
1247
1248   ;; There are several different cases to deal with here.
1249   (cond
1250
1251    ;; Current list isn't empty.  Add the first item to the DONE list if
1252    ;; there's not an item with the same KEY already there.
1253    (l (or (assoc (car (car l)) done)
1254           (progn
1255             (setcdr end (cons (car l) nil))
1256             (setq end (cdr end))))
1257       (mdw-do-uniquify done end (cdr l) rest))
1258
1259    ;; The list we were working on is empty.  Shunt the next list into the
1260    ;; current list position and go round again.
1261    (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
1262
1263    ;; Everything's done.  Remove the leading `nil' from the DONE list and
1264    ;; return it.  Finished!
1265    (t (cdr done))))
1266
1267 (defun date ()
1268   "Insert the current date in a pleasing way."
1269   (interactive)
1270   (insert (save-excursion
1271             (let ((buffer (get-buffer-create "*tmp*")))
1272               (unwind-protect (progn (set-buffer buffer)
1273                                      (erase-buffer)
1274                                      (shell-command "date +%Y-%m-%d" t)
1275                                      (goto-char (mark))
1276                                      (delete-char -1)
1277                                      (buffer-string))
1278                 (kill-buffer buffer))))))
1279
1280 (defun uuencode (file &optional name)
1281   "UUencodes a file, maybe calling it NAME, into the current buffer."
1282   (interactive "fInput file name: ")
1283
1284   ;; If NAME isn't specified, then guess from the filename.
1285   (if (not name)
1286       (setq name
1287             (substring file
1288                        (or (string-match "[^/]*$" file) 0))))
1289   (print (format "uuencode `%s' `%s'" file name))
1290
1291   ;; Now actually do the thing.
1292   (call-process "uuencode" file t nil name))
1293
1294 (defcustom np-file "~/.np"
1295   "Where the `now-playing' file is."
1296   :type 'file
1297   :safe 'stringp)
1298
1299 (defun np (&optional arg)
1300   "Grabs a `now-playing' string."
1301   (interactive)
1302   (save-excursion
1303     (or arg (progn
1304               (goto-char (point-max))
1305               (insert "\nNP: ")
1306               (insert-file-contents np-file)))))
1307
1308 (defun mdw-version-< (ver-a ver-b)
1309   "Answer whether VER-A is strictly earlier than VER-B.
1310 VER-A and VER-B are version numbers, which are strings containing digit
1311 sequences separated by `.'."
1312   (let* ((la (mapcar (lambda (x) (car (read-from-string x)))
1313                      (split-string ver-a "\\.")))
1314          (lb (mapcar (lambda (x) (car (read-from-string x)))
1315                      (split-string ver-b "\\."))))
1316     (catch 'done
1317       (while t
1318         (cond ((null la) (throw 'done lb))
1319               ((null lb) (throw 'done nil))
1320               ((< (car la) (car lb)) (throw 'done t))
1321               ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb)))
1322               (t (throw 'done nil)))))))
1323
1324 (defun mdw-check-autorevert ()
1325   "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
1326 This takes into consideration whether it's been found using
1327 tramp, which seems to get itself into a twist."
1328   (cond ((not (boundp 'global-auto-revert-ignore-buffer))
1329          nil)
1330         ((and (buffer-file-name)
1331               (fboundp 'tramp-tramp-file-p)
1332               (tramp-tramp-file-p (buffer-file-name)))
1333          (unless global-auto-revert-ignore-buffer
1334            (setq global-auto-revert-ignore-buffer 'tramp)))
1335         ((eq global-auto-revert-ignore-buffer 'tramp)
1336          (setq global-auto-revert-ignore-buffer nil))))
1337
1338 (defadvice find-file (after mdw-autorevert activate)
1339   (mdw-check-autorevert))
1340 (defadvice write-file (after mdw-autorevert activate)
1341   (mdw-check-autorevert))
1342
1343 (defun mdw-auto-revert ()
1344   "Recheck all of the autorevertable buffers, and update VC modelines."
1345   (interactive)
1346   (let ((auto-revert-check-vc-info t))
1347     (auto-revert-buffers)))
1348
1349 ;;;--------------------------------------------------------------------------
1350 ;;; Dired hacking.
1351
1352 (defadvice dired-maybe-insert-subdir
1353     (around mdw-marked-insertion first activate)
1354   "The DIRNAME may be a list of directory names to insert.
1355 Interactively, if files are marked, then insert all of them.
1356 With a numeric prefix argument, select that many entries near
1357 point; with a non-numeric prefix argument, prompt for listing
1358 options."
1359   (interactive
1360    (list (dired-get-marked-files nil
1361                                  (and (integerp current-prefix-arg)
1362                                       current-prefix-arg)
1363                                  #'file-directory-p)
1364          (and current-prefix-arg
1365               (not (integerp current-prefix-arg))
1366               (read-string "Switches for listing: "
1367                            (or dired-subdir-switches
1368                                dired-actual-switches)))))
1369   (let ((dirs (ad-get-arg 0)))
1370     (dolist (dir (if (listp dirs) dirs (list dirs)))
1371       (ad-set-arg 0 dir)
1372       ad-do-it)))
1373
1374 (defun mdw-dired-run (args &optional syncp)
1375   (interactive (let ((file (dired-get-filename t)))
1376                  (list (read-string (format "Arguments for %s: " file))
1377                        current-prefix-arg)))
1378   (funcall (if syncp 'shell-command 'async-shell-command)
1379            (concat (shell-quote-argument (dired-get-filename nil))
1380                    " " args)))
1381
1382 (defadvice dired-do-flagged-delete
1383     (around mdw-delete-if-prefix-argument activate compile)
1384   (let ((delete-by-moving-to-trash (and (null current-prefix-arg)
1385                                         delete-by-moving-to-trash)))
1386     ad-do-it))
1387
1388 (eval-after-load "dired"
1389   '(define-key dired-mode-map "X" 'mdw-dired-run))
1390
1391 ;;;--------------------------------------------------------------------------
1392 ;;; URL viewing.
1393
1394 (defun mdw-w3m-browse-url (url &optional new-session-p)
1395   "Invoke w3m on the URL in its current window, or at least a different one.
1396 If NEW-SESSION-P, start a new session."
1397   (interactive "sURL: \nP")
1398   (save-excursion
1399     (let ((window (selected-window)))
1400       (unwind-protect
1401           (progn
1402             (select-window (or (and (not new-session-p)
1403                                     (get-buffer-window "*w3m*"))
1404                                (progn
1405                                  (if (one-window-p t) (split-window))
1406                                  (get-lru-window))))
1407             (w3m-browse-url url new-session-p))
1408         (select-window window)))))
1409
1410 (eval-after-load 'w3m
1411   '(define-key w3m-mode-map [?\e ?\r] 'w3m-view-this-url-new-session))
1412
1413 (defcustom mdw-good-url-browsers
1414   '(browse-url-firefox
1415     browse-url-mozilla
1416     browse-url-generic
1417     (w3m . mdw-w3m-browse-url)
1418     browse-url-w3)
1419   "List of good browsers for mdw-good-url-browsers.
1420 Each item is a browser function name, or a cons (CHECK . FUNC).
1421 A symbol FOO stands for (FOO . FOO)."
1422   :type '(repeat (choice function (cons function function))))
1423
1424 (defun mdw-good-url-browser ()
1425   "Return a good URL browser.
1426 Trundle the list of such things, finding the first item for which
1427 CHECK is fboundp, and returning the correponding FUNC."
1428   (let ((bs mdw-good-url-browsers) b check func answer)
1429     (while (and bs (not answer))
1430       (setq b (car bs)
1431             bs (cdr bs))
1432       (if (consp b)
1433           (setq check (car b) func (cdr b))
1434         (setq check b func b))
1435       (if (fboundp check)
1436           (setq answer func)))
1437     answer))
1438
1439 (eval-after-load "w3m-search"
1440   '(progn
1441      (dolist
1442          (item
1443           '(("ddg" "DuckDuckGo" "https://duckduckgo.com/?q=%s")
1444             ("sp" "StartPage" "https://www.startpage.com/do/search?query=%s")
1445             ("wp" "Wikipedia"
1446              "https://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
1447             ("g" "Google" "https://www.google.co.uk/search?q=%s")
1448             ("gi" "Images" "https://images.google.com/images?q=%s")
1449             ("gd" "Google Directory"
1450              "https://www.google.com/search?cat=gwd/Top&q=%s")
1451             ("gg" "Google Groups" "https://groups.google.com/groups?q=%s")
1452             ("gm" "Google maps" "https://maps.google.co.uk/maps?q=%s&hl=en")
1453             ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
1454             ("imdb" "IMDb" "https://www.imdb.com/Find?%s")
1455             ("lp" "Launchpad bug by number"
1456              "https://bugs.launchpad.net/bugs/%s")
1457             ("lppkg" "Launchpad bugs by package"
1458              "https://bugs.launchpad.net/%s")
1459             ("msdn" "MSDN"
1460              "https://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
1461             ("debbug" "Debian bug by number"
1462              "https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
1463             ("debbugpkg" "Debian bugs by package"
1464              "https://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")))
1465        (add-to-list 'w3m-search-engine-alist
1466                     (list (cadr item) (cl-caddr item) nil))
1467        (add-to-list 'w3m-uri-replace-alist
1468                     (list (concat "\\`" (car item) ":")
1469                           'w3m-search-uri-replace
1470                           (cadr item))))))
1471
1472 (setq w3m-search-default-engine "DuckDuckGo")
1473
1474 ;;;--------------------------------------------------------------------------
1475 ;;; Paragraph filling.
1476
1477 ;; Useful variables.
1478
1479 (defcustom mdw-fill-prefix nil
1480   "Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
1481 If there's no fill prefix currently set (by the `fill-prefix'
1482 variable) and there's a match from one of the regexps here, it
1483 gets used to set the fill-prefix for the current operation.
1484
1485 The variable is a list of items of the form `PATTERN . PREFIX'; if
1486 the PATTERN matches, the PREFIX is used to set the fill prefix.
1487
1488 A PATTERN is one of the following.
1489
1490   * STRING -- a regular expression, expected to match at point
1491   * (eval . FORM) -- a Lisp form which must evaluate non-nil
1492   * (if COND CONSEQ-PAT ALT-PAT) -- if COND evaluates non-nil, must match
1493     CONSEQ-PAT; otherwise must match ALT-PAT
1494   * (and PATTERN ...) -- must match all of the PATTERNs
1495   * (or PATTERN ...) -- must match at least one PATTERN
1496   * (not PATTERN) -- mustn't match (probably not useful)
1497
1498 A PREFIX is a list of the following kinds of things:
1499
1500   * STRING -- insert a literal string
1501   * (match . N) -- insert the thing matched by bracketed subexpression N
1502   * (pad . N) -- a string of whitespace the same width as subexpression N
1503   * (expr . FORM) -- the result of evaluating FORM
1504
1505 Information about `bracketed subexpressions' comes from the match data,
1506 as modified during matching.")
1507
1508 (make-variable-buffer-local 'mdw-fill-prefix)
1509
1510 (defcustom mdw-hanging-indents
1511   (concat "\\(\\("
1512             "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
1513             "[ \t]+"
1514           "\\)?\\)")
1515   "Standard regexp matching parts of a hanging indent.
1516 This is mainly useful in `auto-fill-mode'."
1517   :type 'regexp)
1518
1519 ;; Utility functions.
1520
1521 (defun mdw-maybe-tabify (s)
1522   "Tabify or untabify the string S, according to `indent-tabs-mode'."
1523   (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
1524     (with-temp-buffer
1525       (save-match-data
1526         (insert s "\n")
1527         (let ((start (point-min)) (end (point-max)))
1528           (funcall tabfun (point-min) (point-max))
1529           (setq s (buffer-substring (point-min) (1- (point-max)))))))))
1530
1531 (defun mdw-fill-prefix-match-p (pat)
1532   "Return non-nil if PAT matches at the current position."
1533   (cond ((stringp pat) (looking-at pat))
1534         ((not (consp pat)) (error "Unknown pattern item `%S'" pat))
1535         ((eq (car pat) 'eval) (eval (cdr pat)))
1536         ((eq (car pat) 'if)
1537          (if (or (null (cdr pat))
1538                  (null (cddr pat))
1539                  (null (cl-cdddr pat))
1540                  (cl-cddddr pat))
1541              (error "Invalid `if' pattern `%S'" pat))
1542          (mdw-fill-prefix-match-p (if (eval (cadr pat))
1543                                       (cl-caddr pat)
1544                                     (cl-cadddr pat))))
1545         ((eq (car pat) 'and)
1546          (let ((pats (cdr pat))
1547                (ok t))
1548            (while (and pats
1549                        (or (mdw-fill-prefix-match-p (car pats))
1550                            (setq ok nil)))
1551              (setq pats (cdr pats)))
1552            ok))
1553         ((eq (car pat) 'or)
1554          (let ((pats (cdr pat))
1555                (ok nil))
1556            (while (and pats
1557                        (or (not (mdw-fill-prefix-match-p (car pats)))
1558                            (progn (setq ok t) nil)))
1559              (setq pats (cdr pats)))
1560            ok))
1561         ((eq (car pat) 'not)
1562          (if (or (null (cdr pat)) (cddr pat))
1563              (error "Invalid `not' pattern `%S'" pat))
1564          (not (mdw-fill-prefix-match-p (car pats))))
1565         (t (error "Unknown pattern form `%S'" pat))))
1566
1567 (defun mdw-maybe-car (p)
1568   "If P is a pair, return (car P), otherwise just return P."
1569   (if (consp p) (car p) p))
1570
1571 (defun mdw-padding (s)
1572   "Return a string the same width as S but made entirely from whitespace."
1573   (let* ((l (length s)) (i 0) (n (make-string l ? )))
1574     (while (< i l)
1575       (if (= 9 (aref s i))
1576           (aset n i 9))
1577       (setq i (1+ i)))
1578     n))
1579
1580 (defun mdw-do-prefix-match (m)
1581   "Expand a dynamic prefix match element.
1582 See `mdw-fill-prefix' for details."
1583   (cond ((not (consp m)) (format "%s" m))
1584         ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
1585         ((eq (car m) 'pad) (mdw-padding (match-string
1586                                          (mdw-maybe-car (cdr m)))))
1587         ((eq (car m) 'eval) (eval (cdr m)))
1588         (t "")))
1589
1590 (defun mdw-examine-fill-prefixes (l)
1591   "Given a list of dynamic fill prefixes, pick one which matches
1592 context and return the static fill prefix to use.  Point must be
1593 at the start of a line, and match data must be saved."
1594   (let ((prefix nil))
1595     (while (cond ((null l) nil)
1596                  ((mdw-fill-prefix-match-p (caar l))
1597                   (setq prefix
1598                           (mdw-maybe-tabify
1599                            (apply #'concat
1600                                   (mapcar #'mdw-do-prefix-match
1601                                           (cdr (car l))))))
1602                   nil))
1603       (setq l (cdr l)))
1604     prefix))
1605
1606 (defun mdw-choose-dynamic-fill-prefix ()
1607   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
1608   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
1609         ((not mdw-fill-prefix) fill-prefix)
1610         (t (save-excursion
1611              (beginning-of-line)
1612              (save-match-data
1613                (mdw-examine-fill-prefixes mdw-fill-prefix))))))
1614
1615 (defadvice do-auto-fill (around mdw-dynamic-fill-prefix () activate compile)
1616   "Handle auto-filling, working out a dynamic fill prefix in the
1617 case where there isn't a sensible static one."
1618   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
1619     ad-do-it))
1620
1621 (defun mdw-fill-paragraph ()
1622   "Fill paragraph, getting a dynamic fill prefix."
1623   (interactive)
1624   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
1625     (fill-paragraph nil)))
1626
1627 (defun mdw-point-within-string-p ()
1628   "Return non-nil if point is within a string."
1629   (let ((state (syntax-ppss)))
1630     (elt state 3)))
1631
1632 (defun mdw-standard-fill-prefix (rx &optional mat)
1633   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
1634 This is just a short-cut for setting the thing by hand, and by
1635 design it doesn't cope with anything approximating a complicated
1636 case."
1637   (setq mdw-fill-prefix
1638           `(((if (mdw-point-within-string-p)
1639                  ,(concat "\\(\\s-*\\)" mdw-hanging-indents)
1640                ,(concat rx mdw-hanging-indents))
1641              (match . 1)
1642              (pad . ,(or mat 2))))))
1643
1644 ;;;--------------------------------------------------------------------------
1645 ;;; Printing.
1646
1647 ;; Teach PostScript about a condensed variant of Courier.  I'm using 85% of
1648 ;; the usual width, which happens to match `mdwfonts', and David Carlisle's
1649 ;; `pslatex'.  (Once upon a time, I used 80%, but decided consistency with
1650 ;; `pslatex' was useful.)
1651 (setq ps-user-defined-prologue "
1652 /CourierCondensed /Courier
1653 /CourierCondensed-Bold /Courier-Bold
1654 /CourierCondensed-Oblique /Courier-Oblique
1655 /CourierCondensed-BoldOblique /Courier-BoldOblique
1656   4 { findfont [0.85 0 0 1 0 0] makefont definefont pop } repeat
1657 ")
1658
1659 ;; Hack `ps-print''s settings.
1660 (eval-after-load 'ps-print
1661   '(progn
1662
1663      ;; Notice that the comment-delimiters should be in italics too.
1664      (cl-pushnew 'font-lock-comment-delimiter-face ps-italic-faces)
1665
1666      ;; Select more suitable colours for the main kinds of tokens.  The
1667      ;; colours set on the Emacs faces are chosen for use against a dark
1668      ;; background, and work very badly on white paper.
1669      (ps-extend-face '(font-lock-comment-face "darkgreen" nil italic))
1670      (ps-extend-face '(font-lock-comment-delimiter-face "darkgreen" nil italic))
1671      (ps-extend-face '(font-lock-string-face "RoyalBlue4" nil))
1672      (ps-extend-face '(mdw-punct-face "sienna" nil))
1673      (ps-extend-face '(mdw-number-face "OrangeRed3" nil))
1674
1675      ;; Teach `ps-print' about my condensed varsions of Courier.
1676      (setq ps-font-info-database
1677              (append '((CourierCondensed
1678                         (fonts (normal . "CourierCondensed")
1679                                (bold . "CourierCondensed-Bold")
1680                                (italic . "CourierCondensed-Oblique")
1681                                (bold-italic . "CourierCondensed-BoldOblique"))
1682                         (size . 10.0)
1683                         (line-height . 10.55)
1684                         (space-width . 5.1)
1685                         (avg-char-width . 5.1)))
1686                      (cl-remove 'CourierCondensed ps-font-info-database
1687                                 :key #'car)))))
1688
1689 ;; Arrange to strip overlays from the buffer before we print .  This will
1690 ;; prevent `flyspell' from interfering with the printout.  (It would be less
1691 ;; bad if `ps-print' could merge the `flyspell' overlay face with the
1692 ;; underlying `font-lock' face, but it can't (and that seems hard).  So
1693 ;; instead we have this hack.
1694 ;;
1695 ;; The basic trick is to copy the relevant text from the buffer being printed
1696 ;; into a temporary buffer and... just print that.  The text properties come
1697 ;; with the text and end up in the new buffer, and the overlays get lost
1698 ;; along the way.  Only problem is that the headers identifying the file
1699 ;; being printed get confused, so remember the original buffer and reinstate
1700 ;; it when constructing the headers.
1701 (defvar mdw-printing-buffer)
1702
1703 (defadvice ps-generate-header
1704     (around mdw-use-correct-buffer () activate compile)
1705   "Print the correct name of the buffer being printed."
1706   (with-current-buffer mdw-printing-buffer
1707     ad-do-it))
1708
1709 (defadvice ps-generate
1710     (around mdw-strip-overlays (buffer from to genfunc) activate compile)
1711   "Strip overlays -- in particular, from `flyspell' -- before printout."
1712   (with-temp-buffer
1713     (let ((mdw-printing-buffer buffer))
1714       (insert-buffer-substring buffer from to)
1715       (ad-set-arg 0 (current-buffer))
1716       (ad-set-arg 1 (point-min))
1717       (ad-set-arg 2 (point-max))
1718       ad-do-it)))
1719
1720 ;;;--------------------------------------------------------------------------
1721 ;;; Other common declarations.
1722
1723 ;; Common mode settings.
1724
1725 (defcustom mdw-auto-indent t
1726   "Whether to indent automatically after a newline."
1727   :type 'boolean
1728   :safe 'booleanp)
1729
1730 (defun mdw-whitespace-mode (&optional arg)
1731   "Turn on/off whitespace mode, but don't highlight trailing space."
1732   (interactive "P")
1733   (when (and (boundp 'whitespace-style)
1734              (fboundp 'whitespace-mode))
1735     (let ((whitespace-style (remove 'trailing whitespace-style)))
1736       (whitespace-mode arg))
1737     (setq show-trailing-whitespace whitespace-mode)))
1738
1739 (defvar mdw-do-misc-mode-hacking nil)
1740
1741 (defun mdw-misc-mode-config ()
1742   (and mdw-auto-indent
1743        (cond ((eq major-mode 'lisp-mode)
1744               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
1745              ((derived-mode-p 'slime-repl-mode 'asm-mode 'comint-mode)
1746               nil)
1747              (t
1748               (local-set-key "\C-m" 'newline-and-indent))))
1749   (set (make-local-variable 'mdw-do-misc-mode-hacking) t)
1750   (local-set-key [C-return] 'newline)
1751   (make-local-variable 'page-delimiter)
1752   (setq page-delimiter (concat       "^" "\f"
1753                                "\\|" "^"
1754                                      ".\\{0,4\\}"
1755                                      "-\\{5\\}"
1756                                      "\\(" " " ".*" " " "\\)?"
1757                                      "-+"
1758                                      ".\\{0,2\\}"
1759                                      "$"))
1760   (setq comment-column 40)
1761   (auto-fill-mode 1)
1762   (setq fill-column mdw-text-width)
1763   (flyspell-prog-mode)
1764   (and (fboundp 'gtags-mode)
1765        (gtags-mode))
1766   (if (fboundp 'hs-minor-mode)
1767       (trap (hs-minor-mode t))
1768     (outline-minor-mode t))
1769   (reveal-mode t)
1770   (trap (turn-on-font-lock)))
1771
1772 (defun mdw-post-local-vars-misc-mode-config ()
1773   (setq whitespace-line-column mdw-text-width)
1774   (when (and mdw-do-misc-mode-hacking
1775              (not buffer-read-only))
1776     (setq show-trailing-whitespace t)
1777     (mdw-whitespace-mode 1)))
1778 (add-hook 'hack-local-variables-hook 'mdw-post-local-vars-misc-mode-config)
1779
1780 (defmacro mdw-advise-update-angry-fruit-salad (&rest funcs)
1781   `(progn ,@(mapcar (lambda (func)
1782                       `(defadvice ,func
1783                            (after mdw-angry-fruit-salad activate)
1784                          (when mdw-do-misc-mode-hacking
1785                            (setq show-trailing-whitespace
1786                                  (not buffer-read-only))
1787                            (mdw-whitespace-mode (if buffer-read-only 0 1)))))
1788                     funcs)))
1789 (mdw-advise-update-angry-fruit-salad toggle-read-only
1790                                      read-only-mode
1791                                      view-mode
1792                                      view-mode-enable
1793                                      view-mode-disable)
1794
1795 (eval-after-load 'gtags
1796   '(progn
1797      (dolist (key '([mouse-2] [mouse-3]))
1798        (define-key gtags-mode-map key nil))
1799      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
1800      (define-key gtags-select-mode-map [C-S-mouse-2]
1801        'gtags-select-tag-by-event)
1802      (dolist (map (list gtags-mode-map gtags-select-mode-map))
1803        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
1804
1805 ;; Backup file handling.
1806
1807 (defcustom mdw-backup-disable-regexps nil
1808   "List of regular expressions: if a file name matches any of
1809 these then the file is not backed up."
1810   :type '(repeat regexp))
1811
1812 (defun mdw-backup-enable-predicate (name)
1813   "[mdw]'s default backup predicate.
1814 Allows a backup if the standard predicate would allow it, and it
1815 doesn't match any of the regular expressions in
1816 `mdw-backup-disable-regexps'."
1817   (and (normal-backup-enable-predicate name)
1818        (let ((answer t) (list mdw-backup-disable-regexps))
1819          (save-match-data
1820            (while list
1821              (if (string-match (car list) name)
1822                  (setq answer nil))
1823              (setq list (cdr list)))
1824            answer))))
1825 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
1826
1827 ;; Frame cleanup.
1828
1829 (defun mdw-last-one-out-turn-off-the-lights (frame)
1830   "Disconnect from an X display if this was the last frame on that display."
1831   (let ((frame-display (frame-parameter frame 'display)))
1832     (when (and frame-display
1833                (eq window-system 'x)
1834                (not (cl-some (lambda (fr)
1835                                (and (not (eq fr frame))
1836                                     (string= (frame-parameter fr 'display)
1837                                              frame-display)))
1838                              (frame-list))))
1839       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
1840 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
1841
1842 ;;;--------------------------------------------------------------------------
1843 ;;; Fullscreen-ness.
1844
1845 (defcustom mdw-full-screen-parameters
1846   '((menu-bar-lines . 0)
1847     ;;(vertical-scroll-bars . nil)
1848     )
1849   "Frame parameters to set when making a frame fullscreen."
1850   :type '(alist :key-type symbol))
1851
1852 (defcustom mdw-full-screen-save
1853   '(width height)
1854   "Extra frame parameters to save when setting fullscreen."
1855   :type '(repeat symbol))
1856
1857 (defun mdw-toggle-full-screen (&optional frame)
1858   "Show the FRAME fullscreen."
1859   (interactive)
1860   (when window-system
1861     (cond ((frame-parameter frame 'fullscreen)
1862            (set-frame-parameter frame 'fullscreen nil)
1863            (modify-frame-parameters
1864             nil
1865             (or (frame-parameter frame 'mdw-full-screen-saved)
1866                 (mapcar (lambda (assoc)
1867                           (assq (car assoc) default-frame-alist))
1868                         mdw-full-screen-parameters))))
1869           (t
1870            (let ((saved (mapcar (lambda (param)
1871                                   (cons param (frame-parameter frame param)))
1872                                 (append (mapcar #'car
1873                                                 mdw-full-screen-parameters)
1874                                         mdw-full-screen-save))))
1875              (set-frame-parameter frame 'mdw-full-screen-saved saved))
1876            (modify-frame-parameters frame mdw-full-screen-parameters)
1877            (set-frame-parameter frame 'fullscreen 'fullboth)))))
1878
1879 ;;;--------------------------------------------------------------------------
1880 ;;; General fontification.
1881
1882 (make-face 'mdw-virgin-face)
1883
1884 (defmacro mdw-define-face (name &rest body)
1885   "Define a face, and make sure it's actually set as the definition."
1886   (declare (indent 1)
1887            (debug 0))
1888   `(progn
1889      (copy-face 'mdw-virgin-face ',name)
1890      (defvar ,name ',name)
1891      (put ',name 'face-defface-spec ',body)
1892      (face-spec-set ',name ',body nil)))
1893
1894 (mdw-define-face default
1895   (((type w32)) :family "courier new" :height 85)
1896   (((type x)) :family "6x13" :foundry "trad" :height 130)
1897   (((type color)) :foreground "white" :background "black")
1898   (t nil))
1899 (mdw-define-face fixed-pitch
1900   (((type w32)) :family "courier new" :height 85)
1901   (((type x)) :family "6x13" :foundry "trad" :height 130)
1902   (t :foreground "white" :background "black"))
1903 (mdw-define-face fixed-pitch-serif
1904   (((type w32)) :family "courier new" :height 85 :weight bold)
1905   (((type x)) :family "6x13" :foundry "trad" :height 130 :weight bold)
1906   (t :foreground "white" :background "black" :weight bold))
1907 (mdw-define-face variable-pitch
1908   (((type x)) :family "helvetica" :height 120))
1909 (mdw-define-face region
1910   (((min-colors 64)) :background "grey30")
1911   (((class color)) :background "blue")
1912   (t :inverse-video t))
1913 (mdw-define-face error
1914   (((class color)) :background "red")
1915   (t :inverse-video t))
1916 (mdw-define-face match
1917   (((class color)) :background "blue")
1918   (t :inverse-video t))
1919 (mdw-define-face mc/cursor-face
1920   (((class color)) :background "red")
1921   (t :inverse-video t))
1922 (mdw-define-face minibuffer-prompt
1923   (t :weight bold))
1924 (mdw-define-face mode-line
1925   (((class color)) :foreground "blue" :background "yellow"
1926                    :box (:line-width 1 :style released-button))
1927   (t :inverse-video t))
1928 (mdw-define-face mode-line-inactive
1929   (((class color)) :foreground "yellow" :background "blue"
1930                    :box (:line-width 1 :style released-button))
1931   (t :inverse-video t))
1932 (mdw-define-face nobreak-space
1933   (((type tty)))
1934   (t :inherit escape-glyph :underline t))
1935 (mdw-define-face scroll-bar
1936   (t :foreground "black" :background "lightgrey"))
1937 (mdw-define-face fringe
1938   (t :foreground "yellow"))
1939 (mdw-define-face show-paren-match
1940   (((min-colors 64)) :background "darkgreen")
1941   (((class color)) :background "green")
1942   (t :underline t))
1943 (mdw-define-face show-paren-mismatch
1944   (((class color)) :background "red")
1945   (t :inverse-video t))
1946 (mdw-define-face highlight
1947   (((min-colors 64)) :background "DarkSeaGreen4")
1948   (((class color)) :background "cyan")
1949   (t :inverse-video t))
1950
1951 (mdw-define-face viper-minibuffer-emacs (t nil))
1952 (mdw-define-face viper-minibuffer-insert (t nil))
1953 (mdw-define-face viper-minibuffer-vi (t nil))
1954 (mdw-define-face viper-replace-overlay
1955   (((min-colors 64)) :background "darkred")
1956   (((class color)) :background "red")
1957   (t :inverse-video t))
1958 (mdw-define-face viper-search (t :inherit isearch))
1959
1960 (mdw-define-face compilation-error
1961   (((class color)) :foreground "red" :weight bold)
1962   (t :weight bold))
1963 (mdw-define-face compilation-warning
1964   (((class color)) :foreground "orange" :weight bold)
1965   (t :weight bold))
1966 (mdw-define-face compilation-info
1967   (((class color)) :foreground "green" :weight bold)
1968   (t :weight bold))
1969 (mdw-define-face compilation-line-number
1970   (t :weight bold))
1971 (mdw-define-face compilation-column-number
1972   (((min-colors 64)) :foreground "lightgrey"))
1973 (setq compilation-message-face 'mdw-virgin-face)
1974 (setq compilation-enter-directory-face 'font-lock-comment-face)
1975 (setq compilation-leave-directory-face 'font-lock-comment-face)
1976
1977 (mdw-define-face holiday-face
1978   (t :background "red"))
1979 (mdw-define-face calendar-today-face
1980   (t :foreground "yellow" :weight bold))
1981
1982 (mdw-define-face flyspell-incorrect
1983   (((type x)) :underline (:color "red" :style wave))
1984   (((class color)) :foreground "red" :underline t)
1985   (t :underline t))
1986 (mdw-define-face flyspell-duplicate
1987   (((type x)) :underline (:color "orange" :style wave))
1988   (((class color)) :foreground "orange" :underline t)
1989   (t :underline t))
1990
1991 (mdw-define-face comint-highlight-prompt
1992   (t :weight bold))
1993 (mdw-define-face comint-highlight-input
1994   (t nil))
1995
1996 (mdw-define-face Man-underline
1997   (((type tty)) :underline t)
1998   (t :slant italic))
1999
2000 (mdw-define-face ido-subdir
2001   (t :foreground "cyan" :weight bold))
2002
2003 (mdw-define-face dired-directory
2004   (t :foreground "cyan" :weight bold))
2005 (mdw-define-face dired-symlink
2006   (t :foreground "cyan"))
2007 (mdw-define-face dired-perm-write
2008   (t nil))
2009
2010 (mdw-define-face trailing-whitespace
2011   (((class color)) :background "red")
2012   (t :inverse-video t))
2013 (mdw-define-face whitespace-line
2014   (((class color)) :background "darkred")
2015   (t :inverse-video t))
2016 (mdw-define-face mdw-punct-face
2017   (((min-colors 64)) :foreground "burlywood2")
2018   (((class color)) :foreground "yellow"))
2019 (mdw-define-face mdw-number-face
2020   (t :foreground "yellow"))
2021 (mdw-define-face mdw-trivial-face)
2022 (mdw-define-face font-lock-function-name-face
2023   (t :slant italic))
2024 (mdw-define-face font-lock-keyword-face
2025   (t :weight bold))
2026 (mdw-define-face font-lock-constant-face
2027   (t :slant italic))
2028 (mdw-define-face font-lock-builtin-face
2029   (t :weight bold))
2030 (mdw-define-face font-lock-type-face
2031   (t :weight bold :slant italic))
2032 (mdw-define-face font-lock-reference-face
2033   (t :weight bold))
2034 (mdw-define-face font-lock-variable-name-face
2035   (t :slant italic))
2036 (mdw-define-face font-lock-comment-face
2037   (((min-colors 64)) :slant italic :foreground "SeaGreen1")
2038   (((class color)) :foreground "green")
2039   (t :weight bold))
2040 (mdw-define-face font-lock-comment-delimiter-face
2041   (t :inherit font-lock-comment-face))
2042 (mdw-define-face font-lock-string-face
2043   (((min-colors 64)) :foreground "SkyBlue1")
2044   (((class color)) :foreground "cyan")
2045   (t :weight bold))
2046 (mdw-define-face font-lock-doc-face
2047   (t :inherit font-lock-string-face))
2048
2049 (mdw-define-face message-separator
2050   (t :background "red" :foreground "white" :weight bold))
2051 (mdw-define-face message-cited-text
2052   (default :slant italic)
2053   (((min-colors 64)) :foreground "SkyBlue1")
2054   (((class color)) :foreground "cyan"))
2055 (mdw-define-face message-header-cc
2056   (default :slant italic)
2057   (((min-colors 64)) :foreground "SeaGreen1")
2058   (((class color)) :foreground "green"))
2059 (mdw-define-face message-header-newsgroups
2060   (default :slant italic)
2061   (((min-colors 64)) :foreground "SeaGreen1")
2062   (((class color)) :foreground "green"))
2063 (mdw-define-face message-header-subject
2064   (((min-colors 64)) :foreground "SeaGreen1")
2065   (((class color)) :foreground "green"))
2066 (mdw-define-face message-header-to
2067   (((min-colors 64)) :foreground "SeaGreen1")
2068   (((class color)) :foreground "green"))
2069 (mdw-define-face message-header-xheader
2070   (default :slant italic)
2071   (((min-colors 64)) :foreground "SeaGreen1")
2072   (((class color)) :foreground "green"))
2073 (mdw-define-face message-header-other
2074   (default :slant italic)
2075   (((min-colors 64)) :foreground "SeaGreen1")
2076   (((class color)) :foreground "green"))
2077 (mdw-define-face message-header-name
2078   (default :weight bold)
2079   (((min-colors 64)) :foreground "SeaGreen1")
2080   (((class color)) :foreground "green"))
2081
2082 (mdw-define-face which-func
2083   (t nil))
2084
2085 (mdw-define-face gnus-header-name
2086   (default :weight bold)
2087   (((min-colors 64)) :foreground "SeaGreen1")
2088   (((class color)) :foreground "green"))
2089 (mdw-define-face gnus-header-subject
2090   (((min-colors 64)) :foreground "SeaGreen1")
2091   (((class color)) :foreground "green"))
2092 (mdw-define-face gnus-header-from
2093   (((min-colors 64)) :foreground "SeaGreen1")
2094   (((class color)) :foreground "green"))
2095 (mdw-define-face gnus-header-to
2096   (((min-colors 64)) :foreground "SeaGreen1")
2097   (((class color)) :foreground "green"))
2098 (mdw-define-face gnus-header-content
2099   (default :slant italic)
2100   (((min-colors 64)) :foreground "SeaGreen1")
2101   (((class color)) :foreground "green"))
2102
2103 (mdw-define-face gnus-cite-1
2104   (((min-colors 64)) :foreground "SkyBlue1")
2105   (((class color)) :foreground "cyan"))
2106 (mdw-define-face gnus-cite-2
2107   (((min-colors 64)) :foreground "RoyalBlue2")
2108   (((class color)) :foreground "blue"))
2109 (mdw-define-face gnus-cite-3
2110   (((min-colors 64)) :foreground "MediumOrchid")
2111   (((class color)) :foreground "magenta"))
2112 (mdw-define-face gnus-cite-4
2113   (((min-colors 64)) :foreground "firebrick2")
2114   (((class color)) :foreground "red"))
2115 (mdw-define-face gnus-cite-5
2116   (((min-colors 64)) :foreground "burlywood2")
2117   (((class color)) :foreground "yellow"))
2118 (mdw-define-face gnus-cite-6
2119   (((min-colors 64)) :foreground "SeaGreen1")
2120   (((class color)) :foreground "green"))
2121 (mdw-define-face gnus-cite-7
2122   (((min-colors 64)) :foreground "SlateBlue1")
2123   (((class color)) :foreground "cyan"))
2124 (mdw-define-face gnus-cite-8
2125   (((min-colors 64)) :foreground "RoyalBlue2")
2126   (((class color)) :foreground "blue"))
2127 (mdw-define-face gnus-cite-9
2128   (((min-colors 64)) :foreground "purple2")
2129   (((class color)) :foreground "magenta"))
2130 (mdw-define-face gnus-cite-10
2131   (((min-colors 64)) :foreground "DarkOrange2")
2132   (((class color)) :foreground "red"))
2133 (mdw-define-face gnus-cite-11
2134   (t :foreground "grey"))
2135
2136 (mdw-define-face gnus-emphasis-underline
2137   (((type tty)) :underline t)
2138   (t :slant italic))
2139
2140 (mdw-define-face diff-header
2141   (t nil))
2142 (mdw-define-face diff-index
2143   (t :weight bold))
2144 (mdw-define-face diff-file-header
2145   (t :weight bold))
2146 (mdw-define-face diff-hunk-header
2147   (((min-colors 64)) :foreground "SkyBlue1")
2148   (((class color)) :foreground "cyan"))
2149 (mdw-define-face diff-function
2150   (default :weight bold)
2151   (((min-colors 64)) :foreground "SkyBlue1")
2152   (((class color)) :foreground "cyan"))
2153 (mdw-define-face diff-header
2154   (((min-colors 64)) :background "grey10"))
2155 (mdw-define-face diff-added
2156   (((class color)) :foreground "green"))
2157 (mdw-define-face diff-removed
2158   (((class color)) :foreground "red"))
2159 (mdw-define-face diff-context
2160   (t nil))
2161 (mdw-define-face diff-refine-change
2162   (((min-colors 64)) :background "RoyalBlue4")
2163   (t :underline t))
2164 (mdw-define-face diff-refine-removed
2165   (((min-colors 64)) :background "#500")
2166   (t :underline t))
2167 (mdw-define-face diff-refine-added
2168   (((min-colors 64)) :background "#050")
2169   (t :underline t))
2170
2171 (setq ediff-force-faces t)
2172 (mdw-define-face ediff-current-diff-A
2173   (((min-colors 64)) :background "darkred")
2174   (((class color)) :background "red")
2175   (t :inverse-video t))
2176 (mdw-define-face ediff-fine-diff-A
2177   (((min-colors 64)) :background "red3")
2178   (((class color)) :inverse-video t)
2179   (t :inverse-video nil))
2180 (mdw-define-face ediff-even-diff-A
2181   (((min-colors 64)) :background "#300"))
2182 (mdw-define-face ediff-odd-diff-A
2183   (((min-colors 64)) :background "#300"))
2184 (mdw-define-face ediff-current-diff-B
2185   (((min-colors 64)) :background "darkgreen")
2186   (((class color)) :background "magenta")
2187   (t :inverse-video t))
2188 (mdw-define-face ediff-fine-diff-B
2189   (((min-colors 64)) :background "green4")
2190   (((class color)) :inverse-video t)
2191   (t :inverse-video nil))
2192 (mdw-define-face ediff-even-diff-B
2193   (((min-colors 64)) :background "#020"))
2194 (mdw-define-face ediff-odd-diff-B
2195   (((min-colors 64)) :background "#020"))
2196 (mdw-define-face ediff-current-diff-C
2197   (((min-colors 64)) :background "darkblue")
2198   (((class color)) :background "blue")
2199   (t :inverse-video t))
2200 (mdw-define-face ediff-fine-diff-C
2201   (((min-colors 64)) :background "blue1")
2202   (((class color)) :inverse-video t)
2203   (t :inverse-video nil))
2204 (mdw-define-face ediff-even-diff-C
2205   (((min-colors 64)) :background "#004"))
2206 (mdw-define-face ediff-odd-diff-C
2207   (((min-colors 64)) :background "#004"))
2208 (mdw-define-face ediff-current-diff-Ancestor
2209   (((min-colors 64)) :background "#630")
2210   (((class color)) :background "blue")
2211   (t :inverse-video t))
2212 (mdw-define-face ediff-even-diff-Ancestor
2213   (((min-colors 64)) :background "#320"))
2214 (mdw-define-face ediff-odd-diff-Ancestor
2215   (((min-colors 64)) :background "#320"))
2216
2217 (mdw-define-face magit-hash
2218   (((min-colors 64)) :foreground "grey40")
2219   (((class color)) :foreground "blue"))
2220 (mdw-define-face magit-popup-argument
2221   (((min-colors 64)) :foreground "SeaGreen1")
2222   (((class color)) :foreground "green")
2223   (t :weight bold))
2224 (mdw-define-face magit-diff-hunk-heading
2225   (((min-colors 64)) :foreground "grey70" :background "grey25")
2226   (((class color)) :foreground "yellow"))
2227 (mdw-define-face magit-diff-hunk-heading-highlight
2228   (((min-colors 64)) :foreground "grey70" :background "grey35")
2229   (((class color)) :foreground "yellow" :background "blue"))
2230 (mdw-define-face magit-diff-added
2231   (((min-colors 64)) :foreground "#ddffdd" :background "#335533")
2232   (((class color)) :foreground "green"))
2233 (mdw-define-face magit-diff-added-highlight
2234   (((min-colors 64)) :foreground "#cceecc" :background "#336633")
2235   (((class color)) :foreground "green" :background "blue"))
2236 (mdw-define-face magit-diff-removed
2237   (((min-colors 64)) :foreground "#ffdddd" :background "#553333")
2238   (((class color)) :foreground "red"))
2239 (mdw-define-face magit-diff-removed-highlight
2240   (((min-colors 64)) :foreground "#eecccc" :background "#663333")
2241   (((class color)) :foreground "red" :background "blue"))
2242 (mdw-define-face magit-blame-heading
2243   (((min-colors 64)) :foreground "white" :background "grey25"
2244                      :weight normal :slant normal)
2245   (((class color)) :foreground "white" :background "blue"
2246                    :weight normal :slant normal))
2247 (mdw-define-face magit-blame-name
2248   (t :inherit magit-blame-heading :slant italic))
2249 (mdw-define-face magit-blame-date
2250   (((min-colors 64)) :inherit magit-blame-heading :foreground "grey60")
2251   (((class color)) :inherit magit-blame-heading :foreground "cyan"))
2252 (mdw-define-face magit-blame-summary
2253   (t :inherit magit-blame-heading :weight bold))
2254
2255 (mdw-define-face dylan-header-background
2256   (((min-colors 64)) :background "NavyBlue")
2257   (((class color)) :background "blue"))
2258
2259 (mdw-define-face erc-my-nick-face
2260   (t :foreground "yellow" :weight bold))
2261 (mdw-define-face erc-current-nick-face
2262   (t :foreground "yellow" :weight bold))
2263 (mdw-define-face erc-input-face
2264   (t :foreground "yellow"))
2265 (mdw-define-face erc-action-face
2266   ())
2267 (mdw-define-face erc-button
2268   (t :foreground "cyan" :underline t :weight semi-bold))
2269
2270 (mdw-define-face woman-bold
2271   (t :weight bold))
2272 (mdw-define-face woman-italic
2273   (t :slant italic))
2274
2275 (eval-after-load "rst"
2276   '(progn
2277      (mdw-define-face rst-level-1-face
2278        (t :foreground "SkyBlue1" :weight bold))
2279      (mdw-define-face rst-level-2-face
2280        (t :foreground "SeaGreen1" :weight bold))
2281      (mdw-define-face rst-level-3-face
2282        (t :weight bold))
2283      (mdw-define-face rst-level-4-face
2284        (t :slant italic))
2285      (mdw-define-face rst-level-5-face
2286        (t :underline t))
2287      (mdw-define-face rst-level-6-face
2288        ())))
2289
2290 (mdw-define-face p4-depot-added-face
2291   (t :foreground "green"))
2292 (mdw-define-face p4-depot-branch-op-face
2293   (t :foreground "yellow"))
2294 (mdw-define-face p4-depot-deleted-face
2295   (t :foreground "red"))
2296 (mdw-define-face p4-depot-unmapped-face
2297   (t :foreground "SkyBlue1"))
2298 (mdw-define-face p4-diff-change-face
2299   (t :foreground "yellow"))
2300 (mdw-define-face p4-diff-del-face
2301   (t :foreground "red"))
2302 (mdw-define-face p4-diff-file-face
2303   (t :foreground "SkyBlue1"))
2304 (mdw-define-face p4-diff-head-face
2305   (t :background "grey10"))
2306 (mdw-define-face p4-diff-ins-face
2307   (t :foreground "green"))
2308
2309 (mdw-define-face w3m-anchor-face
2310   (t :foreground "SkyBlue1" :underline t))
2311 (mdw-define-face w3m-arrived-anchor-face
2312   (t :foreground "SkyBlue1" :underline t))
2313
2314 (mdw-define-face whizzy-slice-face
2315   (t :background "grey10"))
2316 (mdw-define-face whizzy-error-face
2317   (t :background "darkred"))
2318
2319 ;; Ellipses used to indicate hidden text (and similar).
2320 (mdw-define-face mdw-ellipsis-face
2321   (((type tty)) :foreground "blue") (t :foreground "grey60"))
2322 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
2323       (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
2324       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
2325       (bar (make-glyph-code ?| mdw-ellipsis-face)))
2326   (set-display-table-slot standard-display-table 0 dollar)
2327   (set-display-table-slot standard-display-table 1 backslash)
2328   (set-display-table-slot standard-display-table 4
2329                           (vector dot dot dot))
2330   (set-display-table-slot standard-display-table 5 bar))
2331
2332 ;;;--------------------------------------------------------------------------
2333 ;;; Where is point?
2334
2335 (mdw-define-face mdw-point-overlay-face
2336   (((type graphic)))
2337   (((min-colors 64)) :background "darkblue")
2338   (((class color)) :background "blue")
2339   (((type tty) (class mono)) :inverse-video t))
2340
2341 (defcustom mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar)
2342   "Bitmaps to display in the left and right fringes in the current line."
2343   :type '(cons symbol symbol))
2344
2345 (defun mdw-configure-point-overlay ()
2346   (let ((ov (make-overlay 0 0)))
2347     (overlay-put ov 'priority 0)
2348     (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
2349            (left (car fringe)) (right (cdr fringe))
2350            (s ""))
2351       (when left
2352         (let ((ss "."))
2353           (put-text-property 0 1 'display `(left-fringe ,left) ss)
2354           (setq s (concat s ss))))
2355       (when right
2356         (let ((ss "."))
2357           (put-text-property 0 1 'display `(right-fringe ,right) ss)
2358           (setq s (concat s ss))))
2359       (when (or left right)
2360         (overlay-put ov 'before-string s)))
2361     (overlay-put ov 'face 'mdw-point-overlay-face)
2362     (delete-overlay ov)
2363     ov))
2364
2365 (defvar mdw-point-overlay (mdw-configure-point-overlay)
2366   "An overlay used for showing where point is in the selected window.")
2367 (defun mdw-reconfigure-point-overlay ()
2368   (interactive)
2369   (setq mdw-point-overlay (mdw-configure-point-overlay)))
2370
2371 (defun mdw-remove-point-overlay ()
2372   "Remove the current-point overlay."
2373   (delete-overlay mdw-point-overlay))
2374
2375 (defun mdw-update-point-overlay ()
2376   "Mark the current point position with an overlay."
2377   (if (not mdw-point-overlay-mode)
2378       (mdw-remove-point-overlay)
2379     (overlay-put mdw-point-overlay 'window (selected-window))
2380     (move-overlay mdw-point-overlay
2381                   (line-beginning-position)
2382                   (+ (line-end-position) 1))))
2383
2384 (defvar mdw-point-overlay-buffers nil
2385   "List of buffers using `mdw-point-overlay-mode'.")
2386
2387 (define-minor-mode mdw-point-overlay-mode
2388   "Indicate current line with an overlay."
2389   :global nil
2390   (let ((buffer (current-buffer)))
2391     (setq mdw-point-overlay-buffers
2392             (cl-mapcan (lambda (buf)
2393                          (if (and (buffer-live-p buf)
2394                                   (not (eq buf buffer)))
2395                              (list buf)))
2396                        mdw-point-overlay-buffers))
2397     (if mdw-point-overlay-mode
2398         (setq mdw-point-overlay-buffers
2399                 (cons buffer mdw-point-overlay-buffers))))
2400   (cond (mdw-point-overlay-buffers
2401          (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
2402          (add-hook 'post-command-hook 'mdw-update-point-overlay))
2403         (t
2404          (mdw-remove-point-overlay)
2405          (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
2406          (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
2407
2408 (define-globalized-minor-mode mdw-global-point-overlay-mode
2409   mdw-point-overlay-mode
2410   (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
2411
2412 (defvar mdw-terminal-title-alist nil)
2413 (defun mdw-update-terminal-title ()
2414   (when (let ((term (frame-parameter nil 'tty-type)))
2415           (and term (string-match "^xterm" term)))
2416     (let* ((tty (frame-parameter nil 'tty))
2417            (old (assoc tty mdw-terminal-title-alist))
2418            (new (format-mode-line frame-title-format)))
2419       (unless (and old (equal (cdr old) new))
2420         (if old (rplacd old new)
2421           (setq mdw-terminal-title-alist
2422                   (cons (cons tty new) mdw-terminal-title-alist)))
2423         (send-string-to-terminal (concat "\e]2;" new "\e\\"))))))
2424
2425 (add-hook 'post-command-hook 'mdw-update-terminal-title)
2426
2427 ;;;--------------------------------------------------------------------------
2428 ;;; Ediff hacking.
2429
2430 (defvar mdw-ediff-previous-windows)
2431 (defun mdw-ediff-setup ()
2432   (setq mdw-ediff-previous-windows (current-window-configuration)))
2433 (defun mdw-ediff-suspend-or-quit ()
2434   (set-window-configuration mdw-ediff-previous-windows))
2435 (add-hook 'ediff-before-setup-hook 'mdw-ediff-setup)
2436 (add-hook 'ediff-quit-hook 'mdw-ediff-suspend-or-quit t)
2437 (add-hook 'ediff-suspend-hook 'mdw-ediff-suspend-or-quit t)
2438
2439 ;;;--------------------------------------------------------------------------
2440 ;;; C programming configuration.
2441
2442 ;; Make C indentation nice.
2443
2444 (defun mdw-c-lineup-arglist (langelem)
2445   "Hack for DWIMmery in c-lineup-arglist."
2446   (if (save-excursion
2447         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
2448       0
2449     (c-lineup-arglist langelem)))
2450
2451 (defun mdw-c-indent-extern-mumble (langelem)
2452   "Indent `extern \"...\" {' lines."
2453   (save-excursion
2454     (back-to-indentation)
2455     (if (looking-at
2456          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
2457         c-basic-offset
2458       nil)))
2459
2460 (defun mdw-c-indent-arglist-nested (langelem)
2461   "Indent continued argument lists.
2462 If we've nested more than one argument list, then only introduce a single
2463 indentation anyway."
2464   (let ((context c-syntactic-context)
2465         (pos (c-langelem-2nd-pos c-syntactic-element))
2466         (should-indent-p t))
2467     (while (and context
2468                 (eq (caar context) 'arglist-cont-nonempty))
2469       (when (and (= (cl-caddr (pop context)) pos)
2470                  context
2471                  (memq (caar context) '(arglist-intro
2472                                         arglist-cont-nonempty)))
2473         (setq should-indent-p nil)))
2474     (if should-indent-p '+ 0)))
2475
2476 (defvar mdw-define-c-styles-hook nil
2477   "Hook run when `cc-mode' starts up to define styles.")
2478
2479 (defun mdw-merge-style-alists (first second)
2480   (let ((output nil))
2481     (dolist (item first)
2482       (let ((key (car item)) (value (cdr item)))
2483         (if (let* ((key-name (symbol-name key))
2484                    (key-len (length key-name)))
2485               (and (>= key-len 6)
2486                    (string= (substring key-name (- key-len 6)) "-alist")))
2487             (push (cons key
2488                         (mdw-merge-style-alists value
2489                                                 (cdr (assoc key second))))
2490                   output)
2491           (push item output))))
2492     (dolist (item second)
2493       (unless (assoc (car item) first)
2494         (push item output)))
2495     (nreverse output)))
2496
2497 (cl-defmacro mdw-define-c-style (name (&optional parent) &rest assocs)
2498   "Define a C style, called NAME (a symbol) based on PARENT, setting ASSOCs.
2499 A function, named `mdw-define-c-style/NAME', is defined to actually install
2500 the style using `c-add-style', and added to the hook
2501 `mdw-define-c-styles-hook'.  If CC Mode is already loaded, then the style is
2502 set."
2503   (declare (indent defun))
2504   (let* ((name-string (symbol-name name))
2505          (var (intern (concat "mdw-c-style/" name-string)))
2506          (func (intern (concat "mdw-define-c-style/" name-string))))
2507     `(progn
2508        (setq ,var
2509                ,(if (null parent)
2510                     `',assocs
2511                   (let ((parent-list (intern (concat "mdw-c-style/"
2512                                                      (symbol-name parent)))))
2513                     `(mdw-merge-style-alists ',assocs ,parent-list))))
2514        (defun ,func () (c-add-style ,name-string ,var))
2515        (and (featurep 'cc-mode) (,func))
2516        (add-hook 'mdw-define-c-styles-hook ',func)
2517        ',name)))
2518
2519 (eval-after-load "cc-mode"
2520   '(run-hooks 'mdw-define-c-styles-hook))
2521
2522 (mdw-define-c-style mdw-c ()
2523   (c-basic-offset . 2)
2524   (comment-column . 40)
2525   (c-class-key . "class")
2526   (c-backslash-column . 72)
2527   (c-label-minimum-indentation . 0)
2528   (c-indent-comments-syntactically-p t)
2529   (c-indent-comment-alist (end-block . (column . nil))
2530                           (cpp-end-block . (column . nil))
2531                           (other . (column . nil)))
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 (mdw-define-face slime-repl-input-face
5261   (t))
5262 (mdw-define-face slime-repl-output-face
5263   (t :inherit font-lock-comment-face))
5264 (mdw-define-face slime-repl-inputed-output-face
5265   (t :inherit link))
5266 (mdw-define-face slime-repl-output-mouseover-face
5267   (t :inherit highlight))
5268
5269 ;; Hooks.
5270
5271 (progn
5272   (dolist (hook '(emacs-lisp-mode-hook
5273                   scheme-mode-hook
5274                   lisp-mode-hook
5275                   inferior-lisp-mode-hook
5276                   lisp-interaction-mode-hook
5277                   ielm-mode-hook
5278                   slime-repl-mode-hook))
5279     (add-hook hook 'mdw-misc-mode-config t)
5280     (add-hook hook 'mdw-fontify-lispy t))
5281   (add-hook 'lisp-mode-hook 'mdw-common-lisp-indent t)
5282   (add-hook 'inferior-lisp-mode-hook
5283             #'(lambda () (local-set-key "\C-m" 'comint-send-and-indent)) t))
5284
5285 ;;;--------------------------------------------------------------------------
5286 ;;; Other languages.
5287
5288 ;; Smalltalk.
5289
5290 (defun mdw-setup-smalltalk ()
5291   (and mdw-auto-indent
5292        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
5293   (make-local-variable 'mdw-auto-indent)
5294   (setq mdw-auto-indent nil)
5295   (local-set-key "\C-i" 'smalltalk-reindent))
5296
5297 (defun mdw-fontify-smalltalk ()
5298   (make-local-variable 'font-lock-keywords)
5299   (setq font-lock-keywords
5300           (list
5301            (list "\\<[A-Z][a-zA-Z0-9]*\\>"
5302                  '(0 font-lock-keyword-face))
5303            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
5304                          "[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
5305                          "\\([eE][-+]?[0-9_]+\\)?")
5306                  '(0 mdw-number-face))
5307            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
5308                  '(0 mdw-punct-face)))))
5309
5310 (progn
5311   (add-hook 'smalltalk-mode 'mdw-misc-mode-config t)
5312   (add-hook 'smalltalk-mode 'mdw-fontify-smalltalk t))
5313
5314 ;; m4.
5315
5316 (defun mdw-setup-m4 ()
5317
5318   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
5319   ;; annoying: fix it.
5320   (modify-syntax-entry ?{ "(")
5321   (modify-syntax-entry ?} ")")
5322
5323   ;; Fill prefix.
5324   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
5325
5326 (dolist (hook '(m4-mode-hook autoconf-mode-hook autotest-mode-hook))
5327   (add-hook hook #'mdw-misc-mode-config t)
5328   (add-hook hook #'mdw-setup-m4 t))
5329
5330 ;; Make.
5331
5332 (progn
5333   (add-hook 'makefile-mode-hook 'mdw-misc-mode-config t))
5334
5335 ;; nroff/troff.
5336
5337 (progn
5338   (add-hook 'nroff-mode-hook 'mdw-misc-mode-config t))
5339
5340 ;;;--------------------------------------------------------------------------
5341 ;;; Text mode.
5342
5343 (defun mdw-text-mode ()
5344   (setq fill-column 72)
5345   (flyspell-mode t)
5346   (mdw-standard-fill-prefix
5347    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
5348   (auto-fill-mode 1))
5349
5350 (eval-after-load "flyspell"
5351   '(define-key flyspell-mode-map "\C-\M-i" nil))
5352
5353 (progn
5354   (add-hook 'text-mode-hook 'mdw-text-mode t))
5355
5356 ;;;--------------------------------------------------------------------------
5357 ;;; Outline and hide/show modes.
5358
5359 (defun mdw-outline-collapse-all ()
5360   "Completely collapse everything in the entire buffer."
5361   (interactive)
5362   (save-excursion
5363     (goto-char (point-min))
5364     (while (< (point) (point-max))
5365       (hide-subtree)
5366       (forward-line))))
5367
5368 (setq hs-hide-comments-when-hiding-all nil)
5369
5370 (defadvice hs-hide-all (after hide-first-comment activate)
5371   (save-excursion (hs-hide-initial-comment-block)))
5372
5373 ;;;--------------------------------------------------------------------------
5374 ;;; Shell mode.
5375
5376 (defun mdw-sh-mode-setup ()
5377   (local-set-key [?\C-a] 'comint-bol)
5378   (add-hook 'comint-output-filter-functions
5379             'comint-watch-for-password-prompt))
5380
5381 (defun mdw-term-mode-setup ()
5382   (setq term-prompt-regexp shell-prompt-pattern)
5383   (make-local-variable 'mouse-yank-at-point)
5384   (make-local-variable 'transient-mark-mode)
5385   (setq mouse-yank-at-point t)
5386   (auto-fill-mode -1)
5387   (setq tab-width 8))
5388
5389 (defun comint-send-and-indent ()
5390   (interactive)
5391   (comint-send-input)
5392   (and mdw-auto-indent
5393        (indent-for-tab-command)))
5394
5395 (defadvice comint-line-beginning-position
5396     (around mdw-calculate-it-properly () activate compile)
5397   "Calculate the actual line start for multi-line input."
5398   (if (or comint-use-prompt-regexp
5399           (eq (field-at-pos (point)) 'output))
5400       ad-do-it
5401     (setq ad-return-value
5402             (constrain-to-field (line-beginning-position) (point)))))
5403
5404 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
5405 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
5406 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
5407 (defun term-send-meta-meta-something ()
5408   (interactive)
5409   (term-send-raw-string "\e\e")
5410   (term-send-raw))
5411 (eval-after-load 'term
5412   '(progn
5413      (define-key term-raw-map [?\e ?\e] nil)
5414      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
5415      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
5416      (define-key term-raw-map [M-right] 'term-send-meta-right)
5417      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
5418      (define-key term-raw-map [M-left] 'term-send-meta-left)
5419      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
5420
5421 (defadvice term-exec (before program-args-list compile activate)
5422   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
5423 This allows you to pass a list of arguments through `ansi-term'."
5424   (let ((program (ad-get-arg 2)))
5425     (if (listp program)
5426         (progn
5427           (ad-set-arg 2 (car program))
5428           (ad-set-arg 4 (cdr program))))))
5429
5430 (defadvice term-exec-1 (around hack-environment compile activate)
5431   "Hack the environment inherited by inferiors in the terminal."
5432   (let ((process-environment (copy-tree process-environment)))
5433     (setenv "LD_PRELOAD" nil)
5434     ad-do-it))
5435
5436 (defadvice shell (around hack-environment compile activate)
5437   "Hack the environment inherited by inferiors in the shell."
5438   (let ((process-environment (copy-tree process-environment)))
5439     (setenv "LD_PRELOAD" nil)
5440     ad-do-it))
5441
5442 (defun ssh (host)
5443   "Open a terminal containing an ssh session to the HOST."
5444   (interactive "sHost: ")
5445   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
5446
5447 (defcustom git-grep-command
5448   "env GIT_PAGER=cat git grep --no-color -nH -e "
5449   "The default command for \\[git-grep]."
5450   :type 'string)
5451
5452 (defvar git-grep-history nil)
5453
5454 (defun git-grep (command-args)
5455   "Run `git grep' with user-specified args and collect output in a buffer."
5456   (interactive
5457    (list (read-shell-command "Run git grep (like this): "
5458                              git-grep-command 'git-grep-history)))
5459   (let ((grep-use-null-device nil))
5460     (grep command-args)))
5461
5462 ;;;--------------------------------------------------------------------------
5463 ;;; Magit configuration.
5464
5465 (setq magit-diff-refine-hunk 't
5466       magit-view-git-manual-method 'man
5467       magit-log-margin '(nil age magit-log-margin-width t 18)
5468       magit-wip-after-save-local-mode-lighter ""
5469       magit-wip-after-apply-mode-lighter ""
5470       magit-wip-before-change-mode-lighter "")
5471 (eval-after-load "magit"
5472   '(progn (global-magit-file-mode 1)
5473           (magit-wip-after-save-mode 1)
5474           (magit-wip-after-apply-mode 1)
5475           (magit-wip-before-change-mode 1)
5476           (add-to-list 'magit-no-confirm 'safe-with-wip)
5477           (add-to-list 'magit-no-confirm 'trash)
5478           (push '(:eval (if (or magit-wip-after-save-local-mode
5479                                 magit-wip-after-apply-mode
5480                                 magit-wip-before-change-mode)
5481                             (format " wip:%s%s%s"
5482                                     (if magit-wip-after-apply-mode "A" "")
5483                                     (if magit-wip-before-change-mode "C" "")
5484                                     (if magit-wip-after-save-local-mode "S" ""))))
5485                 minor-mode-alist)
5486           (dolist (popup '(magit-diff-popup
5487                            magit-diff-refresh-popup
5488                            magit-diff-mode-refresh-popup
5489                            magit-revision-mode-refresh-popup))
5490             (magit-define-popup-switch popup ?R "Reverse diff" "-R"))
5491           (magit-define-popup-switch 'magit-rebase-popup ?r
5492                                      "Rebase merges" "--rebase-merges")))
5493
5494 (defadvice magit-wip-commit-buffer-file
5495     (around mdw-just-this-buffer activate compile)
5496   (let ((magit-save-repository-buffers nil)) ad-do-it))
5497
5498 (defadvice magit-discard
5499     (around mdw-delete-if-prefix-argument activate compile)
5500   (let ((magit-delete-by-moving-to-trash
5501          (and (null current-prefix-arg)
5502               magit-delete-by-moving-to-trash)))
5503     ad-do-it))
5504
5505 (setq magit-repolist-columns
5506         '(("Name" 16 magit-repolist-column-ident nil)
5507           ("Version" 18 magit-repolist-column-version nil)
5508           ("St" 2 magit-repolist-column-dirty nil)
5509           ("L<U" 3 mdw-repolist-column-unpulled-from-upstream nil)
5510           ("L>U" 3 mdw-repolist-column-unpushed-to-upstream nil)
5511           ("Path" 32 magit-repolist-column-path nil)))
5512
5513 (setq magit-repository-directories '(("~/etc/profile" . 0)
5514                                      ("~/src/" . 1)))
5515
5516 (defadvice magit-list-repos (around mdw-dirname () activate compile)
5517   "Make sure the returned names are directory names.
5518 Otherwise child processes get started in the wrong directory and
5519 there is sadness."
5520   (setq ad-return-value (mapcar #'file-name-as-directory ad-do-it)))
5521
5522 (defun mdw-repolist-column-unpulled-from-upstream (_id)
5523   "Insert number of upstream commits not in the current branch."
5524   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5525     (and upstream
5526          (let ((n (cadr (magit-rev-diff-count "HEAD" upstream))))
5527            (propertize (number-to-string n) 'face
5528                        (if (> n 0) 'bold 'shadow))))))
5529
5530 (defun mdw-repolist-column-unpushed-to-upstream (_id)
5531   "Insert number of commits in the current branch but not its upstream."
5532   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5533     (and upstream
5534          (let ((n (car (magit-rev-diff-count "HEAD" upstream))))
5535            (propertize (number-to-string n) 'face
5536                        (if (> n 0) 'bold 'shadow))))))
5537
5538 (defun mdw-try-smerge ()
5539   (save-excursion
5540     (goto-char (point-min))
5541     (when (re-search-forward "^<<<<<<< " nil t)
5542       (smerge-mode 1))))
5543 (add-hook 'find-file-hook 'mdw-try-smerge t)
5544
5545 (defcustom mdw-magit-new-window-modes
5546   '(magit-diff-mode
5547     magit-log-mode
5548     magit-process-mode
5549     magit-revision-mode
5550     magit-stash-mode
5551     magit-status-mode)
5552   "Magit modes which should cause a new window to be used."
5553   :type '(repeat symbol))
5554
5555 (defun mdw-display-magit-buffer (buffer)
5556   "Like `magit-display-buffer-traditional'.
5557 But uses `mdw-magit-new-window-modes' for its list of modes
5558 rather than baking the list into the function."
5559   (display-buffer buffer
5560                   (let ((mode (with-current-buffer buffer major-mode)))
5561                     (if (and (not mdw-designated-window)
5562                              (derived-mode-p 'magit-mode)
5563                              (mdw-submode-p mode 'magit-mode)
5564                              (not (memq mode mdw-magit-new-window-modes)))
5565                         '(display-buffer-same-window . nil)
5566                       nil))))
5567 (setq magit-display-buffer-function 'mdw-display-magit-buffer)
5568
5569 (defun mdw-display-magit-file-buffer (buffer)
5570   "Show a file buffer from a diff."
5571   (select-window (display-buffer buffer)))
5572 (setq magit-display-file-buffer-function 'mdw-display-magit-file-buffer)
5573
5574 ;;;--------------------------------------------------------------------------
5575 ;;; GUD, and especially GDB.
5576
5577 ;; Inhibit window dedication.  I mean, seriously, wtf?
5578 (defadvice gdb-display-buffer (after mdw-undedicated (buf) compile activate)
5579   "Don't make windows dedicated.  Seriously."
5580   (set-window-dedicated-p ad-return-value nil))
5581 (defadvice gdb-set-window-buffer
5582     (after mdw-undedicated (name &optional ignore-dedicated window)
5583      compile activate)
5584   "Don't make windows dedicated.  Seriously."
5585   (set-window-dedicated-p (or window (selected-window)) nil))
5586
5587 (defadvice gud-find-expr
5588     (around mdw-inhibit-read-only (&rest args) compile activate)
5589   "Inhibit errors caused by my setting of `comint-prompt-read-only'."
5590   (let ((inhibit-read-only t)) ad-do-it))
5591
5592 ;;;--------------------------------------------------------------------------
5593 ;;; SQL stuff.
5594
5595 (setq sql-postgres-options '("-n" "-P" "pager=off")
5596       sql-postgres-login-params
5597         '((user :default "mdw")
5598           (database :default "mdw")
5599           (server :default "db.distorted.org.uk")))
5600
5601 ;;;--------------------------------------------------------------------------
5602 ;;; Man pages.
5603
5604 ;; Turn off `noip' when running `man': it interferes with `man-db''s own
5605 ;; seccomp(2)-based sandboxing, which is (in this case, at least) strictly
5606 ;; better.
5607 (defadvice Man-getpage-in-background
5608     (around mdw-inhibit-noip (topic) compile activate)
5609   "Inhibit the `noip' preload hack when invoking `man'."
5610   (let* ((old-preload (getenv "LD_PRELOAD"))
5611          (preloads (and old-preload
5612                         (save-match-data (split-string old-preload ":"))))
5613          (any nil)
5614          (filtered nil))
5615     (save-match-data
5616       (while preloads
5617         (let ((item (pop preloads)))
5618           (if (string-match  "\\(/\\|^\\)noip\.so\\(:\\|$\\)" item)
5619               (setq any t)
5620             (push item filtered)))))
5621     (if any
5622         (unwind-protect
5623             (progn
5624               (setenv "LD_PRELOAD"
5625                       (and filtered
5626                            (with-output-to-string
5627                              (setq filtered (nreverse filtered))
5628                              (let ((first t))
5629                                (while filtered
5630                                  (if first (setq first nil)
5631                                    (write-char ?:))
5632                                  (write-string (pop filtered)))))))
5633               ad-do-it)
5634           (setenv "LD_PRELOAD" old-preload))
5635       ad-do-it)))
5636
5637 ;;;--------------------------------------------------------------------------
5638 ;;; MPC configuration.
5639
5640 (eval-when-compile (trap (require 'mpc)))
5641
5642 (setq mpc-browser-tags '(Artist|Composer|Performer Album|Playlist))
5643
5644 (defun mdw-mpc-now-playing ()
5645   (interactive)
5646   (require 'mpc)
5647   (save-excursion
5648     (set-buffer (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong"))))
5649     (mpc--status-callback))
5650   (let ((state (cdr (assq 'state mpc-status))))
5651     (cond ((member state '("stop"))
5652            (message "mpd stopped."))
5653           ((member state '("play" "pause"))
5654            (let* ((artist (cdr (assq 'Artist mpc-status)))
5655                   (album (cdr (assq 'Album mpc-status)))
5656                   (title (cdr (assq 'Title mpc-status)))
5657                   (file (cdr (assq 'file mpc-status)))
5658                   (duration-string (cdr (assq 'Time mpc-status)))
5659                   (time-string (cdr (assq 'time mpc-status)))
5660                   (time (and time-string
5661                              (string-to-number
5662                               (if (string-match ":" time-string)
5663                                   (substring time-string
5664                                              0 (match-beginning 0))
5665                                 (time-string)))))
5666                   (duration (and duration-string
5667                                  (string-to-number duration-string)))
5668                   (pos (and time duration
5669                             (format " [%d:%02d/%d:%02d]"
5670                                     (/ time 60) (mod time 60)
5671                                     (/ duration 60) (mod duration 60))))
5672                   (fmt (cond ((and artist title)
5673                               (format "`%s' by %s%s" title artist
5674                                       (if album (format ", from `%s'" album)
5675                                         "")))
5676                              (file
5677                               (format "`%s' (no tags)" file))
5678                              (t
5679                               "(no idea what's playing!)"))))
5680              (if (string= state "play")
5681                  (message "mpd playing %s%s" fmt (or pos ""))
5682                (message "mpd paused in %s%s" fmt (or pos "")))))
5683           (t
5684            (message "mpd in unknown state `%s'" state)))))
5685
5686 (defmacro mdw-define-mpc-wrapper (func bvl interactive &rest body)
5687   `(defun ,func ,bvl
5688      (interactive ,@interactive)
5689      (require 'mpc)
5690      ,@body
5691      (mdw-mpc-now-playing)))
5692
5693 (mdw-define-mpc-wrapper mdw-mpc-play-or-pause () nil
5694   (if (member (cdr (assq 'state (mpc-cmd-status))) '("play"))
5695       (mpc-pause)
5696     (mpc-play)))
5697
5698 (mdw-define-mpc-wrapper mdw-mpc-next () nil (mpc-next))
5699 (mdw-define-mpc-wrapper mdw-mpc-prev () nil (mpc-prev))
5700 (mdw-define-mpc-wrapper mdw-mpc-stop () nil (mpc-stop))
5701
5702 (defun mdw-mpc-louder (step)
5703   (interactive (list (if current-prefix-arg
5704                          (prefix-numeric-value current-prefix-arg)
5705                        +10)))
5706   (mpc-proc-cmd (format "volume %+d" step)))
5707
5708 (defun mdw-mpc-quieter (step)
5709   (interactive (list (if current-prefix-arg
5710                          (prefix-numeric-value current-prefix-arg)
5711                        +10)))
5712   (mpc-proc-cmd (format "volume %+d" (- step))))
5713
5714 (defun mdw-mpc-hack-lines (arg interactivep func)
5715   (if (and interactivep (use-region-p))
5716       (let ((from (region-beginning)) (to (region-end)))
5717         (goto-char from)
5718         (beginning-of-line)
5719         (funcall func)
5720         (forward-line)
5721         (while (< (point) to)
5722           (funcall func)
5723           (forward-line)))
5724     (let ((n (prefix-numeric-value arg)))
5725       (cond ((cl-minusp n)
5726              (unless (bolp)
5727                (beginning-of-line)
5728                (funcall func)
5729                (cl-incf n))
5730              (while (cl-minusp n)
5731                (forward-line -1)
5732                (funcall func)
5733                (cl-incf n)))
5734             (t
5735              (beginning-of-line)
5736              (while (cl-plusp n)
5737                (funcall func)
5738                (forward-line)
5739                (cl-decf n)))))))
5740
5741 (defun mdw-mpc-select-one ()
5742   (when (and (get-char-property (point) 'mpc-file)
5743              (not (get-char-property (point) 'mpc-select)))
5744     (mpc-select-toggle)))
5745
5746 (defun mdw-mpc-unselect-one ()
5747   (when (get-char-property (point) 'mpc-select)
5748     (mpc-select-toggle)))
5749
5750 (defun mdw-mpc-select (&optional arg interactivep)
5751   (interactive (list current-prefix-arg t))
5752   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5753
5754 (defun mdw-mpc-unselect (&optional arg interactivep)
5755   (interactive (list current-prefix-arg t))
5756   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-unselect-one))
5757
5758 (defun mdw-mpc-unselect-backwards (arg)
5759   (interactive "p")
5760   (mdw-mpc-hack-lines (- arg) t 'mdw-mpc-unselect-one))
5761
5762 (defun mdw-mpc-unselect-all ()
5763   (interactive)
5764   (setq mpc-select nil)
5765   (mpc-selection-refresh))
5766
5767 (defun mdw-mpc-next-line (arg)
5768   (interactive "p")
5769   (beginning-of-line)
5770   (forward-line arg))
5771
5772 (defun mdw-mpc-previous-line (arg)
5773   (interactive "p")
5774   (beginning-of-line)
5775   (forward-line (- arg)))
5776
5777 (defun mdw-mpc-playlist-add (&optional arg interactivep)
5778   (interactive (list current-prefix-arg t))
5779   (let ((mpc-select mpc-select))
5780     (when (or arg (and interactivep (use-region-p)))
5781       (setq mpc-select nil)
5782       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5783     (setq mpc-select (reverse mpc-select))
5784     (mpc-playlist-add)))
5785
5786 (defun mdw-mpc-playlist-delete (&optional arg interactivep)
5787   (interactive (list current-prefix-arg t))
5788   (setq mpc-select (nreverse mpc-select))
5789   (mpc-select-save
5790     (when (or arg (and interactivep (use-region-p)))
5791       (setq mpc-select nil)
5792       (mpc-selection-refresh)
5793       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5794       (mpc-playlist-delete)))
5795
5796 (defun mdw-mpc-hack-tagbrowsers ()
5797   (setq-local mode-line-format
5798                 '("%e"
5799                   mode-line-frame-identification
5800                   mode-line-buffer-identification)))
5801 (add-hook 'mpc-tagbrowser-mode-hook 'mdw-mpc-hack-tagbrowsers)
5802
5803 (defun mdw-mpc-hack-songs ()
5804   (setq-local header-line-format
5805               ;; '("MPC " mpc-volume " " mpc-current-song)
5806               (list (propertize " " 'display '(space :align-to 0))
5807                     ;; 'mpc-songs-format-description
5808                     '(:eval
5809                       (let ((deactivate-mark) (hscroll (window-hscroll)))
5810                         (with-temp-buffer
5811                           (mpc-format mpc-songs-format 'self hscroll)
5812                           ;; That would be simpler than the hscroll handling in
5813                           ;; mpc-format, but currently move-to-column does not
5814                           ;; recognize :space display properties.
5815                           ;; (move-to-column hscroll)
5816                           ;; (delete-region (point-min) (point))
5817                           (buffer-string)))))))
5818 (add-hook 'mpc-songs-mode-hook 'mdw-mpc-hack-songs)
5819
5820 (eval-after-load "mpc"
5821   '(progn
5822      (define-key mpc-mode-map "m" 'mdw-mpc-select)
5823      (define-key mpc-mode-map "u" 'mdw-mpc-unselect)
5824      (define-key mpc-mode-map "\177" 'mdw-mpc-unselect-backwards)
5825      (define-key mpc-mode-map "\e\177" 'mdw-mpc-unselect-all)
5826      (define-key mpc-mode-map "n" 'mdw-mpc-next-line)
5827      (define-key mpc-mode-map "p" 'mdw-mpc-previous-line)
5828      (define-key mpc-mode-map "/" 'mpc-songs-search)
5829      (setq mpc-songs-mode-map (make-sparse-keymap))
5830      (set-keymap-parent mpc-songs-mode-map mpc-mode-map)
5831      (define-key mpc-songs-mode-map "l" 'mpc-playlist)
5832      (define-key mpc-songs-mode-map "+" 'mdw-mpc-playlist-add)
5833      (define-key mpc-songs-mode-map "-" 'mdw-mpc-playlist-delete)
5834      (define-key mpc-songs-mode-map "\r" 'mpc-songs-jump-to)))
5835
5836 ;;;--------------------------------------------------------------------------
5837 ;;; Inferior Emacs Lisp.
5838
5839 (setq comint-prompt-read-only t)
5840
5841 (eval-after-load "comint"
5842   '(progn
5843      (define-key comint-mode-map "\C-w" 'comint-kill-region)
5844      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
5845
5846 (eval-after-load "ielm"
5847   '(progn
5848      (define-key ielm-map "\C-w" 'comint-kill-region)
5849      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
5850
5851 ;;;----- That's all, folks --------------------------------------------------
5852
5853 (provide 'dot-emacs)