chiark / gitweb /
el/dot-emacs.el: Remove menu bar from dumb terminals.
[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
MW
26
27(defvar mdw-fast-startup nil
28 "Whether .emacs should optimize for rapid startup.
29This may be at the expense of cool features.")
30(let ((probe nil) (next command-line-args))
c7a8da49
MW
31 (while next
32 (cond ((string= (car next) "--mdw-fast-startup")
33 (setq mdw-fast-startup t)
34 (if probe
35 (rplacd probe (cdr next))
36 (setq command-line-args (cdr next))))
37 (t
38 (setq probe next)))
39 (setq next (cdr next))))
40
6132bc01
MW
41;;;--------------------------------------------------------------------------
42;;; Some general utilities.
f617db13 43
417dcddd
MW
44(eval-when-compile
45 (unless (fboundp 'make-regexp)
46 (load "make-regexp"))
47 (require 'cl))
c7a8da49
MW
48
49(defmacro mdw-regexps (&rest list)
50 "Turn a LIST of strings into a single regular expression at compile-time."
9e789ed5
MW
51 (declare (indent nil)
52 (debug 0))
417dcddd 53 `',(make-regexp list))
c7a8da49 54
6132bc01 55;; Some error trapping.
f617db13
MW
56;;
57;; If individual bits of this file go tits-up, we don't particularly want
58;; the whole lot to stop right there and then, because it's bloody annoying.
59
60(defmacro trap (&rest forms)
61 "Execute FORMS without allowing errors to propagate outside."
9e789ed5
MW
62 (declare (indent 0)
63 (debug t))
f617db13
MW
64 `(condition-case err
65 ,(if (cdr forms) (cons 'progn forms) (car forms))
8df912e4
MW
66 (error (message "Error (trapped): %s in %s"
67 (error-message-string err)
68 ',forms))))
f617db13 69
6132bc01 70;; Configuration reading.
f141fe0f
MW
71
72(defvar mdw-config nil)
73(defun mdw-config (sym)
74 "Read the configuration variable named SYM."
75 (unless mdw-config
daff679f
MW
76 (setq mdw-config
77 (flet ((replace (what with)
78 (goto-char (point-min))
79 (while (re-search-forward what nil t)
80 (replace-match with t))))
81 (with-temp-buffer
82 (insert-file-contents "~/.mdw.conf")
83 (replace "^[ \t]*\\(#.*\\|\\)\n" "")
84 (replace (concat "^[ \t]*"
85 "\\([-a-zA-Z0-9_.]*\\)"
86 "[ \t]*=[ \t]*"
87 "\\(.*[^ \t\n]\\|\\)"
88 "[ \t]**\\(\n\\|$\\)")
89 "(\\1 . \"\\2\")\n")
90 (car (read-from-string
91 (concat "(" (buffer-string) ")")))))))
f141fe0f
MW
92 (cdr (assq sym mdw-config)))
93
6132bc01 94;; Set up the load path convincingly.
eac7b622
MW
95
96(dolist (dir (append (and (boundp 'debian-emacs-flavor)
97 (list (concat "/usr/share/"
98 (symbol-name debian-emacs-flavor)
99 "/site-lisp")))))
100 (dolist (sub (directory-files dir t))
101 (when (and (file-accessible-directory-p sub)
102 (not (member sub load-path)))
103 (setq load-path (nconc load-path (list sub))))))
104
6132bc01 105;; Is an Emacs library available?
cb6e2cd1
MW
106
107(defun library-exists-p (name)
6132bc01
MW
108 "Return non-nil if NAME is an available library.
109Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
110load path. The non-nil value is the filename we found for the
111library."
cb6e2cd1
MW
112 (let ((path load-path) elt (foundp nil))
113 (while (and path (not foundp))
114 (setq elt (car path))
115 (setq path (cdr path))
116 (setq foundp (or (let ((file (concat elt "/" name ".elc")))
117 (and (file-exists-p file) file))
118 (let ((file (concat elt "/" name ".el")))
119 (and (file-exists-p file) file)))))
120 foundp))
121
122(defun maybe-autoload (symbol file &optional docstring interactivep type)
123 "Set an autoload if the file actually exists."
124 (and (library-exists-p file)
125 (autoload symbol file docstring interactivep type)))
126
6132bc01 127;; Splitting windows.
f617db13 128
8c2b05d5
MW
129(unless (fboundp 'scroll-bar-columns)
130 (defun scroll-bar-columns (side)
131 (cond ((eq side 'left) 0)
132 (window-system 3)
133 (t 1))))
134(unless (fboundp 'fringe-columns)
135 (defun fringe-columns (side)
136 (cond ((not window-system) 0)
137 ((eq side 'left) 1)
138 (t 2))))
139
140(defun mdw-divvy-window (&optional width)
f617db13 141 "Split a wide window into appropriate widths."
8c2b05d5
MW
142 (interactive "P")
143 (setq width (cond (width (prefix-numeric-value width))
144 ((and window-system
145 (>= emacs-major-version 22))
146 77)
147 (t 78)))
b5d724dd
MW
148 (let* ((win (selected-window))
149 (sb-width (if (not window-system)
150 1
8c2b05d5
MW
151 (let ((tot 0))
152 (dolist (what '(scroll-bar fringe))
153 (dolist (side '(left right))
154 (incf tot
155 (funcall (intern (concat (symbol-name what)
156 "-columns"))
157 side))))
158 tot)))
b5d724dd 159 (c (/ (+ (window-width) sb-width)
8c2b05d5 160 (+ width sb-width))))
f617db13
MW
161 (while (> c 1)
162 (setq c (1- c))
8c2b05d5 163 (split-window-horizontally (+ width sb-width))
f617db13
MW
164 (other-window 1))
165 (select-window win)))
166
6132bc01 167;; Functions for sexp diary entries.
f617db13
MW
168
169(defun mdw-weekday (l)
170 "Return non-nil if `date' falls on one of the days of the week in L.
6132bc01
MW
171L is a list of day numbers (from 0 to 6 for Sunday through to
172Saturday) or symbols `sunday', `monday', etc. (or a mixture). If
173the date stored in `date' falls on a listed day, then the
174function returns non-nil."
f617db13
MW
175 (let ((d (calendar-day-of-week date)))
176 (or (memq d l)
177 (memq (nth d '(sunday monday tuesday wednesday
178 thursday friday saturday)) l))))
179
180(defun mdw-todo (&optional when)
181 "Return non-nil today, or on WHEN, whichever is later."
182 (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
183 (d (calendar-absolute-from-gregorian date)))
184 (if when
185 (setq w (max w (calendar-absolute-from-gregorian
186 (cond
187 ((not european-calendar-style)
188 when)
189 ((> (car when) 100)
190 (list (nth 1 when)
191 (nth 2 when)
192 (nth 0 when)))
193 (t
194 (list (nth 1 when)
195 (nth 0 when)
196 (nth 2 when))))))))
197 (eq w d)))
198
6132bc01 199;; Fighting with Org-mode's evil key maps.
16fe7c41
MW
200
201(defvar mdw-evil-keymap-keys
202 '(([S-up] . [?\C-c up])
203 ([S-down] . [?\C-c down])
204 ([S-left] . [?\C-c left])
205 ([S-right] . [?\C-c right])
206 (([M-up] [?\e up]) . [C-up])
207 (([M-down] [?\e down]) . [C-down])
208 (([M-left] [?\e left]) . [C-left])
209 (([M-right] [?\e right]) . [C-right]))
210 "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
211The value is an alist mapping evil keys (as a list, or singleton)
212to good keys (in the same form).")
213
214(defun mdw-clobber-evil-keymap (keymap)
215 "Replace evil key bindings in the KEYMAP.
216Evil key bindings are defined in `mdw-evil-keymap-keys'."
217 (dolist (entry mdw-evil-keymap-keys)
218 (let ((binding nil)
219 (keys (if (listp (car entry))
220 (car entry)
221 (list (car entry))))
222 (replacements (if (listp (cdr entry))
223 (cdr entry)
224 (list (cdr entry)))))
225 (catch 'found
226 (dolist (key keys)
227 (setq binding (lookup-key keymap key))
228 (when binding
229 (throw 'found nil))))
230 (when binding
231 (dolist (key keys)
232 (define-key keymap key nil))
233 (dolist (key replacements)
234 (define-key keymap key binding))))))
235
0f6be0b1 236(eval-after-load "org-latex"
f0dbee84
MW
237 '(progn
238 (push '("strayman"
239 "\\documentclass{strayman}
240\\usepackage[utf8]{inputenc}
241\\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
242\\usepackage[T1]{fontenc}
243\\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
244 ("\\section{%s}" . "\\section*{%s}")
245 ("\\subsection{%s}" . "\\subsection*{%s}")
246 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
247 ("\\paragraph{%s}" . "\\paragraph*{%s}")
248 ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
249 org-export-latex-classes)))
250
6132bc01
MW
251;;;--------------------------------------------------------------------------
252;;; Mail and news hacking.
a3bdb4d9
MW
253
254(define-derived-mode mdwmail-mode mail-mode "[mdw] mail"
6132bc01 255 "Major mode for editing news and mail messages from external programs.
a3bdb4d9
MW
256Not much right now. Just support for doing MailCrypt stuff."
257 :syntax-table nil
258 :abbrev-table nil
259 (run-hooks 'mail-setup-hook))
260
261(define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
262
263(add-hook 'mdwail-mode-hook
264 (lambda ()
265 (set-buffer-file-coding-system 'utf-8)
266 (make-local-variable 'paragraph-separate)
267 (make-local-variable 'paragraph-start)
268 (setq paragraph-start
269 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
270 paragraph-start))
271 (setq paragraph-separate
272 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
273 paragraph-separate))))
274
6132bc01 275;; How to encrypt in mdwmail.
a3bdb4d9
MW
276
277(defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
278 (or start
279 (setq start (save-excursion
280 (goto-char (point-min))
281 (or (search-forward "\n\n" nil t) (point-min)))))
282 (or end
283 (setq end (point-max)))
284 (mc-encrypt-generic recip scm start end from sign))
285
6132bc01 286;; How to sign in mdwmail.
a3bdb4d9
MW
287
288(defun mdwmail-mc-sign (key scm start end uclr)
289 (or start
290 (setq start (save-excursion
291 (goto-char (point-min))
292 (or (search-forward "\n\n" nil t) (point-min)))))
293 (or end
294 (setq end (point-max)))
295 (mc-sign-generic key scm start end uclr))
296
6132bc01 297;; Some signature mangling.
a3bdb4d9
MW
298
299(defun mdwmail-mangle-signature ()
300 (save-excursion
301 (goto-char (point-min))
302 (perform-replace "\n-- \n" "\n-- " nil nil nil)))
303(add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
304(add-hook 'message-setup-hook 'mdwmail-mangle-signature)
305
6132bc01 306;; Insert my login name into message-ids, so I can score replies.
a3bdb4d9
MW
307
308(defadvice message-unique-id (after mdw-user-name last activate compile)
309 "Ensure that the user's name appears at the end of the message-id string,
310so that it can be used for convenient filtering."
311 (setq ad-return-value (concat ad-return-value "." (user-login-name))))
312
6132bc01 313;; Tell my movemail hack where movemail is.
a3bdb4d9
MW
314;;
315;; This is needed to shup up warnings about LD_PRELOAD.
316
317(let ((path exec-path))
318 (while path
319 (let ((try (expand-file-name "movemail" (car path))))
320 (if (file-executable-p try)
321 (setenv "REAL_MOVEMAIL" try))
322 (setq path (cdr path)))))
323
6132bc01
MW
324;;;--------------------------------------------------------------------------
325;;; Utility functions.
f617db13 326
b5d724dd
MW
327(or (fboundp 'line-number-at-pos)
328 (defun line-number-at-pos (&optional pos)
329 (let ((opoint (or pos (point))) start)
330 (save-excursion
331 (save-restriction
332 (goto-char (point-min))
333 (widen)
334 (forward-line 0)
335 (setq start (point))
336 (goto-char opoint)
337 (forward-line 0)
338 (1+ (count-lines 1 (point))))))))
459c9fb2 339
f617db13 340(defun mdw-uniquify-alist (&rest alists)
f617db13 341 "Return the concatenation of the ALISTS with duplicate elements removed.
6132bc01
MW
342The first association with a given key prevails; others are
343ignored. The input lists are not modified, although they'll
344probably become garbage."
f617db13
MW
345 (and alists
346 (let ((start-list (cons nil nil)))
347 (mdw-do-uniquify start-list
348 start-list
349 (car alists)
350 (cdr alists)))))
351
f617db13 352(defun mdw-do-uniquify (done end l rest)
6132bc01
MW
353 "A helper function for mdw-uniquify-alist.
354The DONE argument is a list whose first element is `nil'. It
355contains the uniquified alist built so far. The leading `nil' is
356stripped off at the end of the operation; it's only there so that
357DONE always references a cons cell. END refers to the final cons
358cell in the DONE list; it is modified in place each time to avoid
359the overheads of `append'ing all the time. The L argument is the
360alist we're currently processing; the remaining alists are given
361in REST."
362
363 ;; There are several different cases to deal with here.
f617db13
MW
364 (cond
365
6132bc01
MW
366 ;; Current list isn't empty. Add the first item to the DONE list if
367 ;; there's not an item with the same KEY already there.
f617db13
MW
368 (l (or (assoc (car (car l)) done)
369 (progn
370 (setcdr end (cons (car l) nil))
371 (setq end (cdr end))))
372 (mdw-do-uniquify done end (cdr l) rest))
373
6132bc01
MW
374 ;; The list we were working on is empty. Shunt the next list into the
375 ;; current list position and go round again.
f617db13
MW
376 (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
377
6132bc01
MW
378 ;; Everything's done. Remove the leading `nil' from the DONE list and
379 ;; return it. Finished!
f617db13
MW
380 (t (cdr done))))
381
f617db13
MW
382(defun date ()
383 "Insert the current date in a pleasing way."
384 (interactive)
385 (insert (save-excursion
386 (let ((buffer (get-buffer-create "*tmp*")))
387 (unwind-protect (progn (set-buffer buffer)
388 (erase-buffer)
389 (shell-command "date +%Y-%m-%d" t)
390 (goto-char (mark))
391 (delete-backward-char 1)
392 (buffer-string))
393 (kill-buffer buffer))))))
394
f617db13
MW
395(defun uuencode (file &optional name)
396 "UUencodes a file, maybe calling it NAME, into the current buffer."
397 (interactive "fInput file name: ")
398
6132bc01 399 ;; If NAME isn't specified, then guess from the filename.
f617db13
MW
400 (if (not name)
401 (setq name
402 (substring file
403 (or (string-match "[^/]*$" file) 0))))
f617db13
MW
404 (print (format "uuencode `%s' `%s'" file name))
405
6132bc01 406 ;; Now actually do the thing.
f617db13
MW
407 (call-process "uuencode" file t nil name))
408
409(defvar np-file "~/.np"
410 "*Where the `now-playing' file is.")
411
412(defun np (&optional arg)
413 "Grabs a `now-playing' string."
414 (interactive)
415 (save-excursion
416 (or arg (progn
852cd5fb 417 (goto-char (point-max))
f617db13 418 (insert "\nNP: ")
daff679f 419 (insert-file-contents np-file)))))
f617db13 420
c7a8da49 421(defun mdw-check-autorevert ()
6132bc01
MW
422 "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
423This takes into consideration whether it's been found using
424tramp, which seems to get itself into a twist."
46e69f55
MW
425 (cond ((not (boundp 'global-auto-revert-ignore-buffer))
426 nil)
427 ((and (buffer-file-name)
428 (fboundp 'tramp-tramp-file-p)
c7a8da49
MW
429 (tramp-tramp-file-p (buffer-file-name)))
430 (unless global-auto-revert-ignore-buffer
431 (setq global-auto-revert-ignore-buffer 'tramp)))
432 ((eq global-auto-revert-ignore-buffer 'tramp)
433 (setq global-auto-revert-ignore-buffer nil))))
434
435(defadvice find-file (after mdw-autorevert activate)
436 (mdw-check-autorevert))
437(defadvice write-file (after mdw-autorevert activate)
4d9f2d65 438 (mdw-check-autorevert))
eae0aa6d 439
6132bc01
MW
440;;;--------------------------------------------------------------------------
441;;; Dired hacking.
5195cbc3
MW
442
443(defadvice dired-maybe-insert-subdir
444 (around mdw-marked-insertion first activate)
6132bc01
MW
445 "The DIRNAME may be a list of directory names to insert.
446Interactively, if files are marked, then insert all of them.
447With a numeric prefix argument, select that many entries near
448point; with a non-numeric prefix argument, prompt for listing
449options."
5195cbc3
MW
450 (interactive
451 (list (dired-get-marked-files nil
452 (and (integerp current-prefix-arg)
453 current-prefix-arg)
454 #'file-directory-p)
455 (and current-prefix-arg
456 (not (integerp current-prefix-arg))
457 (read-string "Switches for listing: "
458 (or dired-subdir-switches
459 dired-actual-switches)))))
460 (let ((dirs (ad-get-arg 0)))
461 (dolist (dir (if (listp dirs) dirs (list dirs)))
462 (ad-set-arg 0 dir)
463 ad-do-it)))
464
6132bc01
MW
465;;;--------------------------------------------------------------------------
466;;; URL viewing.
a203fba8
MW
467
468(defun mdw-w3m-browse-url (url &optional new-session-p)
469 "Invoke w3m on the URL in its current window, or at least a different one.
470If NEW-SESSION-P, start a new session."
471 (interactive "sURL: \nP")
472 (save-excursion
63fb20c1
MW
473 (let ((window (selected-window)))
474 (unwind-protect
475 (progn
476 (select-window (or (and (not new-session-p)
477 (get-buffer-window "*w3m*"))
478 (progn
479 (if (one-window-p t) (split-window))
480 (get-lru-window))))
481 (w3m-browse-url url new-session-p))
482 (select-window window)))))
a203fba8
MW
483
484(defvar mdw-good-url-browsers
485 '((w3m . mdw-w3m-browse-url)
486 browse-url-w3
487 browse-url-mozilla)
6132bc01
MW
488 "List of good browsers for mdw-good-url-browsers.
489Each item is a browser function name, or a cons (CHECK . FUNC).
490A symbol FOO stands for (FOO . FOO).")
a203fba8
MW
491
492(defun mdw-good-url-browser ()
6132bc01
MW
493 "Return a good URL browser.
494Trundle the list of such things, finding the first item for which
495CHECK is fboundp, and returning the correponding FUNC."
a203fba8
MW
496 (let ((bs mdw-good-url-browsers) b check func answer)
497 (while (and bs (not answer))
498 (setq b (car bs)
499 bs (cdr bs))
500 (if (consp b)
501 (setq check (car b) func (cdr b))
502 (setq check b func b))
503 (if (fboundp check)
504 (setq answer func)))
505 answer))
506
f36cdb77
MW
507(eval-after-load "w3m-search"
508 '(progn
509 (dolist
510 (item
511 '(("g" "Google" "http://www.google.co.uk/search?q=%s")
512 ("gd" "Google Directory"
513 "http://www.google.com/search?cat=gwd/Top&q=%s")
514 ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
515 ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
516 ("gi" "Images" "http://images.google.com/images?q=%s")
517 ("rfc" "RFC"
518 "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
519 ("wp" "Wikipedia"
520 "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
521 ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
522 ("nc-wiki" "nCipher wiki"
523 "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
524 ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
525 ("lp" "Launchpad bug by number"
526 "https://bugs.launchpad.net/bugs/%s")
527 ("lppkg" "Launchpad bugs by package"
528 "https://bugs.launchpad.net/%s")
529 ("msdn" "MSDN"
530 "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
531 ("debbug" "Debian bug by number"
532 "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
533 ("debbugpkg" "Debian bugs by package"
534 "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
535 ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
536 (add-to-list 'w3m-search-engine-alist
537 (list (cadr item) (caddr item) nil))
538 (add-to-list 'w3m-uri-replace-alist
539 (list (concat "\\`" (car item) ":")
540 'w3m-search-uri-replace
541 (cadr item))))))
542
6132bc01
MW
543;;;--------------------------------------------------------------------------
544;;; Paragraph filling.
f617db13 545
6132bc01 546;; Useful variables.
f617db13
MW
547
548(defvar mdw-fill-prefix nil
6132bc01
MW
549 "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
550If there's no fill prefix currently set (by the `fill-prefix'
551variable) and there's a match from one of the regexps here, it
552gets used to set the fill-prefix for the current operation.
f617db13 553
6132bc01
MW
554The variable is a list of items of the form `REGEXP . PREFIX'; if
555the REGEXP matches, the PREFIX is used to set the fill prefix.
556It in turn is a list of things:
f617db13
MW
557
558 STRING -- insert a literal string
559 (match . N) -- insert the thing matched by bracketed subexpression N
560 (pad . N) -- a string of whitespace the same width as subexpression N
561 (expr . FORM) -- the result of evaluating FORM")
562
563(make-variable-buffer-local 'mdw-fill-prefix)
564
565(defvar mdw-hanging-indents
10fa2414
MW
566 (concat "\\(\\("
567 "\\([*o]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
568 "[ \t]+"
569 "\\)?\\)")
6132bc01
MW
570 "*Standard regexp matching parts of a hanging indent.
571This is mainly useful in `auto-fill-mode'.")
f617db13 572
6132bc01 573;; Setting things up.
f617db13
MW
574
575(fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
576
6132bc01 577;; Utility functions.
f617db13
MW
578
579(defun mdw-tabify (s)
580 "Tabify the string S. This is a horrid hack."
581 (save-excursion
582 (save-match-data
583 (let (start end)
584 (beginning-of-line)
585 (setq start (point-marker))
586 (insert s "\n")
587 (setq end (point-marker))
588 (tabify start end)
589 (setq s (buffer-substring start (1- end)))
590 (delete-region start end)
591 (set-marker start nil)
592 (set-marker end nil)
593 s))))
594
595(defun mdw-examine-fill-prefixes (l)
6132bc01
MW
596 "Given a list of dynamic fill prefixes, pick one which matches
597context and return the static fill prefix to use. Point must be
598at the start of a line, and match data must be saved."
f617db13
MW
599 (cond ((not l) nil)
600 ((looking-at (car (car l)))
601 (mdw-tabify (apply (function concat)
602 (mapcar (function mdw-do-prefix-match)
603 (cdr (car l))))))
604 (t (mdw-examine-fill-prefixes (cdr l)))))
605
606(defun mdw-maybe-car (p)
607 "If P is a pair, return (car P), otherwise just return P."
608 (if (consp p) (car p) p))
609
610(defun mdw-padding (s)
611 "Return a string the same width as S but made entirely from whitespace."
612 (let* ((l (length s)) (i 0) (n (make-string l ? )))
613 (while (< i l)
614 (if (= 9 (aref s i))
615 (aset n i 9))
616 (setq i (1+ i)))
617 n))
618
619(defun mdw-do-prefix-match (m)
6132bc01
MW
620 "Expand a dynamic prefix match element.
621See `mdw-fill-prefix' for details."
f617db13
MW
622 (cond ((not (consp m)) (format "%s" m))
623 ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
624 ((eq (car m) 'pad) (mdw-padding (match-string
625 (mdw-maybe-car (cdr m)))))
626 ((eq (car m) 'eval) (eval (cdr m)))
627 (t "")))
628
629(defun mdw-choose-dynamic-fill-prefix ()
630 "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
631 (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
632 ((not mdw-fill-prefix) fill-prefix)
633 (t (save-excursion
634 (beginning-of-line)
635 (save-match-data
636 (mdw-examine-fill-prefixes mdw-fill-prefix))))))
637
638(defun do-auto-fill ()
6132bc01
MW
639 "Handle auto-filling, working out a dynamic fill prefix in the
640case where there isn't a sensible static one."
f617db13
MW
641 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
642 (mdw-do-auto-fill)))
643
644(defun mdw-fill-paragraph ()
645 "Fill paragraph, getting a dynamic fill prefix."
646 (interactive)
647 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
648 (fill-paragraph nil)))
649
650(defun mdw-standard-fill-prefix (rx &optional mat)
651 "Set the dynamic fill prefix, handling standard hanging indents and stuff.
6132bc01
MW
652This is just a short-cut for setting the thing by hand, and by
653design it doesn't cope with anything approximating a complicated
654case."
f617db13
MW
655 (setq mdw-fill-prefix
656 `((,(concat rx mdw-hanging-indents)
657 (match . 1)
658 (pad . ,(or mat 2))))))
659
6132bc01
MW
660;;;--------------------------------------------------------------------------
661;;; Other common declarations.
f617db13 662
6132bc01 663;; Common mode settings.
f617db13
MW
664
665(defvar mdw-auto-indent t
666 "Whether to indent automatically after a newline.")
667
668(defun mdw-misc-mode-config ()
669 (and mdw-auto-indent
670 (cond ((eq major-mode 'lisp-mode)
671 (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
30c8a8fb
MW
672 ((or (eq major-mode 'slime-repl-mode)
673 (eq major-mode 'asm-mode))
674 nil)
f617db13
MW
675 (t
676 (local-set-key "\C-m" 'newline-and-indent))))
677 (local-set-key [C-return] 'newline)
8cb7626b
MW
678 (make-variable-buffer-local 'page-delimiter)
679 (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
f617db13
MW
680 (setq comment-column 40)
681 (auto-fill-mode 1)
682 (setq fill-column 77)
473ff3b0 683 (setq show-trailing-whitespace t)
5fabceb3
MW
684 (let ((whitespace-style (remove 'trailing whitespace-style)))
685 (trap (whitespace-mode t)))
253f61b4
MW
686 (and (fboundp 'gtags-mode)
687 (gtags-mode))
5de5db48 688 (outline-minor-mode t)
e1d21c56 689 (hs-minor-mode t)
49b2646e 690 (reveal-mode t)
1e7a9479 691 (trap (turn-on-font-lock)))
f617db13 692
ed7b46b9
MW
693(defun mdw-post-config-mode-hack ()
694 (let ((whitespace-style (remove 'trailing whitespace-style)))
695 (trap (whitespace-mode t))))
696
253f61b4 697(eval-after-load 'gtags
506bada9
MW
698 '(progn
699 (dolist (key '([mouse-2] [mouse-3]))
700 (define-key gtags-mode-map key nil))
701 (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
702 (define-key gtags-select-mode-map [C-S-mouse-2]
703 'gtags-select-tag-by-event)
704 (dolist (map (list gtags-mode-map gtags-select-mode-map))
705 (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
253f61b4 706
6132bc01 707;; Backup file handling.
2ae647c4
MW
708
709(defvar mdw-backup-disable-regexps nil
6132bc01
MW
710 "*List of regular expressions: if a file name matches any of
711these then the file is not backed up.")
2ae647c4
MW
712
713(defun mdw-backup-enable-predicate (name)
6132bc01
MW
714 "[mdw]'s default backup predicate.
715Allows a backup if the standard predicate would allow it, and it
716doesn't match any of the regular expressions in
717`mdw-backup-disable-regexps'."
2ae647c4
MW
718 (and (normal-backup-enable-predicate name)
719 (let ((answer t) (list mdw-backup-disable-regexps))
720 (save-match-data
721 (while list
722 (if (string-match (car list) name)
723 (setq answer nil))
724 (setq list (cdr list)))
725 answer))))
726(setq backup-enable-predicate 'mdw-backup-enable-predicate)
727
7bb78c67
MW
728;; Frame cleanup.
729
730(defun mdw-last-one-out-turn-off-the-lights (frame)
731 "Disconnect from an X display if this was the last frame on that display."
732 (let ((frame-display (frame-parameter frame 'display)))
733 (when (and frame-display
734 (eq window-system 'x)
735 (not (some (lambda (fr)
736 (message "checking frame %s" frame)
737 (and (not (eq fr frame))
a04d8f3d 738 (string= (frame-parameter fr 'display)
7bb78c67
MW
739 frame-display)
740 (progn "frame %s still uses us" nil)))
741 (frame-list))))
7bb78c67
MW
742 (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
743(add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
744
255ee1fc
MW
745(defvar mdw-frame-parameters-alist
746 '((nil (menu-bar-lines . 0))))
747(defun mdw-set-frame-parameters (frame)
748 (let ((params (assq (if (fboundp 'window-system)
749 (window-system frame)
750 window-system)
751 mdw-frame-parameters-alist)))
752 (when params
753 (modify-frame-parameters frame (cdr params)))))
754(add-hook 'after-make-frame-functions 'mdw-set-frame-parameters)
755
6132bc01
MW
756;;;--------------------------------------------------------------------------
757;;; General fontification.
f617db13 758
1e7a9479
MW
759(defmacro mdw-define-face (name &rest body)
760 "Define a face, and make sure it's actually set as the definition."
761 (declare (indent 1)
762 (debug 0))
763 `(progn
764 (make-face ',name)
765 (defvar ,name ',name)
766 (put ',name 'face-defface-spec ',body)
88cb9c2b 767 (face-spec-set ',name ',body nil)))
1e7a9479
MW
768
769(mdw-define-face default
770 (((type w32)) :family "courier new" :height 85)
771 (((type x)) :family "6x13" :height 130)
db10ce0a
MW
772 (((type color)) :foreground "white" :background "black")
773 (t nil))
1e7a9479
MW
774(mdw-define-face fixed-pitch
775 (((type w32)) :family "courier new" :height 85)
776 (((type x)) :family "6x13" :height 130)
777 (t :foreground "white" :background "black"))
c383eb8a
MW
778(if (>= emacs-major-version 23)
779 (mdw-define-face variable-pitch
780 (((type x)) :family "sans" :height 100))
781 (mdw-define-face variable-pitch
782 (((type x)) :family "helvetica" :height 120)))
1e7a9479 783(mdw-define-face region
db10ce0a
MW
784 (((type tty) (class color)) :background "blue")
785 (((type tty) (class mono)) :inverse-video t)
786 (t :background "grey30"))
1e7a9479
MW
787(mdw-define-face minibuffer-prompt
788 (t :weight bold))
789(mdw-define-face mode-line
db10ce0a
MW
790 (((class color)) :foreground "blue" :background "yellow"
791 :box (:line-width 1 :style released-button))
792 (t :inverse-video t))
1e7a9479 793(mdw-define-face mode-line-inactive
db10ce0a
MW
794 (((class color)) :foreground "yellow" :background "blue"
795 :box (:line-width 1 :style released-button))
796 (t :inverse-video t))
1e7a9479
MW
797(mdw-define-face scroll-bar
798 (t :foreground "black" :background "lightgrey"))
799(mdw-define-face fringe
800 (t :foreground "yellow"))
c383eb8a 801(mdw-define-face show-paren-match
db10ce0a
MW
802 (((class color)) :background "darkgreen")
803 (t :underline t))
c383eb8a 804(mdw-define-face show-paren-mismatch
db10ce0a
MW
805 (((class color)) :background "red")
806 (t :inverse-video t))
1e7a9479 807(mdw-define-face highlight
db10ce0a
MW
808 (((class color)) :background "DarkSeaGreen4")
809 (t :inverse-video t))
1e7a9479
MW
810
811(mdw-define-face holiday-face
812 (t :background "red"))
813(mdw-define-face calendar-today-face
814 (t :foreground "yellow" :weight bold))
815
816(mdw-define-face comint-highlight-prompt
817 (t :weight bold))
db10ce0a 818(mdw-define-face comint-highlight-input)
1e7a9479
MW
819
820(mdw-define-face trailing-whitespace
db10ce0a
MW
821 (((class color)) :background "red")
822 (t :inverse-video t))
1e7a9479
MW
823(mdw-define-face mdw-punct-face
824 (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
825(mdw-define-face mdw-number-face
826 (t :foreground "yellow"))
827(mdw-define-face font-lock-function-name-face
c383eb8a 828 (t :slant italic))
1e7a9479
MW
829(mdw-define-face font-lock-keyword-face
830 (t :weight bold))
831(mdw-define-face font-lock-constant-face
832 (t :slant italic))
833(mdw-define-face font-lock-builtin-face
834 (t :weight bold))
07965a39
MW
835(mdw-define-face font-lock-type-face
836 (t :weight bold :slant italic))
1e7a9479
MW
837(mdw-define-face font-lock-reference-face
838 (t :weight bold))
839(mdw-define-face font-lock-variable-name-face
840 (t :slant italic))
841(mdw-define-face font-lock-comment-delimiter-face
db10ce0a
MW
842 (((class mono)) :weight bold)
843 (((type tty) (class color)) :foreground "green")
844 (t :slant italic :foreground "SeaGreen1"))
1e7a9479 845(mdw-define-face font-lock-comment-face
db10ce0a
MW
846 (((class mono)) :weight bold)
847 (((type tty) (class color)) :foreground "green")
848 (t :slant italic :foreground "SeaGreen1"))
1e7a9479 849(mdw-define-face font-lock-string-face
db10ce0a
MW
850 (((class mono)) :weight bold)
851 (((class color)) :foreground "SkyBlue1"))
1e7a9479
MW
852(mdw-define-face message-separator
853 (t :background "red" :foreground "white" :weight bold))
854(mdw-define-face message-cited-text
855 (default :slant italic)
856 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
857(mdw-define-face message-header-cc
858 (default :weight bold)
859 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
860(mdw-define-face message-header-newsgroups
861 (default :weight bold)
862 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
863(mdw-define-face message-header-subject
864 (default :weight bold)
865 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
866(mdw-define-face message-header-to
867 (default :weight bold)
868 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
869(mdw-define-face message-header-xheader
870 (default :weight bold)
871 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
872(mdw-define-face message-header-other
873 (default :weight bold)
874 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
875(mdw-define-face message-header-name
876 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
877
878(mdw-define-face diff-index
879 (t :weight bold))
880(mdw-define-face diff-file-header
881 (t :weight bold))
882(mdw-define-face diff-hunk-header
883 (t :foreground "SkyBlue1"))
884(mdw-define-face diff-function
885 (t :foreground "SkyBlue1" :weight bold))
886(mdw-define-face diff-header
887 (t :background "grey10"))
888(mdw-define-face diff-added
889 (t :foreground "green"))
890(mdw-define-face diff-removed
891 (t :foreground "red"))
892(mdw-define-face diff-context)
893
e1b8de18
MW
894(mdw-define-face erc-input-face
895 (t :foreground "red"))
896
1e7a9479
MW
897(mdw-define-face woman-bold
898 (t :weight bold))
899(mdw-define-face woman-italic
900 (t :slant italic))
901
902(mdw-define-face p4-depot-added-face
903 (t :foreground "green"))
904(mdw-define-face p4-depot-branch-op-face
905 (t :foreground "yellow"))
906(mdw-define-face p4-depot-deleted-face
907 (t :foreground "red"))
908(mdw-define-face p4-depot-unmapped-face
909 (t :foreground "SkyBlue1"))
910(mdw-define-face p4-diff-change-face
911 (t :foreground "yellow"))
912(mdw-define-face p4-diff-del-face
913 (t :foreground "red"))
914(mdw-define-face p4-diff-file-face
915 (t :foreground "SkyBlue1"))
916(mdw-define-face p4-diff-head-face
917 (t :background "grey10"))
918(mdw-define-face p4-diff-ins-face
919 (t :foreground "green"))
920
921(mdw-define-face whizzy-slice-face
922 (t :background "grey10"))
923(mdw-define-face whizzy-error-face
924 (t :background "darkred"))
f617db13 925
6132bc01
MW
926;;;--------------------------------------------------------------------------
927;;; C programming configuration.
f617db13 928
6132bc01 929;; Linux kernel hacking.
f617db13
MW
930
931(defvar linux-c-mode-hook)
932
933(defun linux-c-mode ()
934 (interactive)
935 (c-mode)
936 (setq major-mode 'linux-c-mode)
937 (setq mode-name "Linux C")
938 (run-hooks 'linux-c-mode-hook))
939
6132bc01 940;; Make C indentation nice.
f617db13 941
f50c1bed
MW
942(defun mdw-c-lineup-arglist (langelem)
943 "Hack for DWIMmery in c-lineup-arglist."
944 (if (save-excursion
945 (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
946 0
947 (c-lineup-arglist langelem)))
948
949(defun mdw-c-indent-extern-mumble (langelem)
950 "Indent `extern \"...\" {' lines."
951 (save-excursion
952 (back-to-indentation)
953 (if (looking-at
954 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
955 c-basic-offset
956 nil)))
957
f617db13
MW
958(defun mdw-c-style ()
959 (c-add-style "[mdw] C and C++ style"
960 '((c-basic-offset . 2)
f617db13
MW
961 (comment-column . 40)
962 (c-class-key . "class")
f50c1bed
MW
963 (c-backslash-column . 72)
964 (c-offsets-alist
965 (substatement-open . (add 0 c-indent-one-line-block))
966 (defun-open . (add 0 c-indent-one-line-block))
967 (arglist-cont-nonempty . mdw-c-lineup-arglist)
968 (topmost-intro . mdw-c-indent-extern-mumble)
969 (cpp-define-intro . 0)
970 (inextern-lang . [0])
971 (label . 0)
972 (case-label . +)
973 (access-label . -)
974 (inclass . +)
975 (inline-open . ++)
976 (statement-cont . 0)
977 (statement-case-intro . +)))
f617db13
MW
978 t))
979
0e7d960b
MW
980(defvar mdw-c-comment-fill-prefix
981 `((,(concat "\\([ \t]*/?\\)"
982 "\\(\*\\|//]\\)"
983 "\\([ \t]*\\)"
984 "\\([A-Za-z]+:[ \t]*\\)?"
985 mdw-hanging-indents)
986 (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
987 "Fill prefix matching C comments (both kinds).")
988
f617db13
MW
989(defun mdw-fontify-c-and-c++ ()
990
6132bc01 991 ;; Fiddle with some syntax codes.
f617db13
MW
992 (modify-syntax-entry ?* ". 23")
993 (modify-syntax-entry ?/ ". 124b")
994 (modify-syntax-entry ?\n "> b")
995
6132bc01 996 ;; Other stuff.
f617db13
MW
997 (mdw-c-style)
998 (setq c-hanging-comment-ender-p nil)
999 (setq c-backslash-column 72)
1000 (setq c-label-minimum-indentation 0)
0e7d960b 1001 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 1002
6132bc01 1003 ;; Now define things to be fontified.
02109a0d 1004 (make-local-variable 'font-lock-keywords)
f617db13 1005 (let ((c-keywords
8d6d55b9
MW
1006 (mdw-regexps "and" ;C++
1007 "and_eq" ;C++
1008 "asm" ;K&R, GCC
1009 "auto" ;K&R, C89
1010 "bitand" ;C++
1011 "bitor" ;C++
1012 "bool" ;C++, C9X macro
1013 "break" ;K&R, C89
1014 "case" ;K&R, C89
1015 "catch" ;C++
1016 "char" ;K&R, C89
1017 "class" ;C++
1018 "complex" ;C9X macro, C++ template type
1019 "compl" ;C++
1020 "const" ;C89
1021 "const_cast" ;C++
1022 "continue" ;K&R, C89
1023 "defined" ;C89 preprocessor
1024 "default" ;K&R, C89
1025 "delete" ;C++
1026 "do" ;K&R, C89
1027 "double" ;K&R, C89
1028 "dynamic_cast" ;C++
1029 "else" ;K&R, C89
1030 ;; "entry" ;K&R -- never used
1031 "enum" ;C89
1032 "explicit" ;C++
1033 "export" ;C++
1034 "extern" ;K&R, C89
1035 "false" ;C++, C9X macro
1036 "float" ;K&R, C89
1037 "for" ;K&R, C89
1038 ;; "fortran" ;K&R
1039 "friend" ;C++
1040 "goto" ;K&R, C89
1041 "if" ;K&R, C89
1042 "imaginary" ;C9X macro
1043 "inline" ;C++, C9X, GCC
1044 "int" ;K&R, C89
1045 "long" ;K&R, C89
1046 "mutable" ;C++
1047 "namespace" ;C++
1048 "new" ;C++
1049 "operator" ;C++
1050 "or" ;C++
1051 "or_eq" ;C++
1052 "private" ;C++
1053 "protected" ;C++
1054 "public" ;C++
1055 "register" ;K&R, C89
1056 "reinterpret_cast" ;C++
1057 "restrict" ;C9X
1058 "return" ;K&R, C89
1059 "short" ;K&R, C89
1060 "signed" ;C89
1061 "sizeof" ;K&R, C89
1062 "static" ;K&R, C89
1063 "static_cast" ;C++
1064 "struct" ;K&R, C89
1065 "switch" ;K&R, C89
1066 "template" ;C++
1067 "this" ;C++
1068 "throw" ;C++
1069 "true" ;C++, C9X macro
1070 "try" ;C++
1071 "this" ;C++
1072 "typedef" ;C89
1073 "typeid" ;C++
1074 "typeof" ;GCC
1075 "typename" ;C++
1076 "union" ;K&R, C89
1077 "unsigned" ;K&R, C89
1078 "using" ;C++
1079 "virtual" ;C++
1080 "void" ;C89
1081 "volatile" ;C89
1082 "wchar_t" ;C++, C89 library type
1083 "while" ;K&R, C89
1084 "xor" ;C++
1085 "xor_eq" ;C++
1086 "_Bool" ;C9X
1087 "_Complex" ;C9X
1088 "_Imaginary" ;C9X
1089 "_Pragma" ;C9X preprocessor
1090 "__alignof__" ;GCC
1091 "__asm__" ;GCC
1092 "__attribute__" ;GCC
1093 "__complex__" ;GCC
1094 "__const__" ;GCC
1095 "__extension__" ;GCC
1096 "__imag__" ;GCC
1097 "__inline__" ;GCC
1098 "__label__" ;GCC
1099 "__real__" ;GCC
1100 "__signed__" ;GCC
1101 "__typeof__" ;GCC
1102 "__volatile__" ;GCC
1103 ))
f617db13 1104 (preprocessor-keywords
8d6d55b9
MW
1105 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1106 "ident" "if" "ifdef" "ifndef" "import" "include"
1107 "line" "pragma" "unassert" "undef" "warning"))
f617db13 1108 (objc-keywords
8d6d55b9
MW
1109 (mdw-regexps "class" "defs" "encode" "end" "implementation"
1110 "interface" "private" "protected" "protocol" "public"
1111 "selector")))
f617db13
MW
1112
1113 (setq font-lock-keywords
1114 (list
f617db13 1115
6132bc01 1116 ;; Fontify include files as strings.
f617db13
MW
1117 (list (concat "^[ \t]*\\#[ \t]*"
1118 "\\(include\\|import\\)"
1119 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1120 '(2 font-lock-string-face))
1121
6132bc01 1122 ;; Preprocessor directives are `references'?.
f617db13
MW
1123 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1124 preprocessor-keywords
1125 "\\)\\>\\|[0-9]+\\|$\\)\\)")
1126 '(1 font-lock-keyword-face))
1127
6132bc01 1128 ;; Handle the keywords defined above.
f617db13
MW
1129 (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1130 '(0 font-lock-keyword-face))
1131
1132 (list (concat "\\<\\(" c-keywords "\\)\\>")
1133 '(0 font-lock-keyword-face))
1134
6132bc01 1135 ;; Handle numbers too.
f617db13
MW
1136 ;;
1137 ;; This looks strange, I know. It corresponds to the
1138 ;; preprocessor's idea of what a number looks like, rather than
1139 ;; anything sensible.
f617db13
MW
1140 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1141 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1142 '(0 mdw-number-face))
1143
6132bc01 1144 ;; And anything else is punctuation.
f617db13 1145 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1146 '(0 mdw-punct-face))))
1147
1148 (mdw-post-config-mode-hack)))
f617db13 1149
6132bc01
MW
1150;;;--------------------------------------------------------------------------
1151;;; AP calc mode.
f617db13
MW
1152
1153(defun apcalc-mode ()
1154 (interactive)
1155 (c-mode)
1156 (setq major-mode 'apcalc-mode)
1157 (setq mode-name "AP Calc")
1158 (run-hooks 'apcalc-mode-hook))
1159
1160(defun mdw-fontify-apcalc ()
1161
6132bc01 1162 ;; Fiddle with some syntax codes.
f617db13
MW
1163 (modify-syntax-entry ?* ". 23")
1164 (modify-syntax-entry ?/ ". 14")
1165
6132bc01 1166 ;; Other stuff.
f617db13
MW
1167 (mdw-c-style)
1168 (setq c-hanging-comment-ender-p nil)
1169 (setq c-backslash-column 72)
1170 (setq comment-start "/* ")
1171 (setq comment-end " */")
0e7d960b 1172 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 1173
6132bc01 1174 ;; Now define things to be fontified.
02109a0d 1175 (make-local-variable 'font-lock-keywords)
f617db13 1176 (let ((c-keywords
8d6d55b9
MW
1177 (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1178 "do" "else" "exit" "for" "global" "goto" "help" "if"
1179 "local" "mat" "obj" "print" "quit" "read" "return"
1180 "show" "static" "switch" "while" "write")))
f617db13
MW
1181
1182 (setq font-lock-keywords
1183 (list
f617db13 1184
6132bc01 1185 ;; Handle the keywords defined above.
f617db13
MW
1186 (list (concat "\\<\\(" c-keywords "\\)\\>")
1187 '(0 font-lock-keyword-face))
1188
6132bc01 1189 ;; Handle numbers too.
f617db13
MW
1190 ;;
1191 ;; This looks strange, I know. It corresponds to the
1192 ;; preprocessor's idea of what a number looks like, rather than
1193 ;; anything sensible.
f617db13
MW
1194 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1195 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1196 '(0 mdw-number-face))
1197
6132bc01 1198 ;; And anything else is punctuation.
f617db13 1199 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1200 '(0 mdw-punct-face)))))
1201
1202 (mdw-post-config-mode-hack))
f617db13 1203
6132bc01
MW
1204;;;--------------------------------------------------------------------------
1205;;; Java programming configuration.
f617db13 1206
6132bc01 1207;; Make indentation nice.
f617db13
MW
1208
1209(defun mdw-java-style ()
1210 (c-add-style "[mdw] Java style"
1211 '((c-basic-offset . 2)
f617db13
MW
1212 (c-offsets-alist (substatement-open . 0)
1213 (label . +)
1214 (case-label . +)
1215 (access-label . 0)
1216 (inclass . +)
1217 (statement-case-intro . +)))
1218 t))
1219
6132bc01 1220;; Declare Java fontification style.
f617db13
MW
1221
1222(defun mdw-fontify-java ()
1223
6132bc01 1224 ;; Other stuff.
f617db13 1225 (mdw-java-style)
f617db13
MW
1226 (setq c-hanging-comment-ender-p nil)
1227 (setq c-backslash-column 72)
0e7d960b 1228 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 1229
6132bc01 1230 ;; Now define things to be fontified.
02109a0d 1231 (make-local-variable 'font-lock-keywords)
f617db13 1232 (let ((java-keywords
8d6d55b9
MW
1233 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1234 "char" "class" "const" "continue" "default" "do"
1235 "double" "else" "extends" "final" "finally" "float"
1236 "for" "goto" "if" "implements" "import" "instanceof"
1237 "int" "interface" "long" "native" "new" "package"
1238 "private" "protected" "public" "return" "short"
1239 "static" "super" "switch" "synchronized" "this"
1240 "throw" "throws" "transient" "try" "void" "volatile"
1241 "while"
1242
1243 "false" "null" "true")))
f617db13
MW
1244
1245 (setq font-lock-keywords
1246 (list
f617db13 1247
6132bc01 1248 ;; Handle the keywords defined above.
f617db13
MW
1249 (list (concat "\\<\\(" java-keywords "\\)\\>")
1250 '(0 font-lock-keyword-face))
1251
6132bc01 1252 ;; Handle numbers too.
f617db13
MW
1253 ;;
1254 ;; The following isn't quite right, but it's close enough.
f617db13
MW
1255 (list (concat "\\<\\("
1256 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1257 "[0-9]+\\(\\.[0-9]*\\|\\)"
1258 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1259 "[lLfFdD]?")
1260 '(0 mdw-number-face))
1261
6132bc01 1262 ;; And anything else is punctuation.
f617db13 1263 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1264 '(0 mdw-punct-face)))))
1265
1266 (mdw-post-config-mode-hack))
f617db13 1267
6132bc01
MW
1268;;;--------------------------------------------------------------------------
1269;;; C# programming configuration.
e808c1e5 1270
6132bc01 1271;; Make indentation nice.
e808c1e5
MW
1272
1273(defun mdw-csharp-style ()
1274 (c-add-style "[mdw] C# style"
1275 '((c-basic-offset . 2)
e808c1e5
MW
1276 (c-offsets-alist (substatement-open . 0)
1277 (label . 0)
1278 (case-label . +)
1279 (access-label . 0)
1280 (inclass . +)
1281 (statement-case-intro . +)))
1282 t))
1283
6132bc01 1284;; Declare C# fontification style.
e808c1e5
MW
1285
1286(defun mdw-fontify-csharp ()
1287
6132bc01 1288 ;; Other stuff.
e808c1e5 1289 (mdw-csharp-style)
e808c1e5
MW
1290 (setq c-hanging-comment-ender-p nil)
1291 (setq c-backslash-column 72)
0e7d960b 1292 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
e808c1e5 1293
6132bc01 1294 ;; Now define things to be fontified.
e808c1e5
MW
1295 (make-local-variable 'font-lock-keywords)
1296 (let ((csharp-keywords
8d6d55b9
MW
1297 (mdw-regexps "abstract" "as" "base" "bool" "break"
1298 "byte" "case" "catch" "char" "checked"
1299 "class" "const" "continue" "decimal" "default"
1300 "delegate" "do" "double" "else" "enum"
1301 "event" "explicit" "extern" "false" "finally"
1302 "fixed" "float" "for" "foreach" "goto"
1303 "if" "implicit" "in" "int" "interface"
1304 "internal" "is" "lock" "long" "namespace"
1305 "new" "null" "object" "operator" "out"
1306 "override" "params" "private" "protected" "public"
1307 "readonly" "ref" "return" "sbyte" "sealed"
1308 "short" "sizeof" "stackalloc" "static" "string"
1309 "struct" "switch" "this" "throw" "true"
1310 "try" "typeof" "uint" "ulong" "unchecked"
1311 "unsafe" "ushort" "using" "virtual" "void"
1312 "volatile" "while" "yield")))
e808c1e5
MW
1313
1314 (setq font-lock-keywords
1315 (list
e808c1e5 1316
6132bc01 1317 ;; Handle the keywords defined above.
e808c1e5
MW
1318 (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1319 '(0 font-lock-keyword-face))
1320
6132bc01 1321 ;; Handle numbers too.
e808c1e5
MW
1322 ;;
1323 ;; The following isn't quite right, but it's close enough.
e808c1e5
MW
1324 (list (concat "\\<\\("
1325 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1326 "[0-9]+\\(\\.[0-9]*\\|\\)"
1327 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1328 "[lLfFdD]?")
1329 '(0 mdw-number-face))
1330
6132bc01 1331 ;; And anything else is punctuation.
e808c1e5 1332 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1333 '(0 mdw-punct-face)))))
1334
1335 (mdw-post-config-mode-hack))
e808c1e5 1336
103c5923
MW
1337(define-derived-mode csharp-mode java-mode "C#"
1338 "Major mode for editing C# code.")
e808c1e5 1339
6132bc01 1340;;;--------------------------------------------------------------------------
07965a39
MW
1341;;; Go programming configuration.
1342
1343(defun mdw-fontify-go ()
1344
1345 (make-local-variable 'font-lock-keywords)
1346 (let ((go-keywords
1347 (mdw-regexps "break" "case" "chan" "const" "continue"
1348 "default" "defer" "else" "fallthrough" "for"
1349 "func" "go" "goto" "if" "import"
1350 "interface" "map" "package" "range" "return"
1351 "select" "struct" "switch" "type" "var")))
1352
1353 (setq font-lock-keywords
1354 (list
1355
1356 ;; Handle the keywords defined above.
1357 (list (concat "\\<\\(" go-keywords "\\)\\>")
1358 '(0 font-lock-keyword-face))
1359
1360 ;; Handle numbers too.
1361 ;;
1362 ;; The following isn't quite right, but it's close enough.
1363 (list (concat "\\<\\("
1364 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1365 "[0-9]+\\(\\.[0-9]*\\|\\)"
1366 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1367 '(0 mdw-number-face))
1368
1369 ;; And anything else is punctuation.
1370 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1371 '(0 mdw-punct-face)))))
1372
1373 (mdw-post-config-mode-hack))
07965a39
MW
1374
1375;;;--------------------------------------------------------------------------
6132bc01 1376;;; Awk programming configuration.
f617db13 1377
6132bc01 1378;; Make Awk indentation nice.
f617db13
MW
1379
1380(defun mdw-awk-style ()
1381 (c-add-style "[mdw] Awk style"
1382 '((c-basic-offset . 2)
f617db13
MW
1383 (c-offsets-alist (substatement-open . 0)
1384 (statement-cont . 0)
1385 (statement-case-intro . +)))
1386 t))
1387
6132bc01 1388;; Declare Awk fontification style.
f617db13
MW
1389
1390(defun mdw-fontify-awk ()
1391
6132bc01 1392 ;; Miscellaneous fiddling.
f617db13
MW
1393 (mdw-awk-style)
1394 (setq c-backslash-column 72)
1395 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1396
6132bc01 1397 ;; Now define things to be fontified.
02109a0d 1398 (make-local-variable 'font-lock-keywords)
f617db13 1399 (let ((c-keywords
8d6d55b9
MW
1400 (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1401 "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1402 "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1403 "RSTART" "RLENGTH" "RT" "SUBSEP"
1404 "atan2" "break" "close" "continue" "cos" "delete"
1405 "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1406 "function" "gensub" "getline" "gsub" "if" "in"
1407 "index" "int" "length" "log" "match" "next" "rand"
1408 "return" "print" "printf" "sin" "split" "sprintf"
1409 "sqrt" "srand" "strftime" "sub" "substr" "system"
1410 "systime" "tolower" "toupper" "while")))
f617db13
MW
1411
1412 (setq font-lock-keywords
1413 (list
f617db13 1414
6132bc01 1415 ;; Handle the keywords defined above.
f617db13
MW
1416 (list (concat "\\<\\(" c-keywords "\\)\\>")
1417 '(0 font-lock-keyword-face))
1418
6132bc01 1419 ;; Handle numbers too.
f617db13
MW
1420 ;;
1421 ;; The following isn't quite right, but it's close enough.
f617db13
MW
1422 (list (concat "\\<\\("
1423 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1424 "[0-9]+\\(\\.[0-9]*\\|\\)"
1425 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1426 "[uUlL]*")
1427 '(0 mdw-number-face))
1428
6132bc01 1429 ;; And anything else is punctuation.
f617db13 1430 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1431 '(0 mdw-punct-face)))))
1432
1433 (mdw-post-config-mode-hack))
f617db13 1434
6132bc01
MW
1435;;;--------------------------------------------------------------------------
1436;;; Perl programming style.
f617db13 1437
6132bc01 1438;; Perl indentation style.
f617db13 1439
f617db13
MW
1440(setq cperl-indent-level 2)
1441(setq cperl-continued-statement-offset 2)
1442(setq cperl-continued-brace-offset 0)
1443(setq cperl-brace-offset -2)
1444(setq cperl-brace-imaginary-offset 0)
1445(setq cperl-label-offset 0)
1446
6132bc01 1447;; Define perl fontification style.
f617db13
MW
1448
1449(defun mdw-fontify-perl ()
1450
6132bc01 1451 ;; Miscellaneous fiddling.
f617db13
MW
1452 (modify-syntax-entry ?$ "\\")
1453 (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1454 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1455
6132bc01 1456 ;; Now define fontification things.
02109a0d 1457 (make-local-variable 'font-lock-keywords)
f617db13 1458 (let ((perl-keywords
8d6d55b9
MW
1459 (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1460 "for" "foreach" "ge" "gt" "goto" "if"
1461 "last" "le" "lt" "local" "my" "ne" "next" "or"
1462 "package" "redo" "require" "return" "sub"
1463 "undef" "unless" "until" "use" "while")))
f617db13
MW
1464
1465 (setq font-lock-keywords
1466 (list
f617db13 1467
6132bc01 1468 ;; Set up the keywords defined above.
f617db13
MW
1469 (list (concat "\\<\\(" perl-keywords "\\)\\>")
1470 '(0 font-lock-keyword-face))
1471
6132bc01 1472 ;; At least numbers are simpler than C.
f617db13
MW
1473 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1474 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1475 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1476 '(0 mdw-number-face))
1477
6132bc01 1478 ;; And anything else is punctuation.
f617db13 1479 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1480 '(0 mdw-punct-face)))))
1481
1482 (mdw-post-config-mode-hack))
f617db13
MW
1483
1484(defun perl-number-tests (&optional arg)
1485 "Assign consecutive numbers to lines containing `#t'. With ARG,
1486strip numbers instead."
1487 (interactive "P")
1488 (save-excursion
1489 (goto-char (point-min))
1490 (let ((i 0) (fmt (if arg "" " %4d")))
1491 (while (search-forward "#t" nil t)
1492 (delete-region (point) (line-end-position))
1493 (setq i (1+ i))
1494 (insert (format fmt i)))
1495 (goto-char (point-min))
1496 (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1497 (replace-match (format "\\1%d" i))))))
1498
6132bc01
MW
1499;;;--------------------------------------------------------------------------
1500;;; Python programming style.
f617db13 1501
99fe6ef5 1502(defun mdw-fontify-pythonic (keywords)
f617db13 1503
6132bc01 1504 ;; Miscellaneous fiddling.
f617db13
MW
1505 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1506
6132bc01 1507 ;; Now define fontification things.
02109a0d 1508 (make-local-variable 'font-lock-keywords)
99fe6ef5
MW
1509 (setq font-lock-keywords
1510 (list
f617db13 1511
be2cc788 1512 ;; Set up the keywords defined above.
29826b11 1513 (list (concat "\\<\\(" keywords "\\)\\>")
99fe6ef5 1514 '(0 font-lock-keyword-face))
f617db13 1515
be2cc788 1516 ;; At least numbers are simpler than C.
99fe6ef5
MW
1517 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1518 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1519 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1520 '(0 mdw-number-face))
f617db13 1521
be2cc788 1522 ;; And anything else is punctuation.
99fe6ef5 1523 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1524 '(0 mdw-punct-face))))
1525
1526 (mdw-post-config-mode-hack))
99fe6ef5 1527
be2cc788 1528;; Define Python fontification styles.
99fe6ef5
MW
1529
1530(defun mdw-fontify-python ()
1531 (mdw-fontify-pythonic
1532 (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1533 "del" "elif" "else" "except" "exec" "finally" "for"
1534 "from" "global" "if" "import" "in" "is" "lambda"
1535 "not" "or" "pass" "print" "raise" "return" "try"
1536 "while" "with" "yield")))
1537
1538(defun mdw-fontify-pyrex ()
1539 (mdw-fontify-pythonic
1540 (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
1541 "ctypedef" "def" "del" "elif" "else" "except" "exec"
1542 "extern" "finally" "for" "from" "global" "if"
1543 "import" "in" "is" "lambda" "not" "or" "pass" "print"
1544 "raise" "return" "struct" "try" "while" "with"
1545 "yield")))
f617db13 1546
6132bc01
MW
1547;;;--------------------------------------------------------------------------
1548;;; Icon programming style.
cc1980e1 1549
6132bc01 1550;; Icon indentation style.
cc1980e1
MW
1551
1552(setq icon-brace-offset 0
1553 icon-continued-brace-offset 0
1554 icon-continued-statement-offset 2
1555 icon-indent-level 2)
1556
6132bc01 1557;; Define Icon fontification style.
cc1980e1
MW
1558
1559(defun mdw-fontify-icon ()
1560
6132bc01 1561 ;; Miscellaneous fiddling.
cc1980e1
MW
1562 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1563
6132bc01 1564 ;; Now define fontification things.
cc1980e1
MW
1565 (make-local-variable 'font-lock-keywords)
1566 (let ((icon-keywords
1567 (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1568 "end" "every" "fail" "global" "if" "initial"
1569 "invocable" "link" "local" "next" "not" "of"
1570 "procedure" "record" "repeat" "return" "static"
1571 "suspend" "then" "to" "until" "while"))
1572 (preprocessor-keywords
1573 (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1574 "include" "line" "undef")))
1575 (setq font-lock-keywords
1576 (list
1577
6132bc01 1578 ;; Set up the keywords defined above.
cc1980e1
MW
1579 (list (concat "\\<\\(" icon-keywords "\\)\\>")
1580 '(0 font-lock-keyword-face))
1581
6132bc01 1582 ;; The things that Icon calls keywords.
cc1980e1
MW
1583 (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1584
6132bc01 1585 ;; At least numbers are simpler than C.
cc1980e1
MW
1586 (list (concat "\\<[0-9]+"
1587 "\\([rR][0-9a-zA-Z]+\\|"
1588 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1589 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1590 '(0 mdw-number-face))
1591
6132bc01 1592 ;; Preprocessor.
cc1980e1
MW
1593 (list (concat "^[ \t]*$[ \t]*\\<\\("
1594 preprocessor-keywords
1595 "\\)\\>")
1596 '(0 font-lock-keyword-face))
1597
6132bc01 1598 ;; And anything else is punctuation.
cc1980e1 1599 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1600 '(0 mdw-punct-face)))))
1601
1602 (mdw-post-config-mode-hack))
cc1980e1 1603
6132bc01
MW
1604;;;--------------------------------------------------------------------------
1605;;; ARM assembler programming configuration.
f617db13 1606
6132bc01 1607;; There doesn't appear to be an Emacs mode for this yet.
f617db13
MW
1608;;
1609;; Better do something about that, I suppose.
1610
1611(defvar arm-assembler-mode-map nil)
1612(defvar arm-assembler-abbrev-table nil)
1613(defvar arm-assembler-mode-syntax-table (make-syntax-table))
1614
1615(or arm-assembler-mode-map
1616 (progn
1617 (setq arm-assembler-mode-map (make-sparse-keymap))
1618 (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1619 (define-key arm-assembler-mode-map [C-return] 'newline)
1620 (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1621
1622(defun arm-assembler-mode ()
1623 "Major mode for ARM assembler programs"
1624 (interactive)
1625
6132bc01 1626 ;; Do standard major mode things.
f617db13
MW
1627 (kill-all-local-variables)
1628 (use-local-map arm-assembler-mode-map)
1629 (setq local-abbrev-table arm-assembler-abbrev-table)
1630 (setq major-mode 'arm-assembler-mode)
1631 (setq mode-name "ARM assembler")
1632
6132bc01 1633 ;; Set up syntax table.
f617db13
MW
1634 (set-syntax-table arm-assembler-mode-syntax-table)
1635 (modify-syntax-entry ?; ; Nasty hack
1636 "<" arm-assembler-mode-syntax-table)
1637 (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1638 (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1639
1640 (make-local-variable 'comment-start)
1641 (setq comment-start ";")
1642 (make-local-variable 'comment-end)
1643 (setq comment-end "")
1644 (make-local-variable 'comment-column)
1645 (setq comment-column 48)
1646 (make-local-variable 'comment-start-skip)
1647 (setq comment-start-skip ";+[ \t]*")
1648
6132bc01 1649 ;; Play with indentation.
f617db13
MW
1650 (make-local-variable 'indent-line-function)
1651 (setq indent-line-function 'indent-relative-maybe)
1652
6132bc01 1653 ;; Set fill prefix.
f617db13
MW
1654 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1655
6132bc01 1656 ;; Fiddle with fontification.
02109a0d 1657 (make-local-variable 'font-lock-keywords)
f617db13
MW
1658 (setq font-lock-keywords
1659 (list
f617db13 1660
6132bc01 1661 ;; Handle numbers too.
f617db13
MW
1662 ;;
1663 ;; The following isn't quite right, but it's close enough.
f617db13
MW
1664 (list (concat "\\("
1665 "&[0-9a-fA-F]+\\|"
1666 "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1667 "\\)")
1668 '(0 mdw-number-face))
1669
6132bc01 1670 ;; Do something about operators.
f617db13
MW
1671 (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1672 '(1 font-lock-keyword-face)
1673 '(2 font-lock-string-face))
1674 (list ":[a-zA-Z]+:"
1675 '(0 font-lock-keyword-face))
1676
6132bc01 1677 ;; Do menemonics and directives.
f617db13
MW
1678 (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1679 '(1 font-lock-keyword-face))
1680
6132bc01 1681 ;; And anything else is punctuation.
f617db13 1682 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9 1683 '(0 mdw-punct-face)))
f617db13 1684
ed7b46b9 1685 (mdw-post-config-mode-hack))
f617db13
MW
1686 (run-hooks 'arm-assembler-mode-hook))
1687
6132bc01
MW
1688;;;--------------------------------------------------------------------------
1689;;; Assembler mode.
30c8a8fb
MW
1690
1691(defun mdw-fontify-asm ()
1692 (modify-syntax-entry ?' "\"")
1693 (modify-syntax-entry ?. "w")
1694 (setf fill-prefix nil)
1695 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1696
6132bc01
MW
1697;;;--------------------------------------------------------------------------
1698;;; TCL configuration.
f617db13
MW
1699
1700(defun mdw-fontify-tcl ()
1701 (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1702 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
02109a0d 1703 (make-local-variable 'font-lock-keywords)
f617db13
MW
1704 (setq font-lock-keywords
1705 (list
f617db13
MW
1706 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1707 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1708 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1709 '(0 mdw-number-face))
1710 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1711 '(0 mdw-punct-face))))
1712 (mdw-post-config-mode-hack))
f617db13 1713
6132bc01
MW
1714;;;--------------------------------------------------------------------------
1715;;; REXX configuration.
f617db13
MW
1716
1717(defun mdw-rexx-electric-* ()
1718 (interactive)
1719 (insert ?*)
1720 (rexx-indent-line))
1721
1722(defun mdw-rexx-indent-newline-indent ()
1723 (interactive)
1724 (rexx-indent-line)
1725 (if abbrev-mode (expand-abbrev))
1726 (newline-and-indent))
1727
1728(defun mdw-fontify-rexx ()
1729
6132bc01 1730 ;; Various bits of fiddling.
f617db13
MW
1731 (setq mdw-auto-indent nil)
1732 (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1733 (local-set-key [?*] 'mdw-rexx-electric-*)
1734 (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
e443a4cd 1735 '(?! ?? ?# ?@ ?$))
f617db13
MW
1736 (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1737
6132bc01 1738 ;; Set up keywords and things for fontification.
f617db13
MW
1739 (make-local-variable 'font-lock-keywords-case-fold-search)
1740 (setq font-lock-keywords-case-fold-search t)
1741
1742 (setq rexx-indent 2)
1743 (setq rexx-end-indent rexx-indent)
f617db13
MW
1744 (setq rexx-cont-indent rexx-indent)
1745
02109a0d 1746 (make-local-variable 'font-lock-keywords)
f617db13 1747 (let ((rexx-keywords
8d6d55b9
MW
1748 (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1749 "else" "end" "engineering" "exit" "expose" "for"
1750 "forever" "form" "fuzz" "if" "interpret" "iterate"
1751 "leave" "linein" "name" "nop" "numeric" "off" "on"
1752 "options" "otherwise" "parse" "procedure" "pull"
1753 "push" "queue" "return" "say" "select" "signal"
1754 "scientific" "source" "then" "trace" "to" "until"
1755 "upper" "value" "var" "version" "when" "while"
1756 "with"
1757
1758 "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1759 "center" "center" "charin" "charout" "chars"
1760 "compare" "condition" "copies" "c2d" "c2x"
1761 "datatype" "date" "delstr" "delword" "d2c" "d2x"
1762 "errortext" "format" "fuzz" "insert" "lastpos"
1763 "left" "length" "lineout" "lines" "max" "min"
1764 "overlay" "pos" "queued" "random" "reverse" "right"
1765 "sign" "sourceline" "space" "stream" "strip"
1766 "substr" "subword" "symbol" "time" "translate"
1767 "trunc" "value" "verify" "word" "wordindex"
1768 "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1769 "x2d")))
f617db13
MW
1770
1771 (setq font-lock-keywords
1772 (list
f617db13 1773
6132bc01 1774 ;; Set up the keywords defined above.
f617db13
MW
1775 (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1776 '(0 font-lock-keyword-face))
1777
6132bc01 1778 ;; Fontify all symbols the same way.
f617db13
MW
1779 (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1780 "[A-Za-z0-9.!?_#@$]+\\)")
1781 '(0 font-lock-variable-name-face))
1782
6132bc01 1783 ;; And everything else is punctuation.
f617db13 1784 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1785 '(0 mdw-punct-face)))))
1786
1787 (mdw-post-config-mode-hack))
f617db13 1788
6132bc01
MW
1789;;;--------------------------------------------------------------------------
1790;;; Standard ML programming style.
f617db13
MW
1791
1792(defun mdw-fontify-sml ()
1793
6132bc01 1794 ;; Make underscore an honorary letter.
f617db13
MW
1795 (modify-syntax-entry ?' "w")
1796
6132bc01 1797 ;; Set fill prefix.
f617db13
MW
1798 (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1799
6132bc01 1800 ;; Now define fontification things.
02109a0d 1801 (make-local-variable 'font-lock-keywords)
f617db13 1802 (let ((sml-keywords
8d6d55b9
MW
1803 (mdw-regexps "abstype" "and" "andalso" "as"
1804 "case"
1805 "datatype" "do"
1806 "else" "end" "eqtype" "exception"
1807 "fn" "fun" "functor"
1808 "handle"
1809 "if" "in" "include" "infix" "infixr"
1810 "let" "local"
1811 "nonfix"
1812 "of" "op" "open" "orelse"
1813 "raise" "rec"
1814 "sharing" "sig" "signature" "struct" "structure"
1815 "then" "type"
1816 "val"
1817 "where" "while" "with" "withtype")))
f617db13
MW
1818
1819 (setq font-lock-keywords
1820 (list
f617db13 1821
6132bc01 1822 ;; Set up the keywords defined above.
f617db13
MW
1823 (list (concat "\\<\\(" sml-keywords "\\)\\>")
1824 '(0 font-lock-keyword-face))
1825
6132bc01 1826 ;; At least numbers are simpler than C.
f617db13
MW
1827 (list (concat "\\<\\(\\~\\|\\)"
1828 "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
852cd5fb
MW
1829 "[wW][0-9]+\\)\\|"
1830 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1831 "\\([eE]\\(\\~\\|\\)"
1832 "[0-9]+\\|\\)\\)\\)")
f617db13
MW
1833 '(0 mdw-number-face))
1834
6132bc01 1835 ;; And anything else is punctuation.
f617db13 1836 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1837 '(0 mdw-punct-face)))))
1838
1839 (mdw-post-config-mode-hack))
f617db13 1840
6132bc01
MW
1841;;;--------------------------------------------------------------------------
1842;;; Haskell configuration.
f617db13
MW
1843
1844(defun mdw-fontify-haskell ()
1845
6132bc01 1846 ;; Fiddle with syntax table to get comments right.
f617db13
MW
1847 (modify-syntax-entry ?' "\"")
1848 (modify-syntax-entry ?- ". 123")
1849 (modify-syntax-entry ?{ ". 1b")
1850 (modify-syntax-entry ?} ". 4b")
1851 (modify-syntax-entry ?\n ">")
1852
6132bc01 1853 ;; Set fill prefix.
f617db13
MW
1854 (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1855
6132bc01 1856 ;; Fiddle with fontification.
02109a0d 1857 (make-local-variable 'font-lock-keywords)
f617db13 1858 (let ((haskell-keywords
8d6d55b9
MW
1859 (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1860 "deriving" "do" "else" "foreign" "hiding" "if"
1861 "import" "in" "infix" "infixl" "infixr" "instance"
1862 "let" "module" "newtype" "of" "qualified" "safe"
1863 "stdcall" "then" "type" "unsafe" "where")))
f617db13
MW
1864
1865 (setq font-lock-keywords
1866 (list
f617db13
MW
1867 (list "--.*$"
1868 '(0 font-lock-comment-face))
1869 (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1870 '(0 font-lock-keyword-face))
1871 (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1872 "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1873 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1874 '(0 mdw-number-face))
1875 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1876 '(0 mdw-punct-face)))))
1877
1878 (mdw-post-config-mode-hack))
f617db13 1879
6132bc01
MW
1880;;;--------------------------------------------------------------------------
1881;;; Erlang configuration.
2ded9493
MW
1882
1883(setq erlang-electric-commannds
1884 '(erlang-electric-newline erlang-electric-semicolon))
1885
1886(defun mdw-fontify-erlang ()
1887
6132bc01 1888 ;; Set fill prefix.
2ded9493
MW
1889 (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
1890
6132bc01 1891 ;; Fiddle with fontification.
2ded9493
MW
1892 (make-local-variable 'font-lock-keywords)
1893 (let ((erlang-keywords
1894 (mdw-regexps "after" "and" "andalso"
1895 "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
1896 "case" "catch" "cond"
1897 "div" "end" "fun" "if" "let" "not"
1898 "of" "or" "orelse"
1899 "query" "receive" "rem" "try" "when" "xor")))
1900
1901 (setq font-lock-keywords
1902 (list
1903 (list "%.*$"
1904 '(0 font-lock-comment-face))
1905 (list (concat "\\<\\(" erlang-keywords "\\)\\>")
1906 '(0 font-lock-keyword-face))
1907 (list (concat "^-\\sw+\\>")
1908 '(0 font-lock-keyword-face))
1909 (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
1910 '(0 mdw-number-face))
1911 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
1912 '(0 mdw-punct-face)))))
1913
1914 (mdw-post-config-mode-hack))
2ded9493 1915
6132bc01
MW
1916;;;--------------------------------------------------------------------------
1917;;; Texinfo configuration.
f617db13
MW
1918
1919(defun mdw-fontify-texinfo ()
1920
6132bc01 1921 ;; Set fill prefix.
f617db13
MW
1922 (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1923
6132bc01 1924 ;; Real fontification things.
02109a0d 1925 (make-local-variable 'font-lock-keywords)
f617db13
MW
1926 (setq font-lock-keywords
1927 (list
f617db13 1928
6132bc01 1929 ;; Environment names are keywords.
f617db13
MW
1930 (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
1931 '(2 font-lock-keyword-face))
1932
6132bc01 1933 ;; Unmark escaped magic characters.
f617db13
MW
1934 (list "\\(@\\)\\([@{}]\\)"
1935 '(1 font-lock-keyword-face)
1936 '(2 font-lock-variable-name-face))
1937
6132bc01 1938 ;; Make sure we get comments properly.
f617db13
MW
1939 (list "@c\\(\\|omment\\)\\( .*\\)?$"
1940 '(0 font-lock-comment-face))
1941
6132bc01 1942 ;; Command names are keywords.
f617db13
MW
1943 (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1944 '(0 font-lock-keyword-face))
1945
6132bc01 1946 ;; Fontify TeX special characters as punctuation.
f617db13 1947 (list "[{}]+"
ed7b46b9
MW
1948 '(0 mdw-punct-face))))
1949
1950 (mdw-post-config-mode-hack))
f617db13 1951
6132bc01
MW
1952;;;--------------------------------------------------------------------------
1953;;; TeX and LaTeX configuration.
f617db13
MW
1954
1955(defun mdw-fontify-tex ()
1956 (setq ispell-parser 'tex)
55f80fae 1957 (turn-on-reftex)
f617db13 1958
6132bc01 1959 ;; Don't make maths into a string.
f617db13
MW
1960 (modify-syntax-entry ?$ ".")
1961 (modify-syntax-entry ?$ "." font-lock-syntax-table)
1962 (local-set-key [?$] 'self-insert-command)
1963
6132bc01 1964 ;; Set fill prefix.
f617db13
MW
1965 (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1966
6132bc01 1967 ;; Real fontification things.
02109a0d 1968 (make-local-variable 'font-lock-keywords)
f617db13
MW
1969 (setq font-lock-keywords
1970 (list
f617db13 1971
6132bc01 1972 ;; Environment names are keywords.
f617db13
MW
1973 (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1974 "{\\([^}\n]*\\)}")
1975 '(2 font-lock-keyword-face))
1976
6132bc01 1977 ;; Suspended environment names are keywords too.
f617db13
MW
1978 (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1979 "{\\([^}\n]*\\)}")
1980 '(3 font-lock-keyword-face))
1981
6132bc01 1982 ;; Command names are keywords.
f617db13
MW
1983 (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1984 '(0 font-lock-keyword-face))
1985
6132bc01 1986 ;; Handle @/.../ for italics.
f617db13 1987 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
852cd5fb
MW
1988 ;; '(1 font-lock-keyword-face)
1989 ;; '(3 font-lock-keyword-face))
f617db13 1990
6132bc01 1991 ;; Handle @*...* for boldness.
f617db13 1992 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
852cd5fb
MW
1993 ;; '(1 font-lock-keyword-face)
1994 ;; '(3 font-lock-keyword-face))
f617db13 1995
6132bc01 1996 ;; Handle @`...' for literal syntax things.
f617db13 1997 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
852cd5fb
MW
1998 ;; '(1 font-lock-keyword-face)
1999 ;; '(3 font-lock-keyword-face))
f617db13 2000
6132bc01 2001 ;; Handle @<...> for nonterminals.
f617db13 2002 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
852cd5fb
MW
2003 ;; '(1 font-lock-keyword-face)
2004 ;; '(3 font-lock-keyword-face))
f617db13 2005
6132bc01 2006 ;; Handle other @-commands.
f617db13 2007 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
852cd5fb 2008 ;; '(0 font-lock-keyword-face))
f617db13 2009
6132bc01 2010 ;; Make sure we get comments properly.
f617db13
MW
2011 (list "%.*"
2012 '(0 font-lock-comment-face))
2013
6132bc01 2014 ;; Fontify TeX special characters as punctuation.
f617db13 2015 (list "[$^_{}#&]"
ed7b46b9
MW
2016 '(0 mdw-punct-face))))
2017
2018 (mdw-post-config-mode-hack))
f617db13 2019
6132bc01
MW
2020;;;--------------------------------------------------------------------------
2021;;; SGML hacking.
f25cf300
MW
2022
2023(defun mdw-sgml-mode ()
2024 (interactive)
2025 (sgml-mode)
2026 (mdw-standard-fill-prefix "")
2027 (make-variable-buffer-local 'sgml-delimiters)
2028 (setq sgml-delimiters
2029 '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2030 "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2031 "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2032 "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2033 "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2034 "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2035 "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2036 "NULL" ""))
2037 (setq major-mode 'mdw-sgml-mode)
2038 (setq mode-name "[mdw] SGML")
2039 (run-hooks 'mdw-sgml-mode-hook))
2040
6132bc01
MW
2041;;;--------------------------------------------------------------------------
2042;;; Shell scripts.
f617db13
MW
2043
2044(defun mdw-setup-sh-script-mode ()
2045
6132bc01 2046 ;; Fetch the shell interpreter's name.
f617db13
MW
2047 (let ((shell-name sh-shell-file))
2048
6132bc01 2049 ;; Try reading the hash-bang line.
f617db13
MW
2050 (save-excursion
2051 (goto-char (point-min))
2052 (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2053 (setq shell-name (match-string 1))))
2054
6132bc01 2055 ;; Now try to set the shell.
f617db13
MW
2056 ;;
2057 ;; Don't let `sh-set-shell' bugger up my script.
f617db13
MW
2058 (let ((executable-set-magic #'(lambda (s &rest r) s)))
2059 (sh-set-shell shell-name)))
2060
6132bc01 2061 ;; Now enable my keys and the fontification.
f617db13
MW
2062 (mdw-misc-mode-config)
2063
6132bc01 2064 ;; Set the indentation level correctly.
f617db13
MW
2065 (setq sh-indentation 2)
2066 (setq sh-basic-offset 2))
2067
092f0a38
MW
2068;;;--------------------------------------------------------------------------
2069;;; Emacs shell mode.
2070
2071(defun mdw-eshell-prompt ()
2072 (let ((left "[") (right "]"))
2073 (when (= (user-uid) 0)
2074 (setq left "«" right "»"))
2075 (concat left
2076 (save-match-data
2077 (replace-regexp-in-string "\\..*$" "" (system-name)))
2078 " "
2079 (eshell/pwd)
2080 right)))
2081(setq eshell-prompt-function 'mdw-eshell-prompt)
2082(setq eshell-prompt-regexp "^\\[[^]]+\\]")
2083
2084(mdw-define-face eshell-prompt (t :weight bold))
2085(mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2086(mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2087(mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2088(mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2089(mdw-define-face eshell-ls-executable (t :weight bold))
2090(mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2091(mdw-define-face eshell-ls-readonly (t nil))
2092(mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2093
6132bc01
MW
2094;;;--------------------------------------------------------------------------
2095;;; Messages-file mode.
f617db13 2096
4bb22eea 2097(defun messages-mode-guts ()
f617db13
MW
2098 (setq messages-mode-syntax-table (make-syntax-table))
2099 (set-syntax-table messages-mode-syntax-table)
f617db13
MW
2100 (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2101 (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2102 (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2103 (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2104 (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2105 (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2106 (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2107 (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2108 (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2109 (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2110 (make-local-variable 'comment-start)
2111 (make-local-variable 'comment-end)
2112 (make-local-variable 'indent-line-function)
2113 (setq indent-line-function 'indent-relative)
2114 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2115 (make-local-variable 'font-lock-defaults)
4bb22eea 2116 (make-local-variable 'messages-mode-keywords)
f617db13 2117 (let ((keywords
8d6d55b9
MW
2118 (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2119 "export" "enum" "fixed-octetstring" "flags"
2120 "harmless" "map" "nested" "optional"
2121 "optional-tagged" "package" "primitive"
2122 "primitive-nullfree" "relaxed[ \t]+enum"
2123 "set" "table" "tagged-optional" "union"
2124 "variadic" "vector" "version" "version-tag")))
4bb22eea 2125 (setq messages-mode-keywords
f617db13
MW
2126 (list
2127 (list (concat "\\<\\(" keywords "\\)\\>:")
2128 '(0 font-lock-keyword-face))
2129 '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2130 '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2131 (0 font-lock-variable-name-face))
2132 '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2133 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2134 (0 mdw-punct-face)))))
2135 (setq font-lock-defaults
4bb22eea 2136 '(messages-mode-keywords nil nil nil nil))
f617db13
MW
2137 (run-hooks 'messages-file-hook))
2138
2139(defun messages-mode ()
2140 (interactive)
2141 (fundamental-mode)
2142 (setq major-mode 'messages-mode)
2143 (setq mode-name "Messages")
4bb22eea 2144 (messages-mode-guts)
f617db13
MW
2145 (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2146 (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2147 (setq comment-start "# ")
2148 (setq comment-end "")
2149 (turn-on-font-lock-if-enabled)
2150 (run-hooks 'messages-mode-hook))
2151
2152(defun cpp-messages-mode ()
2153 (interactive)
2154 (fundamental-mode)
2155 (setq major-mode 'cpp-messages-mode)
2156 (setq mode-name "CPP Messages")
4bb22eea 2157 (messages-mode-guts)
f617db13
MW
2158 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2159 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2160 (setq comment-start "/* ")
2161 (setq comment-end " */")
2162 (let ((preprocessor-keywords
8d6d55b9
MW
2163 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2164 "ident" "if" "ifdef" "ifndef" "import" "include"
2165 "line" "pragma" "unassert" "undef" "warning")))
4bb22eea 2166 (setq messages-mode-keywords
f617db13
MW
2167 (append (list (list (concat "^[ \t]*\\#[ \t]*"
2168 "\\(include\\|import\\)"
2169 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2170 '(2 font-lock-string-face))
2171 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2172 preprocessor-keywords
852cd5fb 2173 "\\)\\>\\|[0-9]+\\|$\\)\\)")
f617db13 2174 '(1 font-lock-keyword-face)))
4bb22eea 2175 messages-mode-keywords)))
f617db13 2176 (turn-on-font-lock-if-enabled)
297d60aa 2177 (run-hooks 'cpp-messages-mode-hook))
f617db13 2178
297d60aa
MW
2179(add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2180(add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
f617db13
MW
2181; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2182
6132bc01
MW
2183;;;--------------------------------------------------------------------------
2184;;; Messages-file mode.
f617db13
MW
2185
2186(defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2187 "Face to use for subsittution directives.")
2188(make-face 'mallow-driver-substitution-face)
2189(defvar mallow-driver-text-face 'mallow-driver-text-face
2190 "Face to use for body text.")
2191(make-face 'mallow-driver-text-face)
2192
2193(defun mallow-driver-mode ()
2194 (interactive)
2195 (fundamental-mode)
2196 (setq major-mode 'mallow-driver-mode)
2197 (setq mode-name "Mallow driver")
2198 (setq mallow-driver-mode-syntax-table (make-syntax-table))
2199 (set-syntax-table mallow-driver-mode-syntax-table)
2200 (make-local-variable 'comment-start)
2201 (make-local-variable 'comment-end)
2202 (make-local-variable 'indent-line-function)
2203 (setq indent-line-function 'indent-relative)
2204 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2205 (make-local-variable 'font-lock-defaults)
2206 (make-local-variable 'mallow-driver-mode-keywords)
2207 (let ((keywords
8d6d55b9
MW
2208 (mdw-regexps "each" "divert" "file" "if"
2209 "perl" "set" "string" "type" "write")))
f617db13
MW
2210 (setq mallow-driver-mode-keywords
2211 (list
2212 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2213 '(0 font-lock-keyword-face))
2214 (list "^%\\s *\\(#.*\\|\\)$"
2215 '(0 font-lock-comment-face))
2216 (list "^%"
2217 '(0 font-lock-keyword-face))
2218 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2219 (list "\\${[^}]*}"
2220 '(0 mallow-driver-substitution-face t)))))
2221 (setq font-lock-defaults
2222 '(mallow-driver-mode-keywords nil nil nil nil))
2223 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2224 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2225 (setq comment-start "%# ")
2226 (setq comment-end "")
2227 (turn-on-font-lock-if-enabled)
2228 (run-hooks 'mallow-driver-mode-hook))
2229
2230(add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2231
6132bc01
MW
2232;;;--------------------------------------------------------------------------
2233;;; NFast debugs.
f617db13
MW
2234
2235(defun nfast-debug-mode ()
2236 (interactive)
2237 (fundamental-mode)
2238 (setq major-mode 'nfast-debug-mode)
2239 (setq mode-name "NFast debug")
2240 (setq messages-mode-syntax-table (make-syntax-table))
2241 (set-syntax-table messages-mode-syntax-table)
2242 (make-local-variable 'font-lock-defaults)
2243 (make-local-variable 'nfast-debug-mode-keywords)
2244 (setq truncate-lines t)
2245 (setq nfast-debug-mode-keywords
2246 (list
2247 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2248 (0 font-lock-keyword-face))
2249 (list (concat "^[ \t]+\\(\\("
2250 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2251 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2252 "[ \t]+\\)*"
2253 "[0-9a-fA-F]+\\)[ \t]*$")
2254 '(0 mdw-number-face))
2255 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2256 (1 font-lock-keyword-face))
2257 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2258 (1 font-lock-warning-face))
2259 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2260 (1 nil))
2261 (list (concat "^[ \t]+\\.cmd=[ \t]+"
2262 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2263 '(1 font-lock-keyword-face))
2264 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2265 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2266 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2267 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2268 (setq font-lock-defaults
2269 '(nfast-debug-mode-keywords nil nil nil nil))
2270 (turn-on-font-lock-if-enabled)
2271 (run-hooks 'nfast-debug-mode-hook))
2272
6132bc01
MW
2273;;;--------------------------------------------------------------------------
2274;;; Other languages.
f617db13 2275
6132bc01 2276;; Smalltalk.
f617db13
MW
2277
2278(defun mdw-setup-smalltalk ()
2279 (and mdw-auto-indent
2280 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2281 (make-variable-buffer-local 'mdw-auto-indent)
2282 (setq mdw-auto-indent nil)
2283 (local-set-key "\C-i" 'smalltalk-reindent))
2284
2285(defun mdw-fontify-smalltalk ()
02109a0d 2286 (make-local-variable 'font-lock-keywords)
f617db13
MW
2287 (setq font-lock-keywords
2288 (list
f617db13
MW
2289 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2290 '(0 font-lock-keyword-face))
2291 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2292 "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2293 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2294 '(0 mdw-number-face))
2295 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
2296 '(0 mdw-punct-face))))
2297 (mdw-post-config-mode-hack))
f617db13 2298
6132bc01 2299;; Lispy languages.
f617db13 2300
873d87df
MW
2301;; Unpleasant bodge.
2302(unless (boundp 'slime-repl-mode-map)
2303 (setq slime-repl-mode-map (make-sparse-keymap)))
2304
f617db13
MW
2305(defun mdw-indent-newline-and-indent ()
2306 (interactive)
2307 (indent-for-tab-command)
2308 (newline-and-indent))
2309
2310(eval-after-load "cl-indent"
2311 '(progn
2312 (mapc #'(lambda (pair)
2313 (put (car pair)
2314 'common-lisp-indent-function
2315 (cdr pair)))
2316 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2317 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2318
2319(defun mdw-common-lisp-indent ()
2320 (make-variable-buffer-local 'lisp-indent-function)
2321 (setq lisp-indent-function 'common-lisp-indent-function))
2322
037be6de 2323(setq lisp-simple-loop-indentation 2
95575d1f
MW
2324 lisp-loop-keyword-indentation 6
2325 lisp-loop-forms-indentation 6)
2326
f617db13
MW
2327(defun mdw-fontify-lispy ()
2328
6132bc01 2329 ;; Set fill prefix.
f617db13
MW
2330 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2331
6132bc01 2332 ;; Not much fontification needed.
02109a0d 2333 (make-local-variable 'font-lock-keywords)
f617db13
MW
2334 (setq font-lock-keywords
2335 (list
f617db13 2336 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
ed7b46b9
MW
2337 '(0 mdw-punct-face))))
2338
2339 (mdw-post-config-mode-hack))
f617db13
MW
2340
2341(defun comint-send-and-indent ()
2342 (interactive)
2343 (comint-send-input)
2344 (and mdw-auto-indent
2345 (indent-for-tab-command)))
2346
ec007bea
MW
2347(defun mdw-setup-m4 ()
2348 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2349
6132bc01
MW
2350;;;--------------------------------------------------------------------------
2351;;; Text mode.
f617db13
MW
2352
2353(defun mdw-text-mode ()
2354 (setq fill-column 72)
2355 (flyspell-mode t)
2356 (mdw-standard-fill-prefix
c7a8da49 2357 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
f617db13
MW
2358 (auto-fill-mode 1))
2359
6132bc01 2360;;;--------------------------------------------------------------------------
faf2cef7 2361;;; Outline and hide/show modes.
5de5db48
MW
2362
2363(defun mdw-outline-collapse-all ()
2364 "Completely collapse everything in the entire buffer."
2365 (interactive)
2366 (save-excursion
2367 (goto-char (point-min))
2368 (while (< (point) (point-max))
2369 (hide-subtree)
2370 (forward-line))))
2371
faf2cef7
MW
2372(setq hs-hide-comments-when-hiding-all nil)
2373
b200af26 2374(defadvice hs-hide-all (after hide-first-comment activate)
941c29ba 2375 (save-excursion (hs-hide-initial-comment-block)))
b200af26 2376
6132bc01
MW
2377;;;--------------------------------------------------------------------------
2378;;; Shell mode.
f617db13
MW
2379
2380(defun mdw-sh-mode-setup ()
2381 (local-set-key [?\C-a] 'comint-bol)
2382 (add-hook 'comint-output-filter-functions
2383 'comint-watch-for-password-prompt))
2384
2385(defun mdw-term-mode-setup ()
3d9147ea 2386 (setq term-prompt-regexp shell-prompt-pattern)
f617db13
MW
2387 (make-local-variable 'mouse-yank-at-point)
2388 (make-local-variable 'transient-mark-mode)
2389 (setq mouse-yank-at-point t)
f617db13
MW
2390 (auto-fill-mode -1)
2391 (setq tab-width 8))
2392
3d9147ea
MW
2393(defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2394(defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
2395(defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2396(defun term-send-meta-meta-something ()
2397 (interactive)
2398 (term-send-raw-string "\e\e")
2399 (term-send-raw))
2400(eval-after-load 'term
2401 '(progn
2402 (define-key term-raw-map [?\e ?\e] nil)
2403 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2404 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2405 (define-key term-raw-map [M-right] 'term-send-meta-right)
2406 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2407 (define-key term-raw-map [M-left] 'term-send-meta-left)
2408 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2409
e07e3320
MW
2410;;;--------------------------------------------------------------------------
2411;;; Inferior Emacs Lisp.
2412
2413(setq comint-prompt-read-only t)
2414
2415(eval-after-load "comint"
2416 '(progn
2417 (define-key comint-mode-map "\C-w" 'comint-kill-region)
2418 (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
2419
2420(eval-after-load "ielm"
2421 '(progn
2422 (define-key ielm-map "\C-w" 'comint-kill-region)
2423 (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
2424
f617db13
MW
2425;;;----- That's all, folks --------------------------------------------------
2426
2427(provide 'dot-emacs)