(debug 0))
`',(make-regexp list))
+(defun mdw-wrong ()
+ "This is not the key sequence you're looking for."
+ (interactive)
+ (error "wrong button"))
+
+(defun mdw-emacs-version-p (major &optional minor)
+ "Return non-nil if the running Emacs is at least version MAJOR.MINOR."
+ (or (> emacs-major-version major)
+ (and (= emacs-major-version major)
+ (>= emacs-minor-version (or minor 0)))))
+
;; Some error trapping.
;;
;; If individual bits of this file go tits-up, we don't particularly want
(concat "(" (buffer-string) ")")))))))
(cdr (assq sym mdw-config)))
+;; Width configuration.
+
+(defvar mdw-column-width
+ (string-to-number (or (mdw-config 'emacs-width) "77"))
+ "Width of Emacs columns.")
+(defvar mdw-text-width mdw-column-width
+ "Expected width of text within columns.")
+(put 'mdw-text-width 'safe-local-variable 'integerp)
+
+;; Local variables hacking.
+
+(defun run-local-vars-mode-hook ()
+ "Run a hook for the major-mode after local variables have been processed."
+ (run-hooks (intern (concat (symbol-name major-mode)
+ "-local-variables-hook"))))
+(add-hook 'hack-local-variables-hook 'run-local-vars-mode-hook)
+
;; Set up the load path convincingly.
(dolist (dir (append (and (boundp 'debian-emacs-flavor)
((>= width 0) (+ width (mdw-horizontal-window-overhead)))
((< width 0) width))))
+(defun mdw-preferred-column-width ()
+ "Return the preferred column width."
+ (if (and window-system (mdw-emacs-version-p 22)) mdw-column-width
+ (1+ mdw-column-width)))
+
(defun mdw-divvy-window (&optional width)
"Split a wide window into appropriate widths."
(interactive "P")
- (setq width (cond (width (prefix-numeric-value width))
- ((and window-system
- (>= emacs-major-version 22))
- 77)
- (t 78)))
+ (setq width (if width (prefix-numeric-value width)
+ (mdw-preferred-column-width)))
(let* ((win (selected-window))
(sb-width (mdw-horizontal-window-overhead))
(c (/ (+ (window-width) sb-width)
(other-window 1))
(select-window win)))
+(defun mdw-set-frame-width (columns &optional width)
+ (interactive "nColumns:
+P")
+ (setq width (if width (prefix-numeric-value width)
+ (mdw-preferred-column-width)))
+ (let ((sb-width (mdw-horizontal-window-overhead)))
+ (set-frame-width (selected-frame)
+ (- (* columns (+ width sb-width))
+ sb-width))
+ (mdw-divvy-window width)))
+
+;; Don't raise windows unless I say so.
+
+(defvar mdw-inhibit-raise-frame nil
+ "*Whether `raise-frame' should do nothing when the frame is mapped.")
+
+(defadvice raise-frame
+ (around mdw-inhibit (&optional frame) activate compile)
+ "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the
+frame is actually mapped on the screen."
+ (if mdw-inhibit-raise-frame
+ (make-frame-visible frame)
+ ad-do-it))
+
+(defmacro mdw-advise-to-inhibit-raise-frame (function)
+ "Advise the FUNCTION not to raise frames, even if it wants to."
+ `(defadvice ,function
+ (around mdw-inhibit-raise (&rest hunoz) activate compile)
+ "Don't raise the window unless you have to."
+ (let ((mdw-inhibit-raise-frame t))
+ ad-do-it)))
+
+(mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus)
+(mdw-advise-to-inhibit-raise-frame appt-disp-window)
+
+;; Bug fix for markdown-mode, which breaks point positioning during
+;; `query-replace'.
+(defadvice markdown-check-change-for-wiki-link
+ (around mdw-save-match activate compile)
+ "Save match data around the `markdown-mode' `after-change-functions' hook."
+ (save-match-data ad-do-it))
+
+;; Bug fix for `bbdb-canonicalize-address': on Emacs 24, `run-hook-with-args'
+;; always returns nil, with the result that all email addresses are lost.
+;; Replace the function entirely.
+(defadvice bbdb-canonicalize-address
+ (around mdw-bug-fix activate compile)
+ "Don't use `run-hook-with-args', because that doesn't work."
+ (let ((net (ad-get-arg 0)))
+
+ ;; Make sure this is a proper hook list.
+ (if (functionp bbdb-canonicalize-net-hook)
+ (setq bbdb-canonicalize-net-hook (list bbdb-canonicalize-net-hook)))
+
+ ;; Iterate over the hooks until things converge.
+ (let ((donep nil))
+ (while (not donep)
+ (let (next (changep nil)
+ hook (hooks bbdb-canonicalize-net-hook))
+ (while hooks
+ (setq hook (pop hooks))
+ (setq next (funcall hook net))
+ (if (not (equal next net))
+ (setq changep t
+ net next)))
+ (setq donep (not changep)))))
+ (setq ad-return-value net)))
+
;; Transient mark mode hacks.
(defadvice exchange-point-and-mark
;; Functions for sexp diary entries.
+(defun mdw-not-org-mode (form)
+ "As FORM, but not in Org mode agenda."
+ (and (not mdw-diary-for-org-mode-p)
+ (eval form)))
+
(defun mdw-weekday (l)
"Return non-nil if `date' falls on one of the days of the week in L.
L is a list of day numbers (from 0 to 6 for Sunday through to
(memq (nth d '(sunday monday tuesday wednesday
thursday friday saturday)) l))))
+(defun mdw-discordian-date (date)
+ "Return the Discordian calendar date corresponding to DATE.
+
+The return value is (YOLD . st-tibs-day) or (YOLD SEASON DAYNUM DOW).
+
+The original is by David Pearson. I modified it to produce date components
+as output rather than a string."
+ (let* ((days ["Sweetmorn" "Boomtime" "Pungenday"
+ "Prickle-Prickle" "Setting Orange"])
+ (months ["Chaos" "Discord" "Confusion"
+ "Bureaucracy" "Aftermath"])
+ (day-count [0 31 59 90 120 151 181 212 243 273 304 334])
+ (year (- (extract-calendar-year date) 1900))
+ (month (1- (extract-calendar-month date)))
+ (day (1- (extract-calendar-day date)))
+ (julian (+ (aref day-count month) day))
+ (dyear (+ year 3066)))
+ (if (and (= month 1) (= day 28))
+ (cons dyear 'st-tibs-day)
+ (list dyear
+ (aref months (floor (/ julian 73)))
+ (1+ (mod julian 73))
+ (aref days (mod julian 5))))))
+
+(defun mdw-diary-discordian-date ()
+ "Convert the date in `date' to a string giving the Discordian date."
+ (let* ((ddate (mdw-discordian-date date))
+ (tail (format "in the YOLD %d" (car ddate))))
+ (if (eq (cdr ddate) 'st-tibs-day)
+ (format "St Tib's Day %s" tail)
+ (let ((season (cadr ddate))
+ (daynum (caddr ddate))
+ (dayname (cadddr ddate)))
+ (format "%s, the %d%s day of %s %s"
+ dayname
+ daynum
+ (let ((ldig (mod daynum 10)))
+ (cond ((= ldig 1) "st")
+ ((= ldig 2) "nd")
+ ((= ldig 3) "rd")
+ (t "th")))
+ season
+ tail)))))
+
(defun mdw-todo (&optional when)
"Return non-nil today, or on WHEN, whichever is later."
(let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
(nth 2 when))))))))
(eq w d)))
+(defvar mdw-diary-for-org-mode-p nil)
+
+(defadvice org-agenda-list (around mdw-preserve-links activate)
+ (let ((mdw-diary-for-org-mode-p t))
+ ad-do-it))
+
+(defadvice diary-add-to-list (before mdw-trim-leading-space compile activate)
+ "Trim leading space from the diary entry string."
+ (save-match-data
+ (let ((str (ad-get-arg 1))
+ (done nil) old)
+ (while (not done)
+ (setq old str)
+ (setq str (cond ((null str) nil)
+ ((string-match "\\(^\\|\n\\)[ \t]+" str)
+ (replace-match "\\1" nil nil str))
+ ((and mdw-diary-for-org-mode-p
+ (string-match (concat
+ "\\(^\\|\n\\)"
+ "\\(" diary-time-regexp
+ "\\(-" diary-time-regexp "\\)?"
+ "\\)"
+ "\\(\t[ \t]*\\| [ \t]+\\)")
+ str))
+ (replace-match "\\1\\2 " nil nil str))
+ ((and (not mdw-diary-for-org-mode-p)
+ (string-match "\\[\\[[^][]*]\\[\\([^][]*\\)]]"
+ str))
+ (replace-match "\\1" nil nil str))
+ (t str)))
+ (if (equal str old) (setq done t)))
+ (ad-set-arg 1 str))))
+
+(defadvice org-bbdb-anniversaries (after mdw-fixup-list compile activate)
+ "Return a string rather than a list."
+ (with-temp-buffer
+ (let ((anyp nil))
+ (dolist (e (let ((ee ad-return-value))
+ (if (atom ee) (list ee) ee)))
+ (when e
+ (when anyp (insert ?\n))
+ (insert e)
+ (setq anyp t)))
+ (setq ad-return-value
+ (and anyp (buffer-string))))))
+
;; Fighting with Org-mode's evil key maps.
(defvar mdw-evil-keymap-keys
(dolist (key replacements)
(define-key keymap key binding))))))
-(eval-after-load "org-latex"
- '(progn
- (push '("strayman"
- "\\documentclass{strayman}
+(defvar mdw-org-latex-defs
+ '(("strayman"
+ "\\documentclass{strayman}
\\usepackage[utf8]{inputenc}
\\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
-\\usepackage[T1]{fontenc}
\\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
- ("\\section{%s}" . "\\section*{%s}")
- ("\\subsection{%s}" . "\\subsection*{%s}")
- ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
- ("\\paragraph{%s}" . "\\paragraph*{%s}")
- ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
- org-export-latex-classes)))
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
+ ("\\paragraph{%s}" . "\\paragraph*{%s}")
+ ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))))
+
+(eval-after-load "org-latex"
+ '(setq org-export-latex-classes
+ (append mdw-org-latex-defs org-export-latex-classes)))
+
+(eval-after-load "ox-latex"
+ '(setq org-latex-classes (append mdw-org-latex-defs org-latex-classes)
+ org-latex-default-packages-alist '(("AUTO" "inputenc" t)
+ ("T1" "fontenc" t)
+ ("" "fixltx2e" nil)
+ ("" "graphicx" t)
+ ("" "longtable" nil)
+ ("" "float" nil)
+ ("" "wrapfig" nil)
+ ("" "rotating" nil)
+ ("normalem" "ulem" t)
+ ("" "textcomp" t)
+ ("" "marvosym" t)
+ ("" "wasysym" t)
+ ("" "amssymb" t)
+ ("" "hyperref" nil)
+ "\\tolerance=1000")))
+
(setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i"
org-export-docbook-xsl-fo-proc-command "fop %i.safe %o"
org-export-docbook-xslt-stylesheet
"/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl")
+;; Glasses.
+
+(setq glasses-separator "-"
+ glasses-separate-parentheses-p nil
+ glasses-uncapitalize-p t)
+
+;; Some hacks to do with window placement.
+
+(defun mdw-clobber-other-windows-showing-buffer (buffer-or-name)
+ "Arrange that no windows on other frames are showing BUFFER-OR-NAME."
+ (interactive "bBuffer: ")
+ (let ((home-frame (selected-frame))
+ (buffer (get-buffer buffer-or-name))
+ (safe-buffer (get-buffer "*scratch*")))
+ (mapc (lambda (frame)
+ (or (eq frame home-frame)
+ (mapc (lambda (window)
+ (and (eq (window-buffer window) buffer)
+ (set-window-buffer window safe-buffer)))
+ (window-list frame))))
+ (frame-list))))
+
+(defvar mdw-inhibit-walk-windows nil
+ "If non-nil, then `walk-windows' does nothing.
+This is used by advice on `switch-to-buffer-other-frame' to inhibit finding
+buffers in random frames.")
+
+(defadvice walk-windows (around mdw-inhibit activate)
+ "If `mdw-inhibit-walk-windows' is non-nil, then do nothing."
+ (and (not mdw-inhibit-walk-windows)
+ ad-do-it))
+
+(defadvice switch-to-buffer-other-frame
+ (around mdw-always-new-frame activate)
+ "Always make a new frame.
+Even if an existing window in some random frame looks tempting."
+ (let ((mdw-inhibit-walk-windows t)) ad-do-it))
+
+(defadvice display-buffer (before mdw-inhibit-other-frames activate)
+ "Don't try to do anything fancy with other frames.
+Pretend they don't exist. They might be on other display devices."
+ (ad-set-arg 2 nil))
+
+;;;--------------------------------------------------------------------------
+;;; Improved compilation machinery.
+
+;; Uprated version of M-x compile.
+
+(setq compile-command
+ (let ((ncpu (with-temp-buffer
+ (insert-file-contents "/proc/cpuinfo")
+ (buffer-string)
+ (count-matches "^processor\\s-*:"))))
+ (format "make -j%d -k" (* 2 ncpu))))
+
+(defun mdw-compilation-buffer-name (mode)
+ (concat "*" (downcase mode) ": "
+ (abbreviate-file-name default-directory) "*"))
+(setq compilation-buffer-name-function 'mdw-compilation-buffer-name)
+
+(eval-after-load "compile"
+ '(progn
+ (define-key compilation-shell-minor-mode-map "\C-c\M-g" 'recompile)))
+
+(defadvice compile (around hack-environment compile activate)
+ "Hack the environment inherited by inferiors in the compilation."
+ (let ((process-environment process-environment))
+ (setenv "LD_PRELOAD" nil)
+ ad-do-it))
+
+(defun mdw-compile (command &optional directory comint)
+ "Initiate a compilation COMMAND, maybe in a different DIRECTORY.
+The DIRECTORY may be nil to not change. If COMINT is t, then
+start an interactive compilation.
+
+Interactively, prompt for the command if the variable
+`compilation-read-command' is non-nil, or if requested through
+the prefix argument. Prompt for the directory, and run
+interactively, if requested through the prefix.
+
+Use a prefix of 4, 6, 12, or 14, or type C-u between one and three times, to
+force prompting for a directory.
+
+Use a prefix of 2, 6, 10, or 14, or type C-u three times, to force
+prompting for the command.
+
+Use a prefix of 8, 10, 12, or 14, or type C-u twice or three times,
+to force interactive compilation."
+ (interactive
+ (let* ((prefix (prefix-numeric-value current-prefix-arg))
+ (command (eval compile-command))
+ (dir (and (plusp (logand prefix #x54))
+ (read-directory-name "Compile in directory: "))))
+ (list (if (or compilation-read-command
+ (plusp (logand prefix #x42)))
+ (compilation-read-command command)
+ command)
+ dir
+ (plusp (logand prefix #x58)))))
+ (let ((default-directory (or directory default-directory)))
+ (compile command comint)))
+
+;; Flymake support.
+
+(defun mdw-find-build-dir (build-file)
+ (catch 'found
+ (let* ((src-dir (file-name-as-directory (expand-file-name ".")))
+ (dir src-dir))
+ (loop
+ (when (file-exists-p (concat dir build-file))
+ (throw 'found dir))
+ (let ((sub (expand-file-name (file-relative-name src-dir dir)
+ (concat dir "build/"))))
+ (catch 'give-up
+ (loop
+ (when (file-exists-p (concat sub build-file))
+ (throw 'found sub))
+ (when (string= sub dir) (throw 'give-up nil))
+ (setq sub (file-name-directory (directory-file-name sub))))))
+ (when (string= dir
+ (setq dir (file-name-directory
+ (directory-file-name dir))))
+ (throw 'found nil))))))
+
+(defun mdw-flymake-make-init ()
+ (let ((build-dir (mdw-find-build-dir "Makefile")))
+ (and build-dir
+ (let ((tmp-src (flymake-init-create-temp-buffer-copy
+ #'flymake-create-temp-inplace)))
+ (flymake-get-syntax-check-program-args
+ tmp-src build-dir t t
+ #'flymake-get-make-cmdline)))))
+
+(setq flymake-allowed-file-name-masks
+ '(("\\.\\(?:[cC]\\|cc\\|cpp\\|cxx\\|c\\+\\+\\)\\'"
+ mdw-flymake-make-init)
+ ("\\.\\(?:[hH]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'"
+ mdw-flymake-master-make-init)
+ ("\\.p[lm]" flymake-perl-init)))
+
+(setq flymake-mode-map
+ (let ((map (if (boundp 'flymake-mode-map)
+ flymake-mode-map
+ (make-sparse-keymap))))
+ (define-key map [?\C-c ?\C-f ?\C-p] 'flymake-goto-prev-error)
+ (define-key map [?\C-c ?\C-f ?\C-n] 'flymake-goto-next-error)
+ (define-key map [?\C-c ?\C-f ?\C-c] 'flymake-compile)
+ (define-key map [?\C-c ?\C-f ?\C-k] 'flymake-stop-all-syntax-checks)
+ (define-key map [?\C-c ?\C-f ?\C-e] 'flymake-popup-current-error-menu)
+ map))
+
;;;--------------------------------------------------------------------------
;;; Mail and news hacking.
(setenv "REAL_MOVEMAIL" try))
(setq path (cdr path)))))
+;; AUTHINFO GENERIC kludge.
+
+(defvar nntp-authinfo-generic nil
+ "Set to the `NNTPAUTH' string to pass on to `authinfo-kludge'.
+
+Use this to arrange for per-server settings.")
+
+(defun nntp-open-authinfo-kludge (buffer)
+ "Open a connection to SERVER using `authinfo-kludge'."
+ (let ((proc (start-process "nntpd" buffer
+ "env" (concat "NNTPAUTH="
+ (or nntp-authinfo-generic
+ (getenv "NNTPAUTH")
+ (error "NNTPAUTH unset")))
+ "authinfo-kludge" nntp-address)))
+ (set-buffer buffer)
+ (nntp-wait-for-string "^\r*200")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc))
+
(eval-after-load "erc"
- '(load "~/.ercrc.el"))
+ '(load "~/.ercrc.el"))
+
+;; Heavy-duty Gnus patching.
+
+(defun mdw-nnimap-transform-headers ()
+ (goto-char (point-min))
+ (let (article lines size string)
+ (block nil
+ (while (not (eobp))
+ (while (not (looking-at "\\* [0-9]+ FETCH"))
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (when (eobp)
+ (return)))
+ (goto-char (match-end 0))
+ ;; Unfold quoted {number} strings.
+ (while (re-search-forward
+ "[^]][ (]{\\([0-9]+\\)}\r?\n"
+ (save-excursion
+ ;; Start of the header section.
+ (or (re-search-forward "] {[0-9]+}\r?\n" nil t)
+ ;; Start of the next FETCH.
+ (re-search-forward "\\* [0-9]+ FETCH" nil t)
+ (point-max)))
+ t)
+ (setq size (string-to-number (match-string 1)))
+ (delete-region (+ (match-beginning 0) 2) (point))
+ (setq string (buffer-substring (point) (+ (point) size)))
+ (delete-region (point) (+ (point) size))
+ (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string)))
+ ;; [mdw] missing from upstream
+ (backward-char 1))
+ (beginning-of-line)
+ (setq article
+ (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position)
+ t)
+ (match-string 1)))
+ (setq lines nil)
+ (setq size
+ (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
+ (line-end-position)
+ t)
+ (match-string 1)))
+ (beginning-of-line)
+ (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
+ (let ((structure (ignore-errors
+ (read (current-buffer)))))
+ (while (and (consp structure)
+ (not (atom (car structure))))
+ (setq structure (car structure)))
+ (setq lines (if (and
+ (stringp (car structure))
+ (equal (upcase (nth 0 structure)) "MESSAGE")
+ (equal (upcase (nth 1 structure)) "RFC822"))
+ (nth 9 structure)
+ (nth 7 structure)))))
+ (delete-region (line-beginning-position) (line-end-position))
+ (insert (format "211 %s Article retrieved." article))
+ (forward-line 1)
+ (when size
+ (insert (format "Chars: %s\n" size)))
+ (when lines
+ (insert (format "Lines: %s\n" lines)))
+ ;; Most servers have a blank line after the headers, but
+ ;; Davmail doesn't.
+ (unless (re-search-forward "^\r$\\|^)\r?$" nil t)
+ (goto-char (point-max)))
+ (delete-region (line-beginning-position) (line-end-position))
+ (insert ".")
+ (forward-line 1)))))
+
+(eval-after-load 'nnimap
+ '(defalias 'nnimap-transform-headers
+ (symbol-function 'mdw-nnimap-transform-headers)))
;;;--------------------------------------------------------------------------
;;; Utility functions.
(cond ((null la) (throw 'done lb))
((null lb) (throw 'done nil))
((< (car la) (car lb)) (throw 'done t))
- ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb))))))))
+ ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb)))
+ (t (throw 'done nil)))))))
(defun mdw-check-autorevert ()
"Sets global-auto-revert-ignore-buffer appropriately for this buffer.
(defadvice write-file (after mdw-autorevert activate)
(mdw-check-autorevert))
+(defun mdw-auto-revert ()
+ "Recheck all of the autorevertable buffers, and update VC modelines."
+ (interactive)
+ (let ((auto-revert-check-vc-info t))
+ (auto-revert-buffers)))
+
;;;--------------------------------------------------------------------------
;;; Dired hacking.
(ad-set-arg 0 dir)
ad-do-it)))
+(defun mdw-dired-run (args &optional syncp)
+ (interactive (let ((file (dired-get-filename t)))
+ (list (read-string (format "Arguments for %s: " file))
+ current-prefix-arg)))
+ (funcall (if syncp 'shell-command 'async-shell-command)
+ (concat (shell-quote-argument (dired-get-filename nil))
+ " " args)))
+
+(defadvice dired-do-flagged-delete
+ (around mdw-delete-if-prefix-argument activate compile)
+ (let ((delete-by-moving-to-trash (and (null current-prefix-arg)
+ delete-by-moving-to-trash)))
+ ad-do-it))
+
+(eval-after-load "dired"
+ '(define-key dired-mode-map "X" 'mdw-dired-run))
+
;;;--------------------------------------------------------------------------
;;; URL viewing.
(w3m-browse-url url new-session-p))
(select-window window)))))
+(eval-after-load 'w3m
+ '(define-key w3m-mode-map [?\e ?\r] 'w3m-view-this-url-new-session))
+
(defvar mdw-good-url-browsers
- '(browse-url-generic
+ '(browse-url-chromium
+ browse-url-mozilla
+ browse-url-generic
(w3m . mdw-w3m-browse-url)
- browse-url-w3
- browse-url-mozilla)
+ browse-url-w3)
"List of good browsers for mdw-good-url-browsers.
Each item is a browser function name, or a cons (CHECK . FUNC).
A symbol FOO stands for (FOO . FOO).")
"*Standard regexp matching parts of a hanging indent.
This is mainly useful in `auto-fill-mode'.")
-;; Setting things up.
-
-(fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
-
;; Utility functions.
-(defun mdw-tabify (s)
- "Tabify the string S. This is a horrid hack."
- (save-excursion
- (save-match-data
- (let (start end)
- (beginning-of-line)
- (setq start (point-marker))
+(defun mdw-maybe-tabify (s)
+ "Tabify or untabify the string S, according to `indent-tabs-mode'."
+ (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
+ (with-temp-buffer
+ (save-match-data
(insert s "\n")
- (setq end (point-marker))
- (tabify start end)
- (setq s (buffer-substring start (1- end)))
- (delete-region start end)
- (set-marker start nil)
- (set-marker end nil)
- s))))
+ (let ((start (point-min)) (end (point-max)))
+ (funcall tabfun (point-min) (point-max))
+ (setq s (buffer-substring (point-min) (1- (point-max)))))))))
(defun mdw-examine-fill-prefixes (l)
"Given a list of dynamic fill prefixes, pick one which matches
context and return the static fill prefix to use. Point must be
at the start of a line, and match data must be saved."
(cond ((not l) nil)
- ((looking-at (car (car l)))
- (mdw-tabify (apply (function concat)
- (mapcar (function mdw-do-prefix-match)
- (cdr (car l))))))
- (t (mdw-examine-fill-prefixes (cdr l)))))
+ ((looking-at (car (car l)))
+ (mdw-maybe-tabify (apply #'concat
+ (mapcar #'mdw-do-prefix-match
+ (cdr (car l))))))
+ (t (mdw-examine-fill-prefixes (cdr l)))))
(defun mdw-maybe-car (p)
"If P is a pair, return (car P), otherwise just return P."
"Expand a dynamic prefix match element.
See `mdw-fill-prefix' for details."
(cond ((not (consp m)) (format "%s" m))
- ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
- ((eq (car m) 'pad) (mdw-padding (match-string
- (mdw-maybe-car (cdr m)))))
- ((eq (car m) 'eval) (eval (cdr m)))
- (t "")))
+ ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
+ ((eq (car m) 'pad) (mdw-padding (match-string
+ (mdw-maybe-car (cdr m)))))
+ ((eq (car m) 'eval) (eval (cdr m)))
+ (t "")))
(defun mdw-choose-dynamic-fill-prefix ()
"Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
(cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
- ((not mdw-fill-prefix) fill-prefix)
- (t (save-excursion
- (beginning-of-line)
- (save-match-data
- (mdw-examine-fill-prefixes mdw-fill-prefix))))))
+ ((not mdw-fill-prefix) fill-prefix)
+ (t (save-excursion
+ (beginning-of-line)
+ (save-match-data
+ (mdw-examine-fill-prefixes mdw-fill-prefix))))))
-(defun do-auto-fill ()
+(defadvice do-auto-fill (around mdw-dynamic-fill-prefix () activate compile)
"Handle auto-filling, working out a dynamic fill prefix in the
case where there isn't a sensible static one."
(let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
- (mdw-do-auto-fill)))
+ ad-do-it))
(defun mdw-fill-paragraph ()
"Fill paragraph, getting a dynamic fill prefix."
design it doesn't cope with anything approximating a complicated
case."
(setq mdw-fill-prefix
- `((,(concat rx mdw-hanging-indents)
- (match . 1)
- (pad . ,(or mat 2))))))
+ `((,(concat rx mdw-hanging-indents)
+ (match . 1)
+ (pad . ,(or mat 2))))))
;;;--------------------------------------------------------------------------
;;; Other common declarations.
(whitespace-mode arg))
(setq show-trailing-whitespace whitespace-mode)))
+(defvar mdw-do-misc-mode-hacking nil)
+
(defun mdw-misc-mode-config ()
(and mdw-auto-indent
(cond ((eq major-mode 'lisp-mode)
(local-set-key "\C-m" 'mdw-indent-newline-and-indent))
- ((or (eq major-mode 'slime-repl-mode)
- (eq major-mode 'asm-mode))
+ ((derived-mode-p 'slime-repl-mode 'asm-mode 'comint-mode)
nil)
(t
(local-set-key "\C-m" 'newline-and-indent))))
+ (set (make-local-variable 'mdw-do-misc-mode-hacking) t)
(local-set-key [C-return] 'newline)
(make-local-variable 'page-delimiter)
(setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
(setq comment-column 40)
(auto-fill-mode 1)
- (setq fill-column 77)
- (setq show-trailing-whitespace t)
- (mdw-whitespace-mode 1)
+ (setq fill-column mdw-text-width)
(and (fboundp 'gtags-mode)
(gtags-mode))
(if (fboundp 'hs-minor-mode)
- (hs-minor-mode t)
+ (trap (hs-minor-mode t))
(outline-minor-mode t))
(reveal-mode t)
(trap (turn-on-font-lock)))
-(defun mdw-post-config-mode-hack ()
- (mdw-whitespace-mode 1))
+(defun mdw-post-local-vars-misc-mode-config ()
+ (setq whitespace-line-column mdw-text-width)
+ (when (and mdw-do-misc-mode-hacking
+ (not buffer-read-only))
+ (setq show-trailing-whitespace t)
+ (mdw-whitespace-mode 1)))
+(add-hook 'hack-local-variables-hook 'mdw-post-local-vars-misc-mode-config)
+
+(defmacro mdw-advise-update-angry-fruit-salad (&rest funcs)
+ `(progn ,@(mapcar (lambda (func)
+ `(defadvice ,func
+ (after mdw-angry-fruit-salad activate)
+ (when mdw-do-misc-mode-hacking
+ (setq show-trailing-whitespace
+ (not buffer-read-only))
+ (mdw-whitespace-mode (if buffer-read-only 0 1)))))
+ funcs)))
+(mdw-advise-update-angry-fruit-salad toggle-read-only
+ read-only-mode
+ view-mode
+ view-mode-enable
+ view-mode-disable)
(eval-after-load 'gtags
'(progn
(run-with-idle-timer 0 nil #'x-close-connection frame-display))))
(add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
+;;;--------------------------------------------------------------------------
+;;; Fullscreen-ness.
+
+(defvar mdw-full-screen-parameters
+ '((menu-bar-lines . 0)
+ ;(vertical-scroll-bars . nil)
+ )
+ "Frame parameters to set when making a frame fullscreen.")
+
+(defvar mdw-full-screen-save
+ '(width height)
+ "Extra frame parameters to save when setting fullscreen.")
+
+(defun mdw-toggle-full-screen (&optional frame)
+ "Show the FRAME fullscreen."
+ (interactive)
+ (when window-system
+ (cond ((frame-parameter frame 'fullscreen)
+ (set-frame-parameter frame 'fullscreen nil)
+ (modify-frame-parameters
+ nil
+ (or (frame-parameter frame 'mdw-full-screen-saved)
+ (mapcar (lambda (assoc)
+ (assq (car assoc) default-frame-alist))
+ mdw-full-screen-parameters))))
+ (t
+ (let ((saved (mapcar (lambda (param)
+ (cons param (frame-parameter frame param)))
+ (append (mapcar #'car
+ mdw-full-screen-parameters)
+ mdw-full-screen-save))))
+ (set-frame-parameter frame 'mdw-full-screen-saved saved))
+ (modify-frame-parameters frame mdw-full-screen-parameters)
+ (set-frame-parameter frame 'fullscreen 'fullboth)))))
+
;;;--------------------------------------------------------------------------
;;; General fontification.
+(make-face 'mdw-virgin-face)
+
(defmacro mdw-define-face (name &rest body)
"Define a face, and make sure it's actually set as the definition."
(declare (indent 1)
(debug 0))
`(progn
- (make-face ',name)
+ (copy-face 'mdw-virgin-face ',name)
(defvar ,name ',name)
(put ',name 'face-defface-spec ',body)
(face-spec-set ',name ',body nil)))
(((type w32)) :family "courier new" :height 85)
(((type x)) :family "6x13" :foundry "trad" :height 130)
(t :foreground "white" :background "black"))
-(if (>= emacs-major-version 23)
+(if (mdw-emacs-version-p 23)
(mdw-define-face variable-pitch
(((type x)) :family "sans" :height 100))
(mdw-define-face variable-pitch
(((type x)) :family "helvetica" :height 90)))
(mdw-define-face region
- (((type tty) (class color)) :background "blue")
- (((type tty) (class mono)) :inverse-video t)
- (t :background "grey30"))
+ (((min-colors 64)) :background "grey30")
+ (((class color)) :background "blue")
+ (t :inverse-video t))
+(mdw-define-face match
+ (((class color)) :background "blue")
+ (t :inverse-video t))
+(mdw-define-face mc/cursor-face
+ (((class color)) :background "red")
+ (t :inverse-video t))
(mdw-define-face minibuffer-prompt
(t :weight bold))
(mdw-define-face mode-line
(((class color)) :foreground "yellow" :background "blue"
:box (:line-width 1 :style released-button))
(t :inverse-video t))
+(mdw-define-face nobreak-space
+ (((type tty)))
+ (t :inherit escape-glyph :underline t))
(mdw-define-face scroll-bar
(t :foreground "black" :background "lightgrey"))
(mdw-define-face fringe
(t :foreground "yellow"))
(mdw-define-face show-paren-match
- (((class color)) :background "darkgreen")
+ (((min-colors 64)) :background "darkgreen")
+ (((class color)) :background "green")
(t :underline t))
(mdw-define-face show-paren-mismatch
(((class color)) :background "red")
(t :inverse-video t))
(mdw-define-face highlight
- (((type x) (class color)) :background "DarkSeaGreen4")
- (((type tty) (class color)) :background "cyan")
+ (((min-colors 64)) :background "DarkSeaGreen4")
+ (((class color)) :background "cyan")
(t :inverse-video t))
(mdw-define-face holiday-face
(mdw-define-face comint-highlight-input
(t nil))
+(mdw-define-face ido-subdir
+ (t :foreground "cyan" :weight bold))
+
(mdw-define-face dired-directory
(t :foreground "cyan" :weight bold))
(mdw-define-face dired-symlink
(mdw-define-face trailing-whitespace
(((class color)) :background "red")
(t :inverse-video t))
+(mdw-define-face whitespace-line
+ (((class color)) :background "darkred")
+ (t :inverse-video t))
(mdw-define-face mdw-punct-face
- (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
+ (((min-colors 64)) :foreground "burlywood2")
+ (((class color)) :foreground "yellow"))
(mdw-define-face mdw-number-face
(t :foreground "yellow"))
+(mdw-define-face mdw-trivial-face)
(mdw-define-face font-lock-function-name-face
(t :slant italic))
(mdw-define-face font-lock-keyword-face
(mdw-define-face font-lock-variable-name-face
(t :slant italic))
(mdw-define-face font-lock-comment-delimiter-face
- (((class mono)) :weight bold)
- (((type tty) (class color)) :foreground "green")
- (t :slant italic :foreground "SeaGreen1"))
+ (((min-colors 64)) :slant italic :foreground "SeaGreen1")
+ (((class color)) :foreground "green")
+ (t :weight bold))
(mdw-define-face font-lock-comment-face
- (((class mono)) :weight bold)
- (((type tty) (class color)) :foreground "green")
- (t :slant italic :foreground "SeaGreen1"))
+ (((min-colors 64)) :slant italic :foreground "SeaGreen1")
+ (((class color)) :foreground "green")
+ (t :weight bold))
(mdw-define-face font-lock-string-face
- (((class mono)) :weight bold)
- (((class color)) :foreground "SkyBlue1"))
+ (((min-colors 64)) :foreground "SkyBlue1")
+ (((class color)) :foreground "cyan")
+ (t :weight bold))
+
(mdw-define-face message-separator
(t :background "red" :foreground "white" :weight bold))
(mdw-define-face message-cited-text
(default :slant italic)
- (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
+ (((min-colors 64)) :foreground "SkyBlue1")
+ (((class color)) :foreground "cyan"))
(mdw-define-face message-header-cc
- (default :weight bold)
- (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
+ (default :slant italic)
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
(mdw-define-face message-header-newsgroups
- (default :weight bold)
- (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
+ (default :slant italic)
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
(mdw-define-face message-header-subject
- (default :weight bold)
- (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
(mdw-define-face message-header-to
- (default :weight bold)
- (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
(mdw-define-face message-header-xheader
- (default :weight bold)
- (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
+ (default :slant italic)
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
(mdw-define-face message-header-other
- (default :weight bold)
- (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
+ (default :slant italic)
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
(mdw-define-face message-header-name
- (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
+ (default :weight bold)
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
+
(mdw-define-face which-func
(t nil))
+(mdw-define-face gnus-header-name
+ (default :weight bold)
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
+(mdw-define-face gnus-header-subject
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
+(mdw-define-face gnus-header-from
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
+(mdw-define-face gnus-header-to
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
+(mdw-define-face gnus-header-content
+ (default :slant italic)
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
+
+(mdw-define-face gnus-cite-1
+ (((min-colors 64)) :foreground "SkyBlue1")
+ (((class color)) :foreground "cyan"))
+(mdw-define-face gnus-cite-2
+ (((min-colors 64)) :foreground "RoyalBlue2")
+ (((class color)) :foreground "blue"))
+(mdw-define-face gnus-cite-3
+ (((min-colors 64)) :foreground "MediumOrchid")
+ (((class color)) :foreground "magenta"))
+(mdw-define-face gnus-cite-4
+ (((min-colors 64)) :foreground "firebrick2")
+ (((class color)) :foreground "red"))
+(mdw-define-face gnus-cite-5
+ (((min-colors 64)) :foreground "burlywood2")
+ (((class color)) :foreground "yellow"))
+(mdw-define-face gnus-cite-6
+ (((min-colors 64)) :foreground "SeaGreen1")
+ (((class color)) :foreground "green"))
+(mdw-define-face gnus-cite-7
+ (((min-colors 64)) :foreground "SlateBlue1")
+ (((class color)) :foreground "cyan"))
+(mdw-define-face gnus-cite-8
+ (((min-colors 64)) :foreground "RoyalBlue2")
+ (((class color)) :foreground "blue"))
+(mdw-define-face gnus-cite-9
+ (((min-colors 64)) :foreground "purple2")
+ (((class color)) :foreground "magenta"))
+(mdw-define-face gnus-cite-10
+ (((min-colors 64)) :foreground "DarkOrange2")
+ (((class color)) :foreground "red"))
+(mdw-define-face gnus-cite-11
+ (t :foreground "grey"))
+
(mdw-define-face diff-header
(t nil))
(mdw-define-face diff-index
(mdw-define-face diff-file-header
(t :weight bold))
(mdw-define-face diff-hunk-header
- (t :foreground "SkyBlue1"))
+ (((min-colors 64)) :foreground "SkyBlue1")
+ (((class color)) :foreground "cyan"))
(mdw-define-face diff-function
- (t :foreground "SkyBlue1" :weight bold))
+ (default :weight bold)
+ (((min-colors 64)) :foreground "SkyBlue1")
+ (((class color)) :foreground "cyan"))
(mdw-define-face diff-header
- (t :background "grey10"))
+ (((min-colors 64)) :background "grey10"))
(mdw-define-face diff-added
- (t :foreground "green"))
+ (((class color)) :foreground "green"))
(mdw-define-face diff-removed
- (t :foreground "red"))
+ (((class color)) :foreground "red"))
(mdw-define-face diff-context
(t nil))
(mdw-define-face diff-refine-change
- (((class color) (type x)) :background "RoyalBlue4")
+ (((min-colors 64)) :background "RoyalBlue4")
+ (t :underline t))
+(mdw-define-face diff-refine-removed
+ (((min-colors 64)) :background "#500")
+ (t :underline t))
+(mdw-define-face diff-refine-added
+ (((min-colors 64)) :background "#050")
(t :underline t))
+(setq ediff-force-faces t)
+(mdw-define-face ediff-current-diff-A
+ (((min-colors 64)) :background "darkred")
+ (((class color)) :background "red")
+ (t :inverse-video t))
+(mdw-define-face ediff-fine-diff-A
+ (((min-colors 64)) :background "red3")
+ (((class color)) :inverse-video t)
+ (t :inverse-video nil))
+(mdw-define-face ediff-even-diff-A
+ (((min-colors 64)) :background "#300"))
+(mdw-define-face ediff-odd-diff-A
+ (((min-colors 64)) :background "#300"))
+(mdw-define-face ediff-current-diff-B
+ (((min-colors 64)) :background "darkgreen")
+ (((class color)) :background "magenta")
+ (t :inverse-video t))
+(mdw-define-face ediff-fine-diff-B
+ (((min-colors 64)) :background "green4")
+ (((class color)) :inverse-video t)
+ (t :inverse-video nil))
+(mdw-define-face ediff-even-diff-B
+ (((min-colors 64)) :background "#020"))
+(mdw-define-face ediff-odd-diff-B
+ (((min-colors 64)) :background "#020"))
+(mdw-define-face ediff-current-diff-C
+ (((min-colors 64)) :background "darkblue")
+ (((class color)) :background "blue")
+ (t :inverse-video t))
+(mdw-define-face ediff-fine-diff-C
+ (((min-colors 64)) :background "blue1")
+ (((class color)) :inverse-video t)
+ (t :inverse-video nil))
+(mdw-define-face ediff-even-diff-C
+ (((min-colors 64)) :background "#004"))
+(mdw-define-face ediff-odd-diff-C
+ (((min-colors 64)) :background "#004"))
+(mdw-define-face ediff-current-diff-Ancestor
+ (((min-colors 64)) :background "#630")
+ (((class color)) :background "blue")
+ (t :inverse-video t))
+(mdw-define-face ediff-even-diff-Ancestor
+ (((min-colors 64)) :background "#320"))
+(mdw-define-face ediff-odd-diff-Ancestor
+ (((min-colors 64)) :background "#320"))
+
+(mdw-define-face magit-hash
+ (((min-colors 64)) :foreground "grey40")
+ (((class color)) :foreground "blue"))
+(mdw-define-face magit-diff-hunk-heading
+ (((min-colors 64)) :foreground "grey70" :background "grey25")
+ (((class color)) :foreground "yellow"))
+(mdw-define-face magit-diff-hunk-heading-highlight
+ (((min-colors 64)) :foreground "grey70" :background "grey35")
+ (((class color)) :foreground "yellow" :background "blue"))
+(mdw-define-face magit-diff-added
+ (((min-colors 64)) :foreground "#ddffdd" :background "#335533")
+ (((class color)) :foreground "green"))
+(mdw-define-face magit-diff-added-highlight
+ (((min-colors 64)) :foreground "#cceecc" :background "#336633")
+ (((class color)) :foreground "green" :background "blue"))
+(mdw-define-face magit-diff-removed
+ (((min-colors 64)) :foreground "#ffdddd" :background "#553333")
+ (((class color)) :foreground "red"))
+(mdw-define-face magit-diff-removed-highlight
+ (((min-colors 64)) :foreground "#eecccc" :background "#663333")
+ (((class color)) :foreground "red" :background "blue"))
+(mdw-define-face magit-blame-heading
+ (((min-colors 64)) :foreground "white" :background "grey25"
+ :weight normal :slant normal)
+ (((class color)) :foreground "white" :background "blue"
+ :weight normal :slant normal))
+(mdw-define-face magit-blame-name
+ (t :inherit magit-blame-heading :slant italic))
+(mdw-define-face magit-blame-date
+ (((min-colors 64)) :inherit magit-blame-heading :foreground "grey60")
+ (((class color)) :inherit magit-blame-heading :foreground "cyan"))
+(mdw-define-face magit-blame-summary
+ (t :inherit magit-blame-heading :weight bold))
+
+(mdw-define-face dylan-header-background
+ (((min-colors 64)) :background "NavyBlue")
+ (((class color)) :background "blue"))
+
(mdw-define-face erc-input-face
(t :foreground "red"))
(mdw-define-face woman-italic
(t :slant italic))
+(eval-after-load "rst"
+ '(progn
+ (mdw-define-face rst-level-1-face
+ (t :foreground "SkyBlue1" :weight bold))
+ (mdw-define-face rst-level-2-face
+ (t :foreground "SeaGreen1" :weight bold))
+ (mdw-define-face rst-level-3-face
+ (t :weight bold))
+ (mdw-define-face rst-level-4-face
+ (t :slant italic))
+ (mdw-define-face rst-level-5-face
+ (t :underline t))
+ (mdw-define-face rst-level-6-face
+ ())))
+
(mdw-define-face p4-depot-added-face
(t :foreground "green"))
(mdw-define-face p4-depot-branch-op-face
(mdw-define-face p4-diff-ins-face
(t :foreground "green"))
+(mdw-define-face w3m-anchor-face
+ (t :foreground "SkyBlue1" :underline t))
+(mdw-define-face w3m-arrived-anchor-face
+ (t :foreground "SkyBlue1" :underline t))
+
(mdw-define-face whizzy-slice-face
(t :background "grey10"))
(mdw-define-face whizzy-error-face
(mdw-define-face mdw-ellipsis-face
(((type tty)) :foreground "blue") (t :foreground "grey60"))
(let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
- (backslash (make-glyph-code ?\ 'mdw-ellipsis-face))
+ (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
(dot (make-glyph-code ?. 'mdw-ellipsis-face))
(bar (make-glyph-code ?| mdw-ellipsis-face)))
(set-display-table-slot standard-display-table 0 dollar)
(set-display-table-slot standard-display-table 5 bar))
;;;--------------------------------------------------------------------------
-;;; C programming configuration.
-
-;; Linux kernel hacking.
+;;; Where is point?
+
+(mdw-define-face mdw-point-overlay-face
+ (((type graphic)))
+ (((min-colors 64)) :background "darkblue")
+ (((class color)) :background "blue")
+ (((type tty) (class mono)) :inverse-video t))
+
+(defvar mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar))
+
+(defun mdw-configure-point-overlay ()
+ (let ((ov (make-overlay 0 0)))
+ (overlay-put ov 'priority 0)
+ (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
+ (left (car fringe)) (right (cdr fringe))
+ (s ""))
+ (when left
+ (let ((ss "."))
+ (put-text-property 0 1 'display `(left-fringe ,left) ss)
+ (setq s (concat s ss))))
+ (when right
+ (let ((ss "."))
+ (put-text-property 0 1 'display `(right-fringe ,right) ss)
+ (setq s (concat s ss))))
+ (when (or left right)
+ (overlay-put ov 'before-string s)))
+ (overlay-put ov 'face 'mdw-point-overlay-face)
+ (delete-overlay ov)
+ ov))
+
+(defvar mdw-point-overlay (mdw-configure-point-overlay)
+ "An overlay used for showing where point is in the selected window.")
+(defun mdw-reconfigure-point-overlay ()
+ (interactive)
+ (setq mdw-point-overlay (mdw-configure-point-overlay)))
+
+(defun mdw-remove-point-overlay ()
+ "Remove the current-point overlay."
+ (delete-overlay mdw-point-overlay))
+
+(defun mdw-update-point-overlay ()
+ "Mark the current point position with an overlay."
+ (if (not mdw-point-overlay-mode)
+ (mdw-remove-point-overlay)
+ (overlay-put mdw-point-overlay 'window (selected-window))
+ (move-overlay mdw-point-overlay
+ (line-beginning-position)
+ (+ (line-end-position) 1))))
+
+(defvar mdw-point-overlay-buffers nil
+ "List of buffers using `mdw-point-overlay-mode'.")
+
+(define-minor-mode mdw-point-overlay-mode
+ "Indicate current line with an overlay."
+ :global nil
+ (let ((buffer (current-buffer)))
+ (setq mdw-point-overlay-buffers
+ (mapcan (lambda (buf)
+ (if (and (buffer-live-p buf)
+ (not (eq buf buffer)))
+ (list buf)))
+ mdw-point-overlay-buffers))
+ (if mdw-point-overlay-mode
+ (setq mdw-point-overlay-buffers
+ (cons buffer mdw-point-overlay-buffers))))
+ (cond (mdw-point-overlay-buffers
+ (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
+ (add-hook 'post-command-hook 'mdw-update-point-overlay))
+ (t
+ (mdw-remove-point-overlay)
+ (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
+ (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
-(defvar linux-c-mode-hook)
+(define-globalized-minor-mode mdw-global-point-overlay-mode
+ mdw-point-overlay-mode
+ (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
-(defun linux-c-mode ()
- (interactive)
- (c-mode)
- (setq major-mode 'linux-c-mode)
- (setq mode-name "Linux C")
- (run-hooks 'linux-c-mode-hook))
+;;;--------------------------------------------------------------------------
+;;; C programming configuration.
;; Make C indentation nice.
c-basic-offset
nil)))
-(defun mdw-c-style ()
- (c-add-style "[mdw] C and C++ style"
- '((c-basic-offset . 2)
- (comment-column . 40)
- (c-class-key . "class")
- (c-backslash-column . 72)
- (c-offsets-alist
- (substatement-open . (add 0 c-indent-one-line-block))
- (defun-open . (add 0 c-indent-one-line-block))
- (arglist-cont-nonempty . mdw-c-lineup-arglist)
- (topmost-intro . mdw-c-indent-extern-mumble)
- (cpp-define-intro . 0)
- (knr-argdecl . 0)
- (inextern-lang . [0])
- (label . 0)
- (case-label . +)
- (access-label . -)
- (inclass . +)
- (inline-open . ++)
- (statement-cont . +)
- (statement-case-intro . +)))
- t))
+(defun mdw-c-indent-arglist-nested (langelem)
+ "Indent continued argument lists.
+If we've nested more than one argument list, then only introduce a single
+indentation anyway."
+ (let ((context c-syntactic-context)
+ (pos (c-langelem-2nd-pos c-syntactic-element))
+ (should-indent-p t))
+ (while (and context
+ (eq (caar context) 'arglist-cont-nonempty))
+ (when (and (= (caddr (pop context)) pos)
+ context
+ (memq (caar context) '(arglist-intro
+ arglist-cont-nonempty)))
+ (setq should-indent-p nil)))
+ (if should-indent-p '+ 0)))
+
+(defvar mdw-define-c-styles-hook nil
+ "Hook run when `cc-mode' starts up to define styles.")
+
+(defmacro mdw-define-c-style (name &rest assocs)
+ "Define a C style, called NAME (a symbol), setting ASSOCs.
+A function, named `mdw-define-c-style/NAME', is defined to actually install
+the style using `c-add-style', and added to the hook
+`mdw-define-c-styles-hook'. If CC Mode is already loaded, then the style is
+set."
+ (declare (indent defun))
+ (let* ((name-string (symbol-name name))
+ (func (intern (concat "mdw-define-c-style/" name-string))))
+ `(progn
+ (defun ,func () (c-add-style ,name-string ',assocs))
+ (and (featurep 'cc-mode) (,func))
+ (add-hook 'mdw-define-c-styles-hook ',func))))
+
+(eval-after-load "cc-mode"
+ '(run-hooks 'mdw-define-c-styles-hook))
+
+(mdw-define-c-style mdw-trustonic-c
+ (c-basic-offset . 4)
+ (comment-column . 0)
+ (c-indent-comment-alist (anchored-comment . (column . 0))
+ (end-block . (space . 1))
+ (cpp-end-block . (space . 1))
+ (other . (space . 1)))
+ (c-class-key . "class")
+ (c-backslash-column . 0)
+ (c-auto-align-backslashes . nil)
+ (c-label-minimum-indentation . 0)
+ (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
+ (defun-open . (add 0 c-indent-one-line-block))
+ (arglist-cont-nonempty . mdw-c-indent-arglist-nested)
+ (topmost-intro . mdw-c-indent-extern-mumble)
+ (cpp-define-intro . 0)
+ (knr-argdecl . 0)
+ (inextern-lang . [0])
+ (label . 0)
+ (case-label . +)
+ (access-label . -2)
+ (inclass . +)
+ (inline-open . ++)
+ (statement-cont . +)
+ (statement-case-intro . +)))
+
+(mdw-define-c-style mdw-c
+ (c-basic-offset . 2)
+ (comment-column . 40)
+ (c-class-key . "class")
+ (c-backslash-column . 72)
+ (c-label-minimum-indentation . 0)
+ (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
+ (defun-open . (add 0 c-indent-one-line-block))
+ (arglist-cont-nonempty . mdw-c-lineup-arglist)
+ (topmost-intro . mdw-c-indent-extern-mumble)
+ (cpp-define-intro . 0)
+ (knr-argdecl . 0)
+ (inextern-lang . [0])
+ (label . 0)
+ (case-label . +)
+ (access-label . -)
+ (inclass . +)
+ (inline-open . ++)
+ (statement-cont . +)
+ (statement-case-intro . +)))
+
+(defun mdw-set-default-c-style (modes style)
+ "Update the default CC Mode style for MODES to be STYLE.
+
+MODES may be a list of major mode names or a singleton. STYLE is a style
+name, as a symbol."
+ (let ((modes (if (listp modes) modes (list modes)))
+ (style (symbol-name style)))
+ (setq c-default-style
+ (append (mapcar (lambda (mode)
+ (cons mode style))
+ modes)
+ (remove-if (lambda (assoc)
+ (memq (car assoc) modes))
+ (if (listp c-default-style)
+ c-default-style
+ (list (cons 'other c-default-style))))))))
+(setq c-default-style "mdw-c")
+
+(mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c)
(defvar mdw-c-comment-fill-prefix
`((,(concat "\\([ \t]*/?\\)"
- "\\(\*\\|//]\\)"
+ "\\(\\*\\|//\\)"
"\\([ \t]*\\)"
"\\([A-Za-z]+:[ \t]*\\)?"
mdw-hanging-indents)
(modify-syntax-entry ?\n "> b")
;; Other stuff.
- (mdw-c-style)
- (setq c-hanging-comment-ender-p nil)
- (setq c-backslash-column 72)
- (setq c-label-minimum-indentation 0)
(setq mdw-fill-prefix mdw-c-comment-fill-prefix)
;; Now define things to be fontified.
(make-local-variable 'font-lock-keywords)
(let ((c-keywords
- (mdw-regexps "and" ;C++
- "and_eq" ;C++
- "asm" ;K&R, GCC
- "auto" ;K&R, C89
- "bitand" ;C++
- "bitor" ;C++
- "bool" ;C++, C9X macro
- "break" ;K&R, C89
- "case" ;K&R, C89
- "catch" ;C++
- "char" ;K&R, C89
- "class" ;C++
- "complex" ;C9X macro, C++ template type
- "compl" ;C++
- "const" ;C89
- "const_cast" ;C++
- "continue" ;K&R, C89
- "defined" ;C89 preprocessor
- "default" ;K&R, C89
- "delete" ;C++
- "do" ;K&R, C89
- "double" ;K&R, C89
- "dynamic_cast" ;C++
- "else" ;K&R, C89
- ;; "entry" ;K&R -- never used
- "enum" ;C89
- "explicit" ;C++
- "export" ;C++
- "extern" ;K&R, C89
- "false" ;C++, C9X macro
- "float" ;K&R, C89
- "for" ;K&R, C89
- ;; "fortran" ;K&R
- "friend" ;C++
- "goto" ;K&R, C89
- "if" ;K&R, C89
- "imaginary" ;C9X macro
- "inline" ;C++, C9X, GCC
- "int" ;K&R, C89
- "long" ;K&R, C89
- "mutable" ;C++
- "namespace" ;C++
- "new" ;C++
- "operator" ;C++
- "or" ;C++
- "or_eq" ;C++
- "private" ;C++
- "protected" ;C++
- "public" ;C++
- "register" ;K&R, C89
+ (mdw-regexps "alignas" ;C11 macro, C++11
+ "alignof" ;C++11
+ "and" ;C++, C95 macro
+ "and_eq" ;C++, C95 macro
+ "asm" ;K&R, C++, GCC
+ "atomic" ;C11 macro, C++11 template type
+ "auto" ;K&R, C89
+ "bitand" ;C++, C95 macro
+ "bitor" ;C++, C95 macro
+ "bool" ;C++, C99 macro
+ "break" ;K&R, C89
+ "case" ;K&R, C89
+ "catch" ;C++
+ "char" ;K&R, C89
+ "char16_t" ;C++11, C11 library type
+ "char32_t" ;C++11, C11 library type
+ "class" ;C++
+ "complex" ;C99 macro, C++ template type
+ "compl" ;C++, C95 macro
+ "const" ;C89
+ "constexpr" ;C++11
+ "const_cast" ;C++
+ "continue" ;K&R, C89
+ "decltype" ;C++11
+ "defined" ;C89 preprocessor
+ "default" ;K&R, C89
+ "delete" ;C++
+ "do" ;K&R, C89
+ "double" ;K&R, C89
+ "dynamic_cast" ;C++
+ "else" ;K&R, C89
+ ;; "entry" ;K&R -- never used
+ "enum" ;C89
+ "explicit" ;C++
+ "export" ;C++
+ "extern" ;K&R, C89
+ "float" ;K&R, C89
+ "for" ;K&R, C89
+ ;; "fortran" ;K&R
+ "friend" ;C++
+ "goto" ;K&R, C89
+ "if" ;K&R, C89
+ "imaginary" ;C99 macro
+ "inline" ;C++, C99, GCC
+ "int" ;K&R, C89
+ "long" ;K&R, C89
+ "mutable" ;C++
+ "namespace" ;C++
+ "new" ;C++
+ "noexcept" ;C++11
+ "noreturn" ;C11 macro
+ "not" ;C++, C95 macro
+ "not_eq" ;C++, C95 macro
+ "nullptr" ;C++11
+ "operator" ;C++
+ "or" ;C++, C95 macro
+ "or_eq" ;C++, C95 macro
+ "private" ;C++
+ "protected" ;C++
+ "public" ;C++
+ "register" ;K&R, C89
"reinterpret_cast" ;C++
- "restrict" ;C9X
+ "restrict" ;C99
"return" ;K&R, C89
"short" ;K&R, C89
"signed" ;C89
"sizeof" ;K&R, C89
"static" ;K&R, C89
+ "static_assert" ;C11 macro, C++11
"static_cast" ;C++
"struct" ;K&R, C89
"switch" ;K&R, C89
"template" ;C++
- "this" ;C++
"throw" ;C++
- "true" ;C++, C9X macro
"try" ;C++
- "this" ;C++
+ "thread_local" ;C11 macro, C++11
"typedef" ;C89
"typeid" ;C++
"typeof" ;GCC
"volatile" ;C89
"wchar_t" ;C++, C89 library type
"while" ;K&R, C89
- "xor" ;C++
- "xor_eq" ;C++
- "_Bool" ;C9X
- "_Complex" ;C9X
- "_Imaginary" ;C9X
- "_Pragma" ;C9X preprocessor
+ "xor" ;C++, C95 macro
+ "xor_eq" ;C++, C95 macro
+ "_Alignas" ;C11
+ "_Alignof" ;C11
+ "_Atomic" ;C11
+ "_Bool" ;C99
+ "_Complex" ;C99
+ "_Generic" ;C11
+ "_Imaginary" ;C99
+ "_Noreturn" ;C11
+ "_Pragma" ;C99 preprocessor
+ "_Static_assert" ;C11
+ "_Thread_local" ;C11
"__alignof__" ;GCC
"__asm__" ;GCC
"__attribute__" ;GCC
"__typeof__" ;GCC
"__volatile__" ;GCC
))
+ (c-constants
+ (mdw-regexps "false" ;C++, C99 macro
+ "this" ;C++
+ "true" ;C++, C99 macro
+ ))
(preprocessor-keywords
(mdw-regexps "assert" "define" "elif" "else" "endif" "error"
"ident" "if" "ifdef" "ifndef" "import" "include"
(list (concat "\\<\\(" c-keywords "\\)\\>")
'(0 font-lock-keyword-face))
+ (list (concat "\\<\\(" c-constants "\\)\\>")
+ '(0 font-lock-variable-name-face))
+
;; Handle numbers too.
;;
;; This looks strange, I know. It corresponds to the
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face))))
+ '(0 mdw-punct-face))))))
- (mdw-post-config-mode-hack)))
+(define-derived-mode sod-mode c-mode "Sod"
+ "Major mode for editing Sod code.")
+(push '("\\.sod$" . sod-mode) auto-mode-alist)
;;;--------------------------------------------------------------------------
;;; AP calc mode.
-(defun apcalc-mode ()
- (interactive)
- (c-mode)
- (setq major-mode 'apcalc-mode)
- (setq mode-name "AP Calc")
- (run-hooks 'apcalc-mode-hook))
+(define-derived-mode apcalc-mode c-mode "AP Calc"
+ "Major mode for editing Calc code.")
(defun mdw-fontify-apcalc ()
(modify-syntax-entry ?/ ". 14")
;; Other stuff.
- (mdw-c-style)
- (setq c-hanging-comment-ender-p nil)
- (setq c-backslash-column 72)
(setq comment-start "/* ")
(setq comment-end " */")
(setq mdw-fill-prefix mdw-c-comment-fill-prefix)
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face))))))
;;;--------------------------------------------------------------------------
;;; Java programming configuration.
;; Make indentation nice.
-(defun mdw-java-style ()
- (c-add-style "[mdw] Java style"
- '((c-basic-offset . 2)
- (c-offsets-alist (substatement-open . 0)
- (label . +)
- (case-label . +)
- (access-label . 0)
- (inclass . +)
- (statement-case-intro . +)))
- t))
+(mdw-define-c-style mdw-java
+ (c-basic-offset . 2)
+ (c-backslash-column . 72)
+ (c-offsets-alist (substatement-open . 0)
+ (label . +)
+ (case-label . +)
+ (access-label . 0)
+ (inclass . +)
+ (statement-case-intro . +)))
+(mdw-set-default-c-style 'java-mode 'mdw-java)
;; Declare Java fontification style.
(defun mdw-fontify-java ()
+ ;; Fiddle with some syntax codes.
+ (modify-syntax-entry ?@ ".")
+ (modify-syntax-entry ?@ "." font-lock-syntax-table)
+
;; Other stuff.
- (mdw-java-style)
- (setq c-hanging-comment-ender-p nil)
- (setq c-backslash-column 72)
(setq mdw-fill-prefix mdw-c-comment-fill-prefix)
;; Now define things to be fontified.
(make-local-variable 'font-lock-keywords)
(let ((java-keywords
- (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
- "char" "class" "const" "continue" "default" "do"
- "double" "else" "extends" "final" "finally" "float"
- "for" "goto" "if" "implements" "import" "instanceof"
- "int" "interface" "long" "native" "new" "package"
- "private" "protected" "public" "return" "short"
- "static" "super" "switch" "synchronized" "this"
- "throw" "throws" "transient" "try" "void" "volatile"
- "while"
-
- "false" "null" "true")))
+ (mdw-regexps "abstract" "assert"
+ "boolean" "break" "byte"
+ "case" "catch" "char" "class" "const" "continue"
+ "default" "do" "double"
+ "else" "enum" "extends"
+ "final" "finally" "float" "for"
+ "goto"
+ "if" "implements" "import" "instanceof" "int"
+ "interface"
+ "long"
+ "native" "new"
+ "package" "private" "protected" "public"
+ "return"
+ "short" "static" "strictfp" "switch" "synchronized"
+ "throw" "throws" "transient" "try"
+ "void" "volatile"
+ "while"))
+
+ (java-constants
+ (mdw-regexps "false" "null" "super" "this" "true")))
(setq font-lock-keywords
(list
(list (concat "\\<\\(" java-keywords "\\)\\>")
'(0 font-lock-keyword-face))
+ ;; Handle the magic constants defined above.
+ (list (concat "\\<\\(" java-constants "\\)\\>")
+ '(0 font-lock-variable-name-face))
+
;; Handle numbers too.
;;
;; The following isn't quite right, but it's close enough.
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face))))))
;;;--------------------------------------------------------------------------
;;; Javascript programming configuration.
(list
;; Handle the keywords defined above.
- (list (concat "\\<\\(" javascript-keywords "\\)\\>")
+ (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
'(0 font-lock-keyword-face))
;; Handle the predefined constants defined above.
- (list (concat "\\<\\(" javascript-constants "\\)\\>")
+ (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
'(0 font-lock-variable-name-face))
;; Handle numbers too.
;;
;; The following isn't quite right, but it's close enough.
- (list (concat "\\<\\("
+ (list (concat "\\_<\\("
"0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
"[0-9]+\\(\\.[0-9]*\\|\\)"
"\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
+ '(0 mdw-punct-face))))))
+
+;;;--------------------------------------------------------------------------
+;;; Scala programming configuration.
+
+(defun mdw-fontify-scala ()
- (mdw-post-config-mode-hack))
+ ;; Comment filling.
+ (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
+
+ ;; Define things to be fontified.
+ (make-local-variable 'font-lock-keywords)
+ (let ((scala-keywords
+ (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
+ "extends" "final" "finally" "for" "forSome" "if"
+ "implicit" "import" "lazy" "match" "new" "object"
+ "override" "package" "private" "protected" "return"
+ "sealed" "throw" "trait" "try" "type" "val"
+ "var" "while" "with" "yield"))
+ (scala-constants
+ (mdw-regexps "false" "null" "super" "this" "true"))
+ (punctuation "[-!%^&*=+:@#~/?\\|`]"))
+
+ (setq font-lock-keywords
+ (list
+
+ ;; Magical identifiers between backticks.
+ (list (concat "`\\([^`]+\\)`")
+ '(1 font-lock-variable-name-face))
+
+ ;; Handle the keywords defined above.
+ (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
+ '(0 font-lock-keyword-face))
+
+ ;; Handle the constants defined above.
+ (list (concat "\\_<\\(" scala-constants "\\)\\_>")
+ '(0 font-lock-variable-name-face))
+
+ ;; Magical identifiers between backticks.
+ (list (concat "`\\([^`]+\\)`")
+ '(1 font-lock-variable-name-face))
+
+ ;; Handle numbers too.
+ ;;
+ ;; As usual, not quite right.
+ (list (concat "\\_<\\("
+ "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
+ "[0-9]+\\(\\.[0-9]*\\|\\)"
+ "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
+ "[lLfFdD]?")
+ '(0 mdw-number-face))
+
+ ;; And everything else is punctuation.
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face)))
+
+ font-lock-syntactic-keywords
+ (list
+
+ ;; Single quotes around characters. But not when used to quote
+ ;; symbol names. Ugh.
+ (list (concat "\\('\\)"
+ "\\(" "."
+ "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
+ "u+" "[0-9a-fA-F]\\{4\\}"
+ "\\|" "\\\\" "[0-7]\\{1,3\\}"
+ "\\|" "\\\\" "." "\\)"
+ "\\('\\)")
+ '(1 "\"")
+ '(4 "\""))))))
;;;--------------------------------------------------------------------------
;;; C# programming configuration.
;; Make indentation nice.
-(defun mdw-csharp-style ()
- (c-add-style "[mdw] C# style"
- '((c-basic-offset . 2)
- (c-offsets-alist (substatement-open . 0)
- (label . 0)
- (case-label . +)
- (access-label . 0)
- (inclass . +)
- (statement-case-intro . +)))
- t))
+(mdw-define-c-style mdw-csharp
+ (c-basic-offset . 2)
+ (c-backslash-column . 72)
+ (c-offsets-alist (substatement-open . 0)
+ (label . 0)
+ (case-label . +)
+ (access-label . 0)
+ (inclass . +)
+ (statement-case-intro . +)))
+(mdw-set-default-c-style 'csharp-mode 'mdw-csharp)
;; Declare C# fontification style.
(defun mdw-fontify-csharp ()
;; Other stuff.
- (mdw-csharp-style)
- (setq c-hanging-comment-ender-p nil)
- (setq c-backslash-column 72)
(setq mdw-fill-prefix mdw-c-comment-fill-prefix)
;; Now define things to be fontified.
(make-local-variable 'font-lock-keywords)
(let ((csharp-keywords
- (mdw-regexps "abstract" "as" "base" "bool" "break"
- "byte" "case" "catch" "char" "checked"
- "class" "const" "continue" "decimal" "default"
- "delegate" "do" "double" "else" "enum"
- "event" "explicit" "extern" "false" "finally"
- "fixed" "float" "for" "foreach" "goto"
- "if" "implicit" "in" "int" "interface"
- "internal" "is" "lock" "long" "namespace"
- "new" "null" "object" "operator" "out"
- "override" "params" "private" "protected" "public"
- "readonly" "ref" "return" "sbyte" "sealed"
- "short" "sizeof" "stackalloc" "static" "string"
- "struct" "switch" "this" "throw" "true"
- "try" "typeof" "uint" "ulong" "unchecked"
- "unsafe" "ushort" "using" "virtual" "void"
- "volatile" "while" "yield")))
+ (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
+ "char" "checked" "class" "const" "continue" "decimal"
+ "default" "delegate" "do" "double" "else" "enum"
+ "event" "explicit" "extern" "finally" "fixed" "float"
+ "for" "foreach" "goto" "if" "implicit" "in" "int"
+ "interface" "internal" "is" "lock" "long" "namespace"
+ "new" "object" "operator" "out" "override" "params"
+ "private" "protected" "public" "readonly" "ref"
+ "return" "sbyte" "sealed" "short" "sizeof"
+ "stackalloc" "static" "string" "struct" "switch"
+ "throw" "try" "typeof" "uint" "ulong" "unchecked"
+ "unsafe" "ushort" "using" "virtual" "void" "volatile"
+ "while" "yield"))
+
+ (csharp-constants
+ (mdw-regexps "base" "false" "null" "this" "true")))
(setq font-lock-keywords
(list
(list (concat "\\<\\(" csharp-keywords "\\)\\>")
'(0 font-lock-keyword-face))
+ ;; Handle the magic constants defined above.
+ (list (concat "\\<\\(" csharp-constants "\\)\\>")
+ '(0 font-lock-variable-name-face))
+
;; Handle numbers too.
;;
;; The following isn't quite right, but it's close enough.
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face))))))
(define-derived-mode csharp-mode java-mode "C#"
"Major mode for editing C# code.")
+;;;--------------------------------------------------------------------------
+;;; F# programming configuration.
+
+(setq fsharp-indent-offset 2)
+
+(defun mdw-fontify-fsharp ()
+
+ (let ((punct "=<>+-*/|&%!@?"))
+ (do ((i 0 (1+ i)))
+ ((>= i (length punct)))
+ (modify-syntax-entry (aref punct i) ".")))
+
+ (modify-syntax-entry ?_ "_")
+ (modify-syntax-entry ?( "(")
+ (modify-syntax-entry ?) ")")
+
+ (setq indent-tabs-mode nil)
+
+ (let ((fsharp-keywords
+ (mdw-regexps "abstract" "and" "as" "assert" "atomic"
+ "begin" "break"
+ "checked" "class" "component" "const" "constraint"
+ "constructor" "continue"
+ "default" "delegate" "do" "done" "downcast" "downto"
+ "eager" "elif" "else" "end" "exception" "extern"
+ "finally" "fixed" "for" "fori" "fun" "function"
+ "functor"
+ "global"
+ "if" "in" "include" "inherit" "inline" "interface"
+ "internal"
+ "lazy" "let"
+ "match" "measure" "member" "method" "mixin" "module"
+ "mutable"
+ "namespace" "new"
+ "object" "of" "open" "or" "override"
+ "parallel" "params" "private" "process" "protected"
+ "public" "pure"
+ "rec" "recursive" "return"
+ "sealed" "sig" "static" "struct"
+ "tailcall" "then" "to" "trait" "try" "type"
+ "upcast" "use"
+ "val" "virtual" "void" "volatile"
+ "when" "while" "with"
+ "yield"))
+
+ (fsharp-builtins
+ (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
+ "base" "false" "null" "true"))
+
+ (bang-keywords
+ (mdw-regexps "do" "let" "return" "use" "yield"))
+
+ (preprocessor-keywords
+ (mdw-regexps "if" "indent" "else" "endif")))
+
+ (setq font-lock-keywords
+ (list (list (concat "\\(^\\|[^\"]\\)"
+ "\\(" "(\\*"
+ "[^*]*\\*+"
+ "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
+ ")"
+ "\\|"
+ "//.*"
+ "\\)")
+ '(2 font-lock-comment-face))
+
+ (list (concat "'" "\\("
+ "\\\\"
+ "\\(" "[ntbr'\\]"
+ "\\|" "[0-9][0-9][0-9]"
+ "\\|" "u" "[0-9a-fA-F]\\{4\\}"
+ "\\|" "U" "[0-9a-fA-F]\\{8\\}"
+ "\\)"
+ "\\|"
+ "." "\\)" "'"
+ "\\|"
+ "\"" "[^\"\\]*"
+ "\\(" "\\\\" "\\(.\\|\n\\)"
+ "[^\"\\]*" "\\)*"
+ "\\(\"\\|\\'\\)")
+ '(0 font-lock-string-face))
+
+ (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
+ "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
+ "\\|"
+ "\\_<\\(" fsharp-keywords "\\)\\_>")
+ '(0 font-lock-keyword-face))
+ (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
+ '(0 font-lock-variable-name-face))
+
+ (list (concat "\\_<"
+ "\\(" "0[bB][01]+" "\\|"
+ "0[oO][0-7]+" "\\|"
+ "0[xX][0-9a-fA-F]+" "\\)"
+ "\\(" "lf\\|LF" "\\|"
+ "[uU]?[ysnlL]?" "\\)"
+ "\\|"
+ "\\_<"
+ "[0-9]+" "\\("
+ "[mMQRZING]"
+ "\\|"
+ "\\(\\.[0-9]*\\)?"
+ "\\([eE][-+]?[0-9]+\\)?"
+ "[fFmM]?"
+ "\\|"
+ "[uU]?[ysnlL]?"
+ "\\)")
+ '(0 mdw-number-face))
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+(defun mdw-fontify-inferior-fsharp ()
+ (mdw-fontify-fsharp)
+ (setq font-lock-keywords
+ (append (list (list "^[#-]" '(0 font-lock-comment-face))
+ (list "^>" '(0 font-lock-keyword-face)))
+ font-lock-keywords)))
+
;;;--------------------------------------------------------------------------
;;; Go programming configuration.
"default" "defer" "else" "fallthrough" "for"
"func" "go" "goto" "if" "import"
"interface" "map" "package" "range" "return"
- "select" "struct" "switch" "type" "var")))
+ "select" "struct" "switch" "type" "var"))
+ (go-intrinsics
+ (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
+ "float32" "float64" "int" "uint8" "int16" "int32"
+ "int64" "rune" "string" "uint" "uint8" "uint16"
+ "uint32" "uint64" "uintptr" "void"
+ "false" "iota" "nil" "true"
+ "init" "main"
+ "append" "cap" "copy" "delete" "imag" "len" "make"
+ "new" "panic" "real" "recover")))
(setq font-lock-keywords
(list
;; Handle the keywords defined above.
(list (concat "\\<\\(" go-keywords "\\)\\>")
'(0 font-lock-keyword-face))
+ (list (concat "\\<\\(" go-intrinsics "\\)\\>")
+ '(0 font-lock-variable-name-face))
+
+ ;; Strings and characters.
+ (list (concat "'"
+ "\\(" "[^\\']" "\\|"
+ "\\\\"
+ "\\(" "[abfnrtv\\'\"]" "\\|"
+ "[0-7]\\{3\\}" "\\|"
+ "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
+ "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
+ "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
+ "'"
+ "\\|"
+ "\""
+ "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
+ "\\(\"\\|$\\)"
+ "\\|"
+ "`" "[^`]+" "`")
+ '(0 font-lock-string-face))
;; Handle numbers too.
;;
"\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
'(0 mdw-number-face))
+ ;; And anything else is punctuation.
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+;;;--------------------------------------------------------------------------
+;;; Rust programming configuration.
+
+(setq-default rust-indent-offset 2)
+
+(defun mdw-self-insert-and-indent (count)
+ (interactive "p")
+ (self-insert-command count)
+ (indent-according-to-mode))
+
+(defun mdw-fontify-rust ()
+
+ ;; Hack syntax categories.
+ (modify-syntax-entry ?= ".")
+
+ ;; Fontify keywords and things.
+ (make-local-variable 'font-lock-keywords)
+ (let ((rust-keywords
+ (mdw-regexps "abstract" "alignof" "as"
+ "become" "box" "break"
+ "const" "continue" "create"
+ "do"
+ "else" "enum" "extern"
+ "final" "fn" "for"
+ "if" "impl" "in"
+ "let" "loop"
+ "macro" "match" "mod" "move" "mut"
+ "offsetof" "override"
+ "priv" "proc" "pub" "pure"
+ "ref" "return"
+ "sizeof" "static" "struct" "super"
+ "trait" "type" "typeof"
+ "unsafe" "unsized" "use"
+ "virtual"
+ "where" "while"
+ "yield"))
+ (rust-builtins
+ (mdw-regexps "array" "pointer" "slice" "tuple"
+ "bool" "true" "false"
+ "f32" "f64"
+ "i8" "i16" "i32" "i64" "isize"
+ "u8" "u16" "u32" "u64" "usize"
+ "char" "str"
+ "self" "Self")))
+ (setq font-lock-keywords
+ (list
+
+ ;; Handle the keywords defined above.
+ (list (concat "\\_<\\(" rust-keywords "\\)\\_>")
+ '(0 font-lock-keyword-face))
+ (list (concat "\\_<\\(" rust-builtins "\\)\\_>")
+ '(0 font-lock-variable-name-face))
+
+ ;; Handle numbers too.
+ (list (concat "\\_<\\("
+ "[0-9][0-9_]*"
+ "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
+ "\\|" "\\.[0-9_]+"
+ "\\)"
+ "\\(f32\\|f64\\)?"
+ "\\|" "\\(" "[0-9][0-9_]*"
+ "\\|" "0x[0-9a-fA-F_]+"
+ "\\|" "0o[0-7_]+"
+ "\\|" "0b[01_]+"
+ "\\)"
+ "\\([ui]\\(8\\|16\\|32\\|64\\|s\\|size\\)\\)?"
+ "\\)\\_>")
+ '(0 mdw-number-face))
+
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
'(0 mdw-punct-face)))))
- (mdw-post-config-mode-hack))
+ ;; Hack key bindings.
+ (local-set-key [?{] 'mdw-self-insert-and-indent)
+ (local-set-key [?}] 'mdw-self-insert-and-indent))
;;;--------------------------------------------------------------------------
;;; Awk programming configuration.
;; Make Awk indentation nice.
-(defun mdw-awk-style ()
- (c-add-style "[mdw] Awk style"
- '((c-basic-offset . 2)
- (c-offsets-alist (substatement-open . 0)
- (statement-cont . 0)
- (statement-case-intro . +)))
- t))
+(mdw-define-c-style mdw-awk
+ (c-basic-offset . 2)
+ (c-offsets-alist (substatement-open . 0)
+ (c-backslash-column . 72)
+ (statement-cont . 0)
+ (statement-case-intro . +)))
+(mdw-set-default-c-style 'awk-mode 'mdw-awk)
;; Declare Awk fontification style.
(defun mdw-fontify-awk ()
;; Miscellaneous fiddling.
- (mdw-awk-style)
- (setq c-backslash-column 72)
(mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
;; Now define things to be fontified.
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face))))))
;;;--------------------------------------------------------------------------
;;; Perl programming style.
;; Perl indentation style.
-(fset 'perl-mode 'cperl-mode)
+(setq perl-indent-level 2)
+
(setq cperl-indent-level 2)
(setq cperl-continued-statement-offset 2)
(setq cperl-continued-brace-offset 0)
;; Miscellaneous fiddling.
(modify-syntax-entry ?$ "\\")
(modify-syntax-entry ?$ "\\" font-lock-syntax-table)
+ (modify-syntax-entry ?: "." font-lock-syntax-table)
(mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
;; Now define fontification things.
(make-local-variable 'font-lock-keywords)
(let ((perl-keywords
- (mdw-regexps "and" "break" "cmp" "continue" "do" "else" "elsif" "eq"
- "for" "foreach" "ge" "given" "gt" "goto" "if"
- "last" "le" "lt" "local" "my" "ne" "next" "or"
- "our" "package" "redo" "require" "return" "sub"
- "undef" "unless" "until" "use" "when" "while")))
+ (mdw-regexps "and"
+ "break"
+ "cmp" "continue"
+ "default" "do"
+ "else" "elsif" "eq"
+ "for" "foreach"
+ "ge" "given" "gt" "goto"
+ "if"
+ "last" "le" "local" "lt"
+ "my"
+ "ne" "next"
+ "or" "our"
+ "package"
+ "redo" "require" "return"
+ "sub"
+ "undef" "unless" "until" "use"
+ "when" "while")))
(setq font-lock-keywords
(list
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face))))))
(defun perl-number-tests (&optional arg)
"Assign consecutive numbers to lines containing `#t'. With ARG,
(list
;; Set up the keywords defined above.
- (list (concat "\\<\\(" keywords "\\)\\>")
+ (list (concat "\\_<\\(" keywords "\\)\\_>")
'(0 font-lock-keyword-face))
;; At least numbers are simpler than C.
- (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
- "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
- "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
+ (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
+ "\\_<[0-9][0-9]*\\(\\.[0-9]*\\|\\)"
+ "\\([eE]\\([-+]\\|\\)[0-9]+\\|[lL]\\|\\)")
'(0 mdw-number-face))
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face)))))
;; Define Python fontification styles.
(defun mdw-fontify-pyrex ()
(mdw-fontify-pythonic
(mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
- "ctypedef" "def" "del" "elif" "else" "except" "exec"
+ "ctypedef" "def" "del" "elif" "else" "enum" "except" "exec"
"extern" "finally" "for" "from" "global" "if"
"import" "in" "is" "lambda" "not" "or" "pass" "print"
- "raise" "return" "struct" "try" "while" "with"
+ "property" "raise" "return" "struct" "try" "while" "with"
"yield")))
+(define-derived-mode pyrex-mode python-mode "Pyrex"
+ "Major mode for editing Pyrex source code")
+(setq auto-mode-alist
+ (append '(("\\.pyx$" . pyrex-mode)
+ ("\\.pxd$" . pyrex-mode)
+ ("\\.pxi$" . pyrex-mode))
+ auto-mode-alist))
+
+;;;--------------------------------------------------------------------------
+;;; Lua programming style.
+
+(setq lua-indent-level 2)
+
+(defun mdw-fontify-lua ()
+
+ ;; Miscellaneous fiddling.
+ (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
+
+ ;; Now define fontification things.
+ (make-local-variable 'font-lock-keywords)
+ (let ((lua-keywords
+ (mdw-regexps "and" "break" "do" "else" "elseif" "end"
+ "false" "for" "function" "goto" "if" "in" "local"
+ "nil" "not" "or" "repeat" "return" "then" "true"
+ "until" "while")))
+ (setq font-lock-keywords
+ (list
+
+ ;; Set up the keywords defined above.
+ (list (concat "\\_<\\(" lua-keywords "\\)\\_>")
+ '(0 font-lock-keyword-face))
+
+ ;; At least numbers are simpler than C.
+ (list (concat "\\_<\\(" "0[xX]"
+ "\\(" "[0-9a-fA-F]+"
+ "\\(\\.[0-9a-fA-F]*\\)?"
+ "\\|" "\\.[0-9a-fA-F]+"
+ "\\)"
+ "\\([pP][-+]?[0-9]+\\)?"
+ "\\|" "\\(" "[0-9]+"
+ "\\(\\.[0-9]*\\)?"
+ "\\|" "\\.[0-9]+"
+ "\\)"
+ "\\([eE][-+]?[0-9]+\\)?"
+ "\\)")
+ '(0 mdw-number-face))
+
+ ;; And anything else is punctuation.
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
;;;--------------------------------------------------------------------------
;;; Icon programming style.
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
-
-;;;--------------------------------------------------------------------------
-;;; ARM assembler programming configuration.
-
-;; There doesn't appear to be an Emacs mode for this yet.
-;;
-;; Better do something about that, I suppose.
-
-(defvar arm-assembler-mode-map nil)
-(defvar arm-assembler-abbrev-table nil)
-(defvar arm-assembler-mode-syntax-table (make-syntax-table))
-
-(or arm-assembler-mode-map
- (progn
- (setq arm-assembler-mode-map (make-sparse-keymap))
- (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
- (define-key arm-assembler-mode-map [C-return] 'newline)
- (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
-
-(defun arm-assembler-mode ()
- "Major mode for ARM assembler programs"
- (interactive)
-
- ;; Do standard major mode things.
- (kill-all-local-variables)
- (use-local-map arm-assembler-mode-map)
- (setq local-abbrev-table arm-assembler-abbrev-table)
- (setq major-mode 'arm-assembler-mode)
- (setq mode-name "ARM assembler")
-
- ;; Set up syntax table.
- (set-syntax-table arm-assembler-mode-syntax-table)
- (modify-syntax-entry ?; ; Nasty hack
- "<" arm-assembler-mode-syntax-table)
- (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
- (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
- (modify-syntax-entry ?' "\"'" arm-assembler-mode-syntax-table)
-
- (make-local-variable 'comment-start)
- (setq comment-start ";")
- (make-local-variable 'comment-end)
- (setq comment-end "")
- (make-local-variable 'comment-column)
- (setq comment-column 48)
- (make-local-variable 'comment-start-skip)
- (setq comment-start-skip ";+[ \t]*")
-
- ;; Play with indentation.
- (make-local-variable 'indent-line-function)
- (setq indent-line-function 'indent-relative-maybe)
-
- ;; Set fill prefix.
- (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
-
- ;; Fiddle with fontification.
- (make-local-variable 'font-lock-keywords)
- (setq font-lock-keywords
- (list
-
- ;; Handle numbers too.
- ;;
- ;; The following isn't quite right, but it's close enough.
- (list (concat "\\("
- "&[0-9a-fA-F]+\\|"
- "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
- "\\)")
- '(0 mdw-number-face))
-
- ;; Do something about operators.
- (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
- '(1 font-lock-keyword-face)
- '(2 font-lock-string-face))
- (list ":[a-zA-Z]+:"
- '(0 font-lock-keyword-face))
-
- ;; Do menemonics and directives.
- (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
- '(1 font-lock-keyword-face))
-
- ;; And anything else is punctuation.
- (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))
-
- (mdw-post-config-mode-hack))
- (run-hooks 'arm-assembler-mode-hook))
+ '(0 mdw-punct-face))))))
;;;--------------------------------------------------------------------------
;;; Assembler mode.
(defun mdw-fontify-asm ()
(modify-syntax-entry ?' "\"")
(modify-syntax-entry ?. "w")
+ (modify-syntax-entry ?\n ">")
(setf fill-prefix nil)
+ (modify-syntax-entry ?. "_")
+ (modify-syntax-entry ?* ". 23")
+ (modify-syntax-entry ?/ ". 124b")
+ (modify-syntax-entry ?\n "> b")
+ (local-set-key ";" 'self-insert-command)
(mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
+(defun mdw-asm-set-comment ()
+ (modify-syntax-entry ?; "."
+ )
+ (modify-syntax-entry asm-comment-char "< b")
+ (setq comment-start (string asm-comment-char ? )))
+(add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
+(put 'asm-comment-char 'safe-local-variable 'characterp)
+
;;;--------------------------------------------------------------------------
;;; TCL configuration.
"\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
'(0 mdw-number-face))
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face))))
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face)))))
+
+;;;--------------------------------------------------------------------------
+;;; Dylan programming configuration.
+
+(defun mdw-fontify-dylan ()
+
+ (make-local-variable 'font-lock-keywords)
+
+ ;; Horrors. `dylan-mode' sets the `major-mode' name after calling this
+ ;; hook, which undoes all of our configuration.
+ (setq major-mode 'dylan-mode)
+ (font-lock-set-defaults)
+
+ (let* ((word "[-_a-zA-Z!*@<>$%]+")
+ (dylan-keywords (mdw-regexps
+
+ "C-address" "C-callable-wrapper" "C-function"
+ "C-mapped-subtype" "C-pointer-type" "C-struct"
+ "C-subtype" "C-union" "C-variable"
+
+ "above" "abstract" "afterwards" "all"
+ "begin" "below" "block" "by"
+ "case" "class" "cleanup" "constant" "create"
+ "define" "domain"
+ "else" "elseif" "end" "exception" "export"
+ "finally" "for" "from" "function"
+ "generic"
+ "handler"
+ "if" "in" "instance" "interface" "iterate"
+ "keyed-by"
+ "let" "library" "local"
+ "macro" "method" "module"
+ "otherwise"
+ "profiling"
+ "select" "slot" "subclass"
+ "table" "then" "to"
+ "unless" "until" "use"
+ "variable" "virtual"
+ "when" "while"))
+ (sharp-keywords (mdw-regexps
+ "all-keys" "key" "next" "rest" "include"
+ "t" "f")))
+ (setq font-lock-keywords
+ (list (list (concat "\\<\\(" dylan-keywords
+ "\\|" "with\\(out\\)?-" word
+ "\\)\\>")
+ '(0 font-lock-keyword-face))
+ (list (concat "\\<" word ":" "\\|"
+ "#\\(" sharp-keywords "\\)\\>")
+ '(0 font-lock-variable-name-face))
+ (list (concat "\\("
+ "\\([-+]\\|\\<\\)[0-9]+" "\\("
+ "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
+ "\\|" "/[0-9]+"
+ "\\)"
+ "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
+ "\\|" "#b[01]+"
+ "\\|" "#o[0-7]+"
+ "\\|" "#x[0-9a-zA-Z]+"
+ "\\)\\>")
+ '(0 mdw-number-face))
+ (list (concat "\\("
+ "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
+ "\\_<[-+*/=<>:&|]+\\_>"
+ "\\)")
+ '(0 mdw-punct-face))))))
+
+;;;--------------------------------------------------------------------------
+;;; Algol 68 configuration.
+
+(setq a68-indent-step 2)
+
+(defun mdw-fontify-algol-68 ()
+
+ ;; Fix up the syntax table.
+ (modify-syntax-entry ?# "!" a68-mode-syntax-table)
+ (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
+ (modify-syntax-entry ch "." a68-mode-syntax-table))
+
+ (make-local-variable 'font-lock-keywords)
+
+ (let ((not-comment
+ (let ((word "COMMENT"))
+ (do ((regexp (concat "[^" (substring word 0 1) "]+")
+ (concat regexp "\\|"
+ (substring word 0 i)
+ "[^" (substring word i (1+ i)) "]"))
+ (i 1 (1+ i)))
+ ((>= i (length word)) regexp)))))
+ (setq font-lock-keywords
+ (list (list (concat "\\<COMMENT\\>"
+ "\\(" not-comment "\\)\\{0,5\\}"
+ "\\(\\'\\|\\<COMMENT\\>\\)")
+ '(0 font-lock-comment-face))
+ (list (concat "\\<CO\\>"
+ "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
+ "\\($\\|\\<CO\\>\\)")
+ '(0 font-lock-comment-face))
+ (list "\\<[A-Z_]+\\>"
+ '(0 font-lock-keyword-face))
+ (list (concat "\\<"
+ "[0-9]+"
+ "\\(\\.[0-9]+\\)?"
+ "\\([eE][-+]?[0-9]+\\)?"
+ "\\>")
+ '(0 mdw-number-face))
+ (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
+ '(0 mdw-punct-face))))))
;;;--------------------------------------------------------------------------
;;; REXX configuration.
;; And everything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face))))))
;;;--------------------------------------------------------------------------
;;; Standard ML programming style.
;; And anything else is punctuation.
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face))))))
;;;--------------------------------------------------------------------------
;;; Haskell configuration.
(defun mdw-fontify-haskell ()
;; Fiddle with syntax table to get comments right.
- (modify-syntax-entry ?' "\"")
- (modify-syntax-entry ?- ". 123")
- (modify-syntax-entry ?{ ". 1b")
- (modify-syntax-entry ?} ". 4b")
+ (modify-syntax-entry ?' "_")
+ (modify-syntax-entry ?- ". 12")
(modify-syntax-entry ?\n ">")
+ ;; Make punctuation be punctuation
+ (let ((punct "=<>+-*/|&%!@?$.^:#`"))
+ (do ((i 0 (1+ i)))
+ ((>= i (length punct)))
+ (modify-syntax-entry (aref punct i) ".")))
+
;; Set fill prefix.
(mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
;; Fiddle with fontification.
(make-local-variable 'font-lock-keywords)
(let ((haskell-keywords
- (mdw-regexps "as" "case" "ccall" "class" "data" "default"
- "deriving" "do" "else" "foreign" "hiding" "if"
- "import" "in" "infix" "infixl" "infixr" "instance"
- "let" "module" "newtype" "of" "qualified" "safe"
- "stdcall" "then" "type" "unsafe" "where")))
+ (mdw-regexps "as"
+ "case" "ccall" "class"
+ "data" "default" "deriving" "do"
+ "else" "exists"
+ "forall" "foreign"
+ "hiding"
+ "if" "import" "in" "infix" "infixl" "infixr" "instance"
+ "let"
+ "mdo" "module"
+ "newtype"
+ "of"
+ "proc"
+ "qualified"
+ "rec"
+ "safe" "stdcall"
+ "then" "type"
+ "unsafe"
+ "where"))
+ (control-sequences
+ (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
+ "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
+ "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
+ "SP" "STX" "SUB" "SYN" "US" "VT")))
(setq font-lock-keywords
(list
- (list "--.*$"
+ (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
+ "\\(-+}\\|-*\\'\\)"
+ "\\|"
+ "--.*$")
'(0 font-lock-comment-face))
- (list (concat "\\<\\(" haskell-keywords "\\)\\>")
+ (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
'(0 font-lock-keyword-face))
- (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
- "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
+ (list (concat "'\\("
+ "[^\\]"
+ "\\|"
+ "\\\\"
+ "\\(" "[abfnrtv\\\"']" "\\|"
+ "^" "\\(" control-sequences "\\|"
+ "[]A-Z@[\\^_]" "\\)" "\\|"
+ "\\|"
+ "[0-9]+" "\\|"
+ "[oO][0-7]+" "\\|"
+ "[xX][0-9A-Fa-f]+"
+ "\\)"
+ "\\)'")
+ '(0 font-lock-string-face))
+ (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
+ '(0 font-lock-variable-name-face))
+ (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
+ "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
"\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
'(0 mdw-number-face))
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face))))))
;;;--------------------------------------------------------------------------
;;; Erlang configuration.
(list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
'(0 mdw-number-face))
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face)))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face))))))
;;;--------------------------------------------------------------------------
;;; Texinfo configuration.
;; Fontify TeX special characters as punctuation.
(list "[{}]+"
- '(0 mdw-punct-face))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face)))))
;;;--------------------------------------------------------------------------
;;; TeX and LaTeX configuration.
(modify-syntax-entry ?$ "." font-lock-syntax-table)
(local-set-key [?$] 'self-insert-command)
+ ;; Make `tab' be useful, given that tab stops in TeX don't work well.
+ (local-set-key "\C-\M-i" 'indent-relative)
+ (setq indent-tabs-mode nil)
+
;; Set fill prefix.
(mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
;; Fontify TeX special characters as punctuation.
(list "[$^_{}#&]"
- '(0 mdw-punct-face))))
-
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face)))))
+
+(setq TeX-install-font-lock 'tex-font-setup)
+
+(eval-after-load 'font-latex
+ '(defun font-latex-jit-lock-force-redisplay (buf start end)
+ "Compatibility for Emacsen not offering `jit-lock-force-redisplay'."
+ ;; The following block is an expansion of `jit-lock-force-redisplay'
+ ;; and involved macros taken from CVS Emacs on 2007-04-28.
+ (with-current-buffer buf
+ (let ((modified (buffer-modified-p)))
+ (unwind-protect
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ buffer-file-name
+ buffer-file-truename)
+ (put-text-property start end 'fontified t))
+ (unless modified
+ (restore-buffer-modified-p nil)))))))
+
+(setq LaTeX-syntactic-comments nil
+ LaTeX-fill-break-at-separators '(\\\[))
;;;--------------------------------------------------------------------------
;;; SGML hacking.
(or (booleanp value)
(every (lambda (v) (memq v '(?\" ?')))
(if (listp value) value (list value)))))
-(put 'mdw-conf-quote-normal 'safe-local-variable '
- mdw-conf-quote-normal-acceptable-value-p)
+(put 'mdw-conf-quote-normal 'safe-local-variable
+ 'mdw-conf-quote-normal-acceptable-value-p)
(defun mdw-fix-up-quote ()
"Apply the setting of `mdw-conf-quote-normal'."
(if (listp flag) flag (list flag)))
(set-syntax-table table)
(and font-lock-mode (font-lock-fontify-buffer)))))))
-(defun mdw-fix-up-quote-hack ()
- "Unpleasant hack to call `mdw-fix-up-quote' at the right time.
-Annoyingly, `hack-local-variables' is done after `set-auto-mode'
-so we wouldn't see a local-variable setting of
-`mdw-conf-quote-normal' in `conf-mode-hook'. Instead, wire
-ourselves onto `hack-local-variables-hook' here, and check the
-setting once it's actually been made."
- (add-hook 'hack-local-variables-hook 'mdw-fix-up-quote t t))
-(add-hook 'conf-mode-hook 'mdw-fix-up-quote-hack t)
+(add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t)
;;;--------------------------------------------------------------------------
;;; Shell scripts.
(let ((executable-set-magic #'(lambda (s &rest r) s)))
(sh-set-shell shell-name)))
+ ;; Don't insert here-document scaffolding automatically.
+ (local-set-key "<" 'self-insert-command)
+
;; Now enable my keys and the fontification.
(mdw-misc-mode-config)
(mdw-define-face eshell-ls-readonly (t nil))
(mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
+(defun mdw-eshell-hack () (setenv "LD_PRELOAD" nil))
+(add-hook 'eshell-mode-hook 'mdw-eshell-hack)
+
;;;--------------------------------------------------------------------------
;;; Messages-file mode.
"\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
'(0 mdw-number-face))
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face))))
- (mdw-post-config-mode-hack))
+ '(0 mdw-punct-face)))))
;; Lispy languages.
;; Not much fontification needed.
(make-local-variable 'font-lock-keywords)
(setq font-lock-keywords
- (list
- (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
- '(0 mdw-punct-face))))
-
- (mdw-post-config-mode-hack))
+ (list (list (concat "\\("
+ "\\_<[-+]?"
+ "\\(" "[0-9]+/[0-9]+"
+ "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
+ "\\.[0-9]+" "\\)"
+ "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
+ "\\)"
+ "\\|"
+ "#"
+ "\\(" "x" "[-+]?"
+ "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
+ "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
+ "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
+ "\\|" "[0-9]+" "r" "[-+]?"
+ "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
+ "\\)"
+ "\\)\\_>")
+ '(0 mdw-number-face))
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face)))))
(defun comint-send-and-indent ()
(interactive)
(and mdw-auto-indent
(indent-for-tab-command)))
+(defadvice comint-line-beginning-position
+ (around mdw-calculate-it-properly () activate compile)
+ "Calculate the actual line start for multi-line input."
+ (if (or comint-use-prompt-regexp
+ (eq (field-at-pos (point)) 'output))
+ ad-do-it
+ (setq ad-return-value
+ (constrain-to-field (line-beginning-position) (point)))))
+
(defun mdw-setup-m4 ()
+
+ ;; Inexplicably, Emacs doesn't match braces in m4 mode. This is very
+ ;; annoying: fix it.
+ (modify-syntax-entry ?{ "(")
+ (modify-syntax-entry ?} ")")
+
+ ;; Fill prefix.
(mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
;;;--------------------------------------------------------------------------
"\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
(auto-fill-mode 1))
+(eval-after-load "flyspell"
+ '(define-key flyspell-mode-map "\C-\M-i" nil))
+
;;;--------------------------------------------------------------------------
;;; Outline and hide/show modes.
(ad-set-arg 2 (car program))
(ad-set-arg 4 (cdr program))))))
+(defadvice term-exec-1 (around hack-environment compile activate)
+ "Hack the environment inherited by inferiors in the terminal."
+ (let ((process-environment process-environment))
+ (setenv "LD_PRELOAD" nil)
+ ad-do-it))
+
+(defadvice shell (around hack-environment compile activate)
+ "Hack the environment inherited by inferiors in the shell."
+ (let ((process-environment process-environment))
+ (setenv "LD_PRELOAD" nil)
+ ad-do-it))
+
(defun ssh (host)
"Open a terminal containing an ssh session to the HOST."
(interactive "sHost: ")
(ansi-term (list "ssh" host) (format "ssh@%s" host)))
+(defvar git-grep-command
+ "env GIT_PAGER=cat git grep --no-color -nH -e "
+ "*The default command for \\[git-grep].")
+
+(defvar git-grep-history nil)
+
+(defun git-grep (command-args)
+ "Run `git grep' with user-specified args and collect output in a buffer."
+ (interactive
+ (list (read-shell-command "Run git grep (like this): "
+ git-grep-command 'git-grep-history)))
+ (let ((grep-use-null-device nil))
+ (grep command-args)))
+
+;;;--------------------------------------------------------------------------
+;;; Magit configuration.
+
+(setq magit-diff-refine-hunk 'all
+ magit-view-git-manual-method 'man
+ magit-log-margin '(nil age magit-log-margin-width t 18)
+ magit-wip-after-save-local-mode-lighter ""
+ magit-wip-after-apply-mode-lighter ""
+ magit-wip-before-change-mode-lighter "")
+(eval-after-load "magit"
+ '(progn (global-magit-file-mode 1)
+ (magit-wip-after-save-mode 1)
+ (magit-wip-after-apply-mode 1)
+ (magit-wip-before-change-mode 1)
+ (add-to-list 'magit-no-confirm 'safe-with-wip)
+ (add-to-list 'magit-no-confirm 'trash)
+ (push '(:eval (if (or magit-wip-after-save-local-mode
+ magit-wip-after-apply-mode
+ magit-wip-before-change-mode)
+ (format " wip:%s%s%s"
+ (if magit-wip-after-apply-mode "A" "")
+ (if magit-wip-before-change-mode "C" "")
+ (if magit-wip-after-save-local-mode "S" ""))))
+ minor-mode-alist)
+ (dolist (popup '(magit-diff-popup
+ magit-diff-refresh-popup
+ magit-diff-mode-refresh-popup
+ magit-revision-mode-refresh-popup))
+ (magit-define-popup-switch popup ?R "Reverse diff" "-R"))))
+
+(defadvice magit-wip-commit-buffer-file
+ (around mdw-just-this-buffer activate compile)
+ (let ((magit-save-repository-buffers nil)) ad-do-it))
+
+(defadvice magit-discard
+ (around mdw-delete-if-prefix-argument activate compile)
+ (let ((magit-delete-by-moving-to-trash
+ (and (null current-prefix-arg)
+ magit-delete-by-moving-to-trash)))
+ ad-do-it))
+
+(setq magit-repolist-columns
+ '(("Name" 16 magit-repolist-column-ident nil)
+ ("Version" 18 magit-repolist-column-version nil)
+ ("St" 2 magit-repolist-column-dirty nil)
+ ("L<U" 3 mdw-repolist-column-unpulled-from-upstream nil)
+ ("L>U" 3 mdw-repolist-column-unpushed-to-upstream nil)
+ ("Path" 32 magit-repolist-column-path nil)))
+
+(setq magit-repository-directories '(("~/etc/profile" . 0)
+ ("~/src/" . 1)))
+
+(defadvice magit-list-repos (around mdw-dirname () activate compile)
+ "Make sure the returned names are directory names.
+Otherwise child processes get started in the wrong directory and
+there is sadness."
+ (setq ad-return-value (mapcar #'file-name-as-directory ad-do-it)))
+
+(defun mdw-repolist-column-unpulled-from-upstream (_id)
+ "Insert number of upstream commits not in the current branch."
+ (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
+ (and upstream
+ (let ((n (cadr (magit-rev-diff-count "HEAD" upstream))))
+ (propertize (number-to-string n) 'face
+ (if (> n 0) 'bold 'shadow))))))
+
+(defun mdw-repolist-column-unpushed-to-upstream (_id)
+ "Insert number of commits in the current branch but not its upstream."
+ (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
+ (and upstream
+ (let ((n (car (magit-rev-diff-count "HEAD" upstream))))
+ (propertize (number-to-string n) 'face
+ (if (> n 0) 'bold 'shadow))))))
+
+(defun mdw-try-smerge ()
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "^<<<<<<< " nil t)
+ (smerge-mode 1))))
+(add-hook 'find-file-hook 'mdw-try-smerge t)
+
+;;;--------------------------------------------------------------------------
+;;; GUD, and especially GDB.
+
+;; Inhibit window dedication. I mean, seriously, wtf?
+(defadvice gdb-display-buffer (after mdw-undedicated (buf) compile activate)
+ "Don't make windows dedicated. Seriously."
+ (set-window-dedicated-p ad-return-value nil))
+(defadvice gdb-set-window-buffer
+ (after mdw-undedicated (name &optional ignore-dedicated window)
+ compile activate)
+ "Don't make windows dedicated. Seriously."
+ (set-window-dedicated-p (or window (selected-window)) nil))
+
+;;;--------------------------------------------------------------------------
+;;; MPC configuration.
+
+(eval-when-compile (trap (require 'mpc)))
+
+(setq mpc-browser-tags '(Artist|Composer|Performer Album|Playlist))
+
+(defun mdw-mpc-now-playing ()
+ (interactive)
+ (require 'mpc)
+ (save-excursion
+ (set-buffer (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong"))))
+ (mpc--status-callback))
+ (let ((state (cdr (assq 'state mpc-status))))
+ (cond ((member state '("stop"))
+ (message "mpd stopped."))
+ ((member state '("play" "pause"))
+ (let* ((artist (cdr (assq 'Artist mpc-status)))
+ (album (cdr (assq 'Album mpc-status)))
+ (title (cdr (assq 'Title mpc-status)))
+ (file (cdr (assq 'file mpc-status)))
+ (duration-string (cdr (assq 'Time mpc-status)))
+ (time-string (cdr (assq 'time mpc-status)))
+ (time (and time-string
+ (string-to-number
+ (if (string-match ":" time-string)
+ (substring time-string
+ 0 (match-beginning 0))
+ (time-string)))))
+ (duration (and duration-string
+ (string-to-number duration-string)))
+ (pos (and time duration
+ (format " [%d:%02d/%d:%02d]"
+ (/ time 60) (mod time 60)
+ (/ duration 60) (mod duration 60))))
+ (fmt (cond ((and artist title)
+ (format "`%s' by %s%s" title artist
+ (if album (format ", from `%s'" album)
+ "")))
+ (file
+ (format "`%s' (no tags)" file))
+ (t
+ "(no idea what's playing!)"))))
+ (if (string= state "play")
+ (message "mpd playing %s%s" fmt (or pos ""))
+ (message "mpd paused in %s%s" fmt (or pos "")))))
+ (t
+ (message "mpd in unknown state `%s'" state)))))
+
+(defmacro mdw-define-mpc-wrapper (func bvl interactive &rest body)
+ `(defun ,func ,bvl
+ (interactive ,@interactive)
+ (require 'mpc)
+ ,@body
+ (mdw-mpc-now-playing)))
+
+(mdw-define-mpc-wrapper mdw-mpc-play-or-pause () nil
+ (if (member (cdr (assq 'state (mpc-cmd-status))) '("play"))
+ (mpc-pause)
+ (mpc-play)))
+
+(mdw-define-mpc-wrapper mdw-mpc-next () nil (mpc-next))
+(mdw-define-mpc-wrapper mdw-mpc-prev () nil (mpc-prev))
+(mdw-define-mpc-wrapper mdw-mpc-stop () nil (mpc-stop))
+
+(defun mdw-mpc-louder (step)
+ (interactive (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ +10)))
+ (mpc-proc-cmd (format "volume %+d" step)))
+
+(defun mdw-mpc-quieter (step)
+ (interactive (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ +10)))
+ (mpc-proc-cmd (format "volume %+d" (- step))))
+
+(defun mdw-mpc-hack-lines (arg interactivep func)
+ (if (and interactivep (use-region-p))
+ (let ((from (region-beginning)) (to (region-end)))
+ (goto-char from)
+ (beginning-of-line)
+ (funcall func)
+ (forward-line)
+ (while (< (point) to)
+ (funcall func)
+ (forward-line)))
+ (let ((n (prefix-numeric-value arg)))
+ (cond ((minusp n)
+ (unless (bolp)
+ (beginning-of-line)
+ (funcall func)
+ (incf n))
+ (while (minusp n)
+ (forward-line -1)
+ (funcall func)
+ (incf n)))
+ (t
+ (beginning-of-line)
+ (while (plusp n)
+ (funcall func)
+ (forward-line)
+ (decf n)))))))
+
+(defun mdw-mpc-select-one ()
+ (when (and (get-char-property (point) 'mpc-file)
+ (not (get-char-property (point) 'mpc-select)))
+ (mpc-select-toggle)))
+
+(defun mdw-mpc-unselect-one ()
+ (when (get-char-property (point) 'mpc-select)
+ (mpc-select-toggle)))
+
+(defun mdw-mpc-select (&optional arg interactivep)
+ (interactive (list current-prefix-arg t))
+ (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
+
+(defun mdw-mpc-unselect (&optional arg interactivep)
+ (interactive (list current-prefix-arg t))
+ (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-unselect-one))
+
+(defun mdw-mpc-unselect-backwards (arg)
+ (interactive "p")
+ (mdw-mpc-hack-lines (- arg) t 'mdw-mpc-unselect-one))
+
+(defun mdw-mpc-unselect-all ()
+ (interactive)
+ (setq mpc-select nil)
+ (mpc-selection-refresh))
+
+(defun mdw-mpc-next-line (arg)
+ (interactive "p")
+ (beginning-of-line)
+ (forward-line arg))
+
+(defun mdw-mpc-previous-line (arg)
+ (interactive "p")
+ (beginning-of-line)
+ (forward-line (- arg)))
+
+(defun mdw-mpc-playlist-add (&optional arg interactivep)
+ (interactive (list current-prefix-arg t))
+ (let ((mpc-select mpc-select))
+ (when (or arg (and interactivep (use-region-p)))
+ (setq mpc-select nil)
+ (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
+ (setq mpc-select (reverse mpc-select))
+ (mpc-playlist-add)))
+
+(defun mdw-mpc-playlist-delete (&optional arg interactivep)
+ (interactive (list current-prefix-arg t))
+ (setq mpc-select (nreverse mpc-select))
+ (mpc-select-save
+ (when (or arg (and interactivep (use-region-p)))
+ (setq mpc-select nil)
+ (mpc-selection-refresh)
+ (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
+ (mpc-playlist-delete)))
+
+(defun mdw-mpc-hack-tagbrowsers ()
+ (setq-local mode-line-format
+ '("%e"
+ mode-line-frame-identification
+ mode-line-buffer-identification)))
+(add-hook 'mpc-tagbrowser-mode-hook 'mdw-mpc-hack-tagbrowsers)
+
+(defun mdw-mpc-hack-songs ()
+ (setq-local header-line-format
+ ;; '("MPC " mpc-volume " " mpc-current-song)
+ (list (propertize " " 'display '(space :align-to 0))
+ ;; 'mpc-songs-format-description
+ '(:eval
+ (let ((deactivate-mark) (hscroll (window-hscroll)))
+ (with-temp-buffer
+ (mpc-format mpc-songs-format 'self hscroll)
+ ;; That would be simpler than the hscroll handling in
+ ;; mpc-format, but currently move-to-column does not
+ ;; recognize :space display properties.
+ ;; (move-to-column hscroll)
+ ;; (delete-region (point-min) (point))
+ (buffer-string)))))))
+(add-hook 'mpc-songs-mode-hook 'mdw-mpc-hack-songs)
+
+(eval-after-load "mpc"
+ '(progn
+ (define-key mpc-mode-map "m" 'mdw-mpc-select)
+ (define-key mpc-mode-map "u" 'mdw-mpc-unselect)
+ (define-key mpc-mode-map "\177" 'mdw-mpc-unselect-backwards)
+ (define-key mpc-mode-map "\e\177" 'mdw-mpc-unselect-all)
+ (define-key mpc-mode-map "n" 'mdw-mpc-next-line)
+ (define-key mpc-mode-map "p" 'mdw-mpc-previous-line)
+ (define-key mpc-mode-map "/" 'mpc-songs-search)
+ (setq mpc-songs-mode-map (make-sparse-keymap))
+ (set-keymap-parent mpc-songs-mode-map mpc-mode-map)
+ (define-key mpc-songs-mode-map "l" 'mpc-playlist)
+ (define-key mpc-songs-mode-map "+" 'mdw-mpc-playlist-add)
+ (define-key mpc-songs-mode-map "-" 'mdw-mpc-playlist-delete)
+ (define-key mpc-songs-mode-map "\r" 'mpc-songs-jump-to)))
+
;;;--------------------------------------------------------------------------
;;; Inferior Emacs Lisp.
~mdw / profile / blobdiff