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