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