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