X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/d54399beacf881e56f4a95f3fc9eb62ffa36cbb4..5223adaa187d2231f03f59a44473b93192bc6968:/el/dot-emacs.el diff --git a/el/dot-emacs.el b/el/dot-emacs.el index a11a898..f0d41c3 100644 --- a/el/dot-emacs.el +++ b/el/dot-emacs.el @@ -24,6 +24,10 @@ ;;;-------------------------------------------------------------------------- ;;; Check command-line. +(defgroup mdw nil + "Customization for mdw's Emacs configuration." + :prefix "mdw-") + (defun mdw-check-command-line-switch (switch) (let ((probe nil) (next command-line-args) (found nil)) (while next @@ -51,15 +55,14 @@ This may be at the expense of cool features.") ;;; Some general utilities. (eval-when-compile - (unless (fboundp 'make-regexp) - (load "make-regexp")) - (require 'cl)) + (unless (fboundp 'make-regexp) (load "make-regexp")) + (require 'cl-lib)) (defmacro mdw-regexps (&rest list) "Turn a LIST of strings into a single regular expression at compile-time." (declare (indent nil) (debug 0)) - `',(make-regexp list)) + `',(make-regexp (sort (cl-copy-list list) #'string<))) (defun mdw-wrong () "This is not the key sequence you're looking for." @@ -72,20 +75,28 @@ This may be at the expense of cool features.") (and (= emacs-major-version major) (>= emacs-minor-version (or minor 0))))) +(defun mdw-submode-p (mode parent) + "Return non-nil if MODE is indirectly derived from PARENT." + (let ((answer nil)) + (while (cond ((eq mode parent) (setq answer t) nil) + (t (setq mode (get mode 'derived-mode-parent))))) + answer)) + ;; Some error trapping. ;; ;; If individual bits of this file go tits-up, we don't particularly want ;; the whole lot to stop right there and then, because it's bloody annoying. -(defmacro trap (&rest forms) - "Execute FORMS without allowing errors to propagate outside." - (declare (indent 0) - (debug t)) - `(condition-case err - ,(if (cdr forms) (cons 'progn forms) (car forms)) - (error (message "Error (trapped): %s in %s" - (error-message-string err) - ',forms)))) +(eval-and-compile + (defmacro trap (&rest forms) + "Execute FORMS without allowing errors to propagate outside." + (declare (indent 0) + (debug t)) + `(condition-case err + ,(if (cdr forms) (cons 'progn forms) (car forms)) + (error (message "Error (trapped): %s in %s" + (error-message-string err) + ',forms))))) ;; Configuration reading. @@ -94,10 +105,10 @@ This may be at the expense of cool features.") "Read the configuration variable named SYM." (unless mdw-config (setq mdw-config - (flet ((replace (what with) - (goto-char (point-min)) - (while (re-search-forward what nil t) - (replace-match with t)))) + (cl-flet ((replace (what with) + (goto-char (point-min)) + (while (re-search-forward what nil t) + (replace-match with t)))) (with-temp-buffer (insert-file-contents "~/.mdw.conf") (replace "^[ \t]*\\(#.*\\)?\n" "") @@ -113,12 +124,14 @@ This may be at the expense of cool features.") ;; Width configuration. -(defvar mdw-column-width +(defcustom 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) + "Width of Emacs columns." + :type 'integer) +(defcustom mdw-text-width mdw-column-width + "Expected width of text within columns." + :type 'integer + :safe 'integerp) ;; Local variables hacking. @@ -202,8 +215,9 @@ cruft." (let ((tot 0)) (dolist (what '(scroll-bar fringe)) (dolist (side '(left right)) - (incf tot (funcall (intern (concat (symbol-name what) "-columns")) - side)))) + (cl-incf tot + (funcall (intern (concat (symbol-name what) "-columns")) + side)))) tot))) (defun mdw-split-window-horizontally (&optional width) @@ -240,6 +254,18 @@ fringes is not taken out of the allowance for WIDTH, unlike (other-window 1)) (select-window win))) +(defun mdw-frame-width-quantized-p (frame-width column-width) + "Return whether the FRAME-WIDTH was chosen specifically for COLUMN-WIDTH." + (let ((sb-width (mdw-horizontal-window-overhead))) + (zerop (mod (+ frame-width sb-width) + (+ column-width sb-width))))) + +(defun mdw-frame-width-for-columns (columns width) + "Return the preferred width for a frame with so many COLUMNS of WIDTH." + (let ((sb-width (mdw-horizontal-window-overhead))) + (- (* columns (+ width sb-width)) + sb-width))) + (defun mdw-set-frame-width (columns &optional width) "Set the current frame to be the correct width for COLUMNS columns. @@ -249,26 +275,26 @@ can be set interactively with a prefix argument.)" 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))) + (set-frame-width (selected-frame) + (mdw-frame-width-for-columns columns width)) + (mdw-divvy-window width)) -(defvar mdw-frame-width-fudge +(defcustom mdw-frame-width-fudge (cond ((<= emacs-major-version 20) 1) ((= emacs-major-version 26) 3) (t 0)) "The number of extra columns to add to the desired frame width. -This is sadly necessary because Emacs 26 is broken in this regard.") +This is sadly necessary because Emacs 26 is broken in this regard." + :type 'integer) -(defvar mdw-frame-colour-alist +(defcustom mdw-frame-colour-alist '((black . ("#000000" . "#ffffff")) (red . ("#2a0000" . "#ffffff")) (green . ("#002a00" . "#ffffff")) (blue . ("#00002a" . "#ffffff"))) - "*Alist mapping symbol names to (FOREGROUND . BACKGROUND) colour pairs.") + "Alist mapping symbol names to (FOREGROUND . BACKGROUND) colour pairs." + :type '(alist :key-type symbol :value-type (cons color color))) (defun mdw-set-frame-colour (colour &optional frame) (interactive "xColour name or (FOREGROUND . BACKGROUND) pair: @@ -280,10 +306,72 @@ This is sadly necessary because Emacs 26 is broken in this regard.") (set-frame-parameter frame 'background-color (car colour)) (set-frame-parameter frame 'foreground-color (cdr colour))) +;; Window configuration switching. + +(defvar mdw-current-window-configuration nil + "The current window configuration register name, or `nil'.") + +(defun mdw-switch-window-configuration (register &optional no-save) + "Switch make REGISTER be the new current window configuration. +If a current window configuration register is established, and +NO-SAVE is nil, then save the current window configuration to +that register first. + +Signal an error if the new register contains something other than +a window configuration. If the register is unset then save the +current window configuration to it immediately. + +With one or three C-u, or an odd numeric prefix argument, set +NO-SAVE, so the previous window configuration register is left +unchanged. + +With two or three C-u, or a prefix argument which is an odd +multiple of 2, just clear the record of the current window +configuration register, so that the next switch doesn't save the +prevailing configuration." + (interactive + (let ((arg current-prefix-arg)) + (list (if (or (and (consp arg) (= (car arg) 16) (= (car arg) 64)) + (and (integerp arg) (not (zerop (logand arg 2))))) + nil + (register-read-with-preview "Switch to window configuration: ")) + (or (and (consp arg) (= (car arg) 4) (= (car arg) 64)) + (and (integerp arg) (not (zerop (logand arg 1)))))))) + + (let ((previous mdw-current-window-configuration) + (current-windows (list (current-window-configuration) + (point-marker))) + (register-value (and register (get-register register)))) + (when (and mdw-current-window-configuration (not no-save)) + (set-register mdw-current-window-configuration current-windows)) + (cond ((null register) + (setq mdw-current-window-configuration nil) + (if previous + (message "Left window configuration `%c'." previous) + (message "Nothing to do!"))) + ((not (or (null register-value) + (and (consp register-value) + (window-configuration-p (car register-value)) + (integer-or-marker-p (cadr register-value)) + (null (cl-caddr register-value))))) + (error "Register `%c' is not a window configuration" register)) + (t + (cond ((null register-value) + (set-register register current-windows) + (message "Started new window configuration `%c'." + register)) + (t + (set-window-configuration (car register-value)) + (goto-char (cadr register-value)) + (message "Switched to window configuration `%c'." + register))) + (setq mdw-current-window-configuration register))))) + ;; 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.") +(defcustom mdw-inhibit-raise-frame nil + "Whether `raise-frame' should do nothing when the frame is mapped." + :type 'boolean) (defadvice raise-frame (around mdw-inhibit (&optional frame) activate compile) @@ -359,6 +447,9 @@ it's currently off." ;; Functions for sexp diary entries. +(defvar mdw-diary-for-org-mode-p nil + "Display diary along with the agenda?") + (defun mdw-not-org-mode (form) "As FORM, but not in Org mode agenda." (and (not mdw-diary-for-org-mode-p) @@ -406,8 +497,8 @@ as output rather than a string." (if (eq (cdr ddate) 'st-tibs-day) (format "St Tib's Day %s" tail) (let ((season (cadr ddate)) - (daynum (caddr ddate)) - (dayname (cadddr ddate))) + (daynum (cl-caddr ddate)) + (dayname (cl-cadddr ddate))) (format "%s, the %d%s day of %s %s" dayname daynum @@ -438,13 +529,13 @@ as output rather than a string." (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)) -(defvar diary-time-regexp nil) +(defcustom diary-time-regexp nil + "Regexp matching times in the diary buffer." + :type 'regexp) (defadvice diary-add-to-list (before mdw-trim-leading-space compile activate) "Trim leading space from the diary entry string." @@ -488,7 +579,7 @@ as output rather than a string." ;; Fighting with Org-mode's evil key maps. -(defvar mdw-evil-keymap-keys +(defcustom mdw-evil-keymap-keys '(([S-up] . [?\C-c up]) ([S-down] . [?\C-c down]) ([S-left] . [?\C-c left]) @@ -499,7 +590,9 @@ as output rather than a string." (([M-right] [?\e right]) . [C-right])) "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'. The value is an alist mapping evil keys (as a list, or singleton) -to good keys (in the same form).") +to good keys (in the same form)." + :type '(alist :key-type (choice key-sequence (repeat key-sequence)) + :value-type key-sequence)) (defun mdw-clobber-evil-keymap (keymap) "Replace evil key bindings in the KEYMAP. @@ -523,7 +616,7 @@ Evil key bindings are defined in `mdw-evil-keymap-keys'." (dolist (key replacements) (define-key keymap key binding)))))) -(defvar mdw-org-latex-defs +(defcustom mdw-org-latex-defs '(("strayman" "\\documentclass{strayman} \\usepackage[utf8]{inputenc} @@ -533,7 +626,24 @@ Evil key bindings are defined in `mdw-evil-keymap-keys'." ("\\subsection{%s}" . "\\subsection*{%s}") ("\\subsubsection{%s}" . "\\subsubsection*{%s}") ("\\paragraph{%s}" . "\\paragraph*{%s}") - ("\\subparagraph{%s}" . "\\subparagraph*{%s}")))) + ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))) + "Additional LaTeX class definitions." + :type '(alist :key-type string + :value-type (list string + (alist :inline t + :key-type string + :value-type string)))) + +(setq org-emphasis-regexp-components + '("- \t('\"{}" ; prematch + "- \t.,:!?;'\")}\\[" ; postmatch + " \t\r\n" ; /forbidden/ as border + "." ; body regexp + 1)) ; maximum newlines + +(setq org-entities-user + ;; NAME LATEX MATHP HTML ASCII LATIN1 UTF8 + '(("relax" "" nil "" "" "" ""))) (eval-after-load "org-latex" '(setq org-export-latex-classes @@ -558,7 +668,6 @@ Evil key bindings are defined in `mdw-evil-keymap-keys'." ("" "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 @@ -572,6 +681,55 @@ Evil key bindings are defined in `mdw-evil-keymap-keys'." ;; Some hacks to do with window placement. +(defvar mdw-designated-window nil + "The window chosen by `mdw-designate-window', or nil.") + +(defun mdw-designated-window-display-buffer-function (buffer not-this-window) + "Display buffer function to use the designated window." + (unless mdw-designated-window (error "No designated window!")) + (prog1 mdw-designated-window + (with-selected-window mdw-designated-window (switch-to-buffer buffer)) + (setq mdw-designated-window nil + display-buffer-function nil))) + +(defun mdw-display-buffer-in-designated-window (buffer alist) + "Display function to use the designated window." + (prog1 mdw-designated-window + (when mdw-designated-window + (with-selected-window mdw-designated-window + (switch-to-buffer buffer nil t))) + (setq mdw-designated-window nil))) + +(defun mdw-designate-window (cancel) + "Use the selected window for the next pop-up buffer. +With a prefix argument, clear the designated window." + (interactive "P") + (let ((window (selected-window))) + (cond (cancel + (cond (mdw-designated-window + (setq mdw-designated-window nil) + (unless (mdw-emacs-version-p 24) + (setq display-buffer-function nil)) + (message "Window designation cleared.")) + (t + (message "No designated window active.")))) + ((window-dedicated-p window) + (error "Window is dedicated to its buffer.")) + (t + (setq mdw-designated-window window) + (unless (mdw-emacs-version-p 24) + (setq display-buffer-function + #'mdw-designated-window-display-buffer-function)) + (message "Window designated."))))) + +(when (mdw-emacs-version-p 24) + (setq display-buffer-base-action + (let* ((action display-buffer-base-action) + (funcs (car action)) + (alist (cdr action))) + (cons (cons 'mdw-display-buffer-in-designated-window funcs) + alist)))) + (defun mdw-clobber-other-windows-showing-buffer (buffer-or-name) "Arrange that no windows on other frames are showing BUFFER-OR-NAME." (interactive "bBuffer: ") @@ -611,7 +769,117 @@ Pretend they don't exist. They might be on other display devices." (ad-set-arg 2 nil)) (setq even-window-sizes nil - even-window-heights nil) + even-window-heights nil + display-buffer-reuse-frames nil) + +(defvar mdw-fallback-window-alist nil + "Alist mapping frames to fallback windows.") + +(defun mdw-cleanup-fallback-window-alist () + "Remove entries for dead frames and windows from the fallback alist." + (let ((prev nil) + (cursor mdw-fallback-window-alist)) + (while cursor + (let* ((assoc (car cursor)) + (tail (cdr cursor))) + (cond ((and (frame-live-p (car assoc)) + (window-live-p (cdr assoc))) + (setq prev cursor)) + ((null prev) + (setq mdw-fallback-window-alist tail)) + (t + (setcdr prev tail))) + (setq cursor tail))))) + +(defun mdw-set-fallback-window (cancel) + "Prefer the selected window for pop-up buffers in this frame. +With a prefix argument, clear the fallback window." + (interactive "P") + (let* ((frame (selected-frame)) (window (selected-window)) + (assoc (assq (selected-frame) mdw-fallback-window-alist))) + (cond (cancel + (cond (assoc + (setcdr assoc nil) + (message "Fallback window cleared.")) + (t + (message "No fallback window active in this frame.")))) + ((window-dedicated-p window) + (error "Window is dedicated to its buffer.")) + (t + (if assoc (setcdr assoc window) + (push (cons frame window) mdw-fallback-window-alist)) + (message "Fallback window set."))) + (mdw-cleanup-fallback-window-alist))) + +(defun mdw-last-window-in-frame-p (window) + "Return whether WINDOW is the last in its frame." + (catch 'done + (while window + (let ((next (window-next-sibling window))) + (while (and next (window-minibuffer-p next)) + (setq next (window-next-sibling next))) + (if next (throw 'done nil))) + (setq window (window-parent window))) + t)) + +(defun mdw-display-buffer-in-tolerable-window (buffer alist) + "Try finding a tolerable window in which to display BUFFER. +Begone, foul DWIMmerlaik! + +This is all totally subject to arbitrary change in the future, but the +emphasis is on predictability rather than crazy DWIMmery." + (let* ((selected (selected-window)) chosen + (fallback (assq (selected-frame) mdw-fallback-window-alist)) + (full-height-p (window-full-height-p selected)) + (full-width-p (window-full-width-p selected))) + (cond + + ((and fallback (window-live-p (cdr fallback))) + ;; There's a fallback window set for this frame. Use it. + + (setq chosen (cdr fallback) + selected nil) + (display-buffer-record-window 'window chosen buffer)) + + ((and full-height-p full-width-p) + ;; We're basically the only window in the frame. If we want to get + ;; anywhere, we'll have to split the window. + + (let ((width (window-width selected)) + (preferred-width (mdw-preferred-column-width))) + (if (and (>= width (mdw-frame-width-for-columns 2 preferred-width)) + (mdw-frame-width-quantized-p width preferred-width)) + (setq chosen (split-window-right preferred-width)) + (setq chosen (split-window-below))) + (display-buffer-record-window 'window chosen buffer))) + + ((mdw-last-window-in-frame-p selected) + ;; This is the last window in the frame. I don't think I want to + ;; clobber the first window, so rebound and clobber the previous one + ;; instead. (This obviously has the same effect if there are only two + ;; windows, but seems more useful if there are three.) + + (setq chosen (previous-window selected 'never nil)) + (display-buffer-record-window 'reuse chosen buffer)) + + (t + ;; There's another window in front of us. Let's use that one. + (setq chosen (next-window selected 'never nil))) + (display-buffer-record-window 'reuse chosen buffer)) + + (if (eq chosen selected) + (error "Failed to select a different window!")) + + (when chosen + (with-selected-window chosen (switch-to-buffer buffer))) + chosen)) + +;; Hack the display actions so that they do something sensible. +(setq display-buffer-fallback-action + '((display-buffer--maybe-same-window + display-buffer-reuse-window + display-buffer-pop-up-window + mdw-display-buffer-in-tolerable-window))) ;; Rename buffers along with files. @@ -691,14 +959,14 @@ to force interactive compilation." (interactive (let* ((prefix (prefix-numeric-value current-prefix-arg)) (command (eval compile-command)) - (dir (and (plusp (logand prefix #x54)) + (dir (and (cl-plusp (logand prefix #x54)) (read-directory-name "Compile in directory: ")))) (list (if (or compilation-read-command - (plusp (logand prefix #x42))) + (cl-plusp (logand prefix #x42))) (compilation-read-command command) command) dir - (plusp (logand prefix #x58))))) + (cl-plusp (logand prefix #x58))))) (let ((default-directory (or directory default-directory))) (compile command comint))) @@ -708,13 +976,13 @@ to force interactive compilation." (catch 'found (let* ((src-dir (file-name-as-directory (expand-file-name "."))) (dir src-dir)) - (loop + (cl-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 + (cl-loop (when (file-exists-p (concat sub build-file)) (throw 'found sub)) (when (string= sub dir) (throw 'give-up nil)) @@ -826,10 +1094,13 @@ so that it can be used for convenient filtering." ;; AUTHINFO GENERIC kludge. -(defvar nntp-authinfo-generic nil +(defcustom nntp-authinfo-generic nil "Set to the `NNTPAUTH' string to pass on to `authinfo-kludge'. -Use this to arrange for per-server settings.") +Use this to arrange for per-server settings." + :type '(choice (const :tag "Use `NNTPAUTH' environment variable" nil) + string) + :safe 'stringp) (defun nntp-open-authinfo-kludge (buffer) "Open a connection to SERVER using `authinfo-kludge'." @@ -853,12 +1124,12 @@ Use this to arrange for per-server settings.") (defun mdw-nnimap-transform-headers () (goto-char (point-min)) (let (article lines size string) - (block nil + (cl-block nil (while (not (eobp)) (while (not (looking-at "\\* [0-9]+ FETCH")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) - (return))) + (cl-return))) (goto-char (match-end 0)) ;; Unfold quoted {number} strings. (while (re-search-forward @@ -924,8 +1195,8 @@ Use this to arrange for per-server settings.") (defadvice gnus-other-frame (around mdw-hack-frame-width compile activate) "Always arrange for mail/news frames to be 80 columns wide." (let ((default-frame-alist (cons `(width . ,(+ 80 mdw-frame-width-fudge)) - (cl-delete 'width default-frame-alist - :key #'car)))) + (delete* 'width default-frame-alist + :key #'car)))) ad-do-it)) ;; Preferred programs. @@ -1018,8 +1289,10 @@ in REST." ;; Now actually do the thing. (call-process "uuencode" file t nil name)) -(defvar np-file "~/.np" - "*Where the `now-playing' file is.") +(defcustom np-file "~/.np" + "Where the `now-playing' file is." + :type 'file + :safe 'stringp) (defun np (&optional arg) "Grabs a `now-playing' string." @@ -1071,21 +1344,6 @@ tramp, which seems to get itself into a twist." (let ((auto-revert-check-vc-info t)) (auto-revert-buffers))) -(defun comint-send-and-indent () - (interactive) - (comint-send-input) - (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))))) - ;;;-------------------------------------------------------------------------- ;;; Dired hacking. @@ -1150,14 +1408,16 @@ If NEW-SESSION-P, start a new session." (eval-after-load 'w3m '(define-key w3m-mode-map [?\e ?\r] 'w3m-view-this-url-new-session)) -(defvar mdw-good-url-browsers - '(browse-url-mozilla +(defcustom mdw-good-url-browsers + '(browse-url-firefox + browse-url-mozilla browse-url-generic (w3m . mdw-w3m-browse-url) 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).") +A symbol FOO stands for (FOO . FOO)." + :type '(repeat (choice function (cons function function)))) (defun mdw-good-url-browser () "Return a good URL browser. @@ -1204,7 +1464,7 @@ CHECK is fboundp, and returning the correponding FUNC." "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s") ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml"))) (add-to-list 'w3m-search-engine-alist - (list (cadr item) (caddr item) nil)) + (list (cadr item) (cl-caddr item) nil)) (add-to-list 'w3m-uri-replace-alist (list (concat "\\`" (car item) ":") 'w3m-search-uri-replace @@ -1215,8 +1475,8 @@ CHECK is fboundp, and returning the correponding FUNC." ;; Useful variables. -(defvar mdw-fill-prefix nil - "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'. +(defcustom mdw-fill-prefix nil + "Used by `mdw-line-prefix' and `mdw-fill-paragraph'. If there's no fill prefix currently set (by the `fill-prefix' variable) and there's a match from one of the regexps here, it gets used to set the fill-prefix for the current operation. @@ -1246,13 +1506,14 @@ as modified during matching.") (make-variable-buffer-local 'mdw-fill-prefix) -(defvar mdw-hanging-indents +(defcustom mdw-hanging-indents (concat "\\(\\(" "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)" "[ \t]+" "\\)?\\)") - "*Standard regexp matching parts of a hanging indent. -This is mainly useful in `auto-fill-mode'.") + "Standard regexp matching parts of a hanging indent. +This is mainly useful in `auto-fill-mode'." + :type 'regexp) ;; Utility functions. @@ -1274,12 +1535,12 @@ This is mainly useful in `auto-fill-mode'.") ((eq (car pat) 'if) (if (or (null (cdr pat)) (null (cddr pat)) - (null (cdddr pat)) - (cddddr pat)) + (null (cl-cdddr pat)) + (cl-cddddr pat)) (error "Invalid `if' pattern `%S'" pat)) (mdw-fill-prefix-match-p (if (eval (cadr pat)) - (caddr pat) - (cadddr pat)))) + (cl-caddr pat) + (cl-cadddr pat)))) ((eq (car pat) 'and) (let ((pats (cdr pat)) (ok t)) @@ -1399,7 +1660,7 @@ case." '(progn ;; Notice that the comment-delimiters should be in italics too. - (pushnew 'font-lock-comment-delimiter-face ps-italic-faces) + (cl-pushnew 'font-lock-comment-delimiter-face ps-italic-faces) ;; Select more suitable colours for the main kinds of tokens. The ;; colours set on the Emacs faces are chosen for use against a dark @@ -1460,8 +1721,10 @@ case." ;; Common mode settings. -(defvar mdw-auto-indent t - "Whether to indent automatically after a newline.") +(defcustom mdw-auto-indent t + "Whether to indent automatically after a newline." + :type 'boolean + :safe 'booleanp) (defun mdw-whitespace-mode (&optional arg) "Turn on/off whitespace mode, but don't highlight trailing space." @@ -1540,9 +1803,10 @@ case." ;; Backup file handling. -(defvar mdw-backup-disable-regexps nil - "*List of regular expressions: if a file name matches any of -these then the file is not backed up.") +(defcustom mdw-backup-disable-regexps nil + "List of regular expressions: if a file name matches any of +these then the file is not backed up." + :type '(repeat regexp)) (defun mdw-backup-enable-predicate (name) "[mdw]'s default backup predicate. @@ -1566,26 +1830,28 @@ doesn't match any of the regular expressions in (let ((frame-display (frame-parameter frame 'display))) (when (and frame-display (eq window-system 'x) - (not (some (lambda (fr) - (and (not (eq fr frame)) - (string= (frame-parameter fr 'display) - frame-display))) - (frame-list)))) + (not (cl-some (lambda (fr) + (and (not (eq fr frame)) + (string= (frame-parameter fr 'display) + frame-display))) + (frame-list)))) (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 +(defcustom mdw-full-screen-parameters '((menu-bar-lines . 0) - ;(vertical-scroll-bars . nil) + ;;(vertical-scroll-bars . nil) ) - "Frame parameters to set when making a frame fullscreen.") + "Frame parameters to set when making a frame fullscreen." + :type '(alist :key-type symbol)) -(defvar mdw-full-screen-save +(defcustom mdw-full-screen-save '(width height) - "Extra frame parameters to save when setting fullscreen.") + "Extra frame parameters to save when setting fullscreen." + :type '(repeat symbol)) (defun mdw-toggle-full-screen (&optional frame) "Show the FRAME fullscreen." @@ -1643,6 +1909,9 @@ doesn't match any of the regular expressions in (((min-colors 64)) :background "grey30") (((class color)) :background "blue") (t :inverse-video t)) +(mdw-define-face error + (((class color)) :background "red") + (t :inverse-video t)) (mdw-define-face match (((class color)) :background "blue") (t :inverse-video t)) @@ -1687,11 +1956,37 @@ doesn't match any of the regular expressions in (t :inverse-video t)) (mdw-define-face viper-search (t :inherit isearch)) +(mdw-define-face compilation-error + (((class color)) :foreground "red" :weight bold) + (t :weight bold)) +(mdw-define-face compilation-warning + (((class color)) :foreground "orange" :weight bold) + (t :weight bold)) +(mdw-define-face compilation-info + (((class color)) :foreground "green" :weight bold) + (t :weight bold)) +(mdw-define-face compilation-line-number + (t :weight bold)) +(mdw-define-face compilation-column-number + (((min-colors 64)) :foreground "lightgrey")) +(setq compilation-message-face 'mdw-virgin-face) +(setq compilation-enter-directory-face 'font-lock-comment-face) +(setq compilation-leave-directory-face 'font-lock-comment-face) + (mdw-define-face holiday-face (t :background "red")) (mdw-define-face calendar-today-face (t :foreground "yellow" :weight bold)) +(mdw-define-face flyspell-incorrect + (((type x)) :underline (:color "red" :style wave)) + (((class color)) :foreground "red" :underline t) + (t :underline t)) +(mdw-define-face flyspell-duplicate + (((type x)) :underline (:color "orange" :style wave)) + (((class color)) :foreground "orange" :underline t) + (t :underline t)) + (mdw-define-face comint-highlight-prompt (t :weight bold)) (mdw-define-face comint-highlight-input @@ -1737,18 +2032,18 @@ doesn't match any of the regular expressions in (t :weight bold)) (mdw-define-face font-lock-variable-name-face (t :slant italic)) -(mdw-define-face font-lock-comment-delimiter-face - (((min-colors 64)) :slant italic :foreground "SeaGreen1") - (((class color)) :foreground "green") - (t :weight bold)) (mdw-define-face font-lock-comment-face (((min-colors 64)) :slant italic :foreground "SeaGreen1") (((class color)) :foreground "green") (t :weight bold)) +(mdw-define-face font-lock-comment-delimiter-face + (t :inherit font-lock-comment-face)) (mdw-define-face font-lock-string-face (((min-colors 64)) :foreground "SkyBlue1") (((class color)) :foreground "cyan") (t :weight bold)) +(mdw-define-face font-lock-doc-face + (t :inherit font-lock-string-face)) (mdw-define-face message-separator (t :background "red" :foreground "white" :weight bold)) @@ -1921,6 +2216,10 @@ doesn't match any of the regular expressions in (mdw-define-face magit-hash (((min-colors 64)) :foreground "grey40") (((class color)) :foreground "blue")) +(mdw-define-face magit-popup-argument + (((min-colors 64)) :foreground "SeaGreen1") + (((class color)) :foreground "green") + (t :weight bold)) (mdw-define-face magit-diff-hunk-heading (((min-colors 64)) :foreground "grey70" :background "grey25") (((class color)) :foreground "yellow")) @@ -1956,8 +2255,16 @@ doesn't match any of the regular expressions in (((min-colors 64)) :background "NavyBlue") (((class color)) :background "blue")) +(mdw-define-face erc-my-nick-face + (t :foreground "yellow" :weight bold)) +(mdw-define-face erc-current-nick-face + (t :foreground "yellow" :weight bold)) (mdw-define-face erc-input-face - (t :foreground "red")) + (t :foreground "yellow")) +(mdw-define-face erc-action-face + ()) +(mdw-define-face erc-button + (t :foreground "cyan" :underline t :weight semi-bold)) (mdw-define-face woman-bold (t :weight bold)) @@ -2030,7 +2337,9 @@ doesn't match any of the regular expressions in (((class color)) :background "blue") (((type tty) (class mono)) :inverse-video t)) -(defvar mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar)) +(defcustom mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar) + "Bitmaps to display in the left and right fringes in the current line." + :type '(cons symbol symbol)) (defun mdw-configure-point-overlay () (let ((ov (make-overlay 0 0))) @@ -2079,11 +2388,11 @@ doesn't match any of the regular expressions in :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)) + (cl-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)))) @@ -2115,6 +2424,18 @@ doesn't match any of the regular expressions in (add-hook 'post-command-hook 'mdw-update-terminal-title) ;;;-------------------------------------------------------------------------- +;;; Ediff hacking. + +(defvar mdw-ediff-previous-windows) +(defun mdw-ediff-setup () + (setq mdw-ediff-previous-windows (current-window-configuration))) +(defun mdw-ediff-suspend-or-quit () + (set-window-configuration mdw-ediff-previous-windows)) +(add-hook 'ediff-before-setup-hook 'mdw-ediff-setup) +(add-hook 'ediff-quit-hook 'mdw-ediff-suspend-or-quit t) +(add-hook 'ediff-suspend-hook 'mdw-ediff-suspend-or-quit t) + +;;;-------------------------------------------------------------------------- ;;; C programming configuration. ;; Make C indentation nice. @@ -2144,7 +2465,7 @@ indentation anyway." (should-indent-p t)) (while (and context (eq (caar context) 'arglist-cont-nonempty)) - (when (and (= (caddr (pop context)) pos) + (when (and (= (cl-caddr (pop context)) pos) context (memq (caar context) '(arglist-intro arglist-cont-nonempty))) @@ -2158,7 +2479,10 @@ indentation anyway." (let ((output nil)) (dolist (item first) (let ((key (car item)) (value (cdr item))) - (if (string-suffix-p "-alist" (symbol-name key)) + (if (let* ((key-name (symbol-name key)) + (key-len (length key-name))) + (and (>= key-len 6) + (string= (substring key-name (- key-len 6)) "-alist"))) (push (cons key (mdw-merge-style-alists value (cdr (assoc key second)))) @@ -2200,6 +2524,10 @@ set." (c-class-key . "class") (c-backslash-column . 72) (c-label-minimum-indentation . 0) + (c-indent-comments-syntactically-p t) + (c-indent-comment-alist (end-block . (column . nil)) + (cpp-end-block . (column . nil)) + (other . (column . nil))) (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) @@ -2217,14 +2545,14 @@ set." (mdw-define-c-style mdw-trustonic-c (mdw-c) (c-basic-offset . 4) - (c-indent-comment-alist (anchored-comment . (column . 0)) - (end-block . (space . 1)) - (cpp-end-block . (space . 1)) - (other . (space . 1))) (c-offsets-alist (access-label . -2))) (mdw-define-c-style mdw-trustonic-alec-c (mdw-trustonic-c) (comment-column . 0) + (c-indent-comment-alist (anchored-comment . (column . 0)) + (end-block . (space . 1)) + (cpp-end-block . (space . 1)) + (other . (space . 1))) (c-offsets-alist (arglist-cont-nonempty . mdw-c-indent-arglist-nested))) (defun mdw-set-default-c-style (modes style) @@ -2238,11 +2566,12 @@ name, as a symbol." (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)))))))) + (cl-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) @@ -2786,7 +3115,7 @@ name, as a symbol." (defun mdw-fontify-fsharp () (let ((punct "=<>+-*/|&%!@?")) - (do ((i 0 (1+ i))) + (cl-do ((i 0 (1+ i))) ((>= i (length punct))) (modify-syntax-entry (aref punct i) "."))) @@ -3040,7 +3369,8 @@ name, as a symbol." ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face))))) + '(0 mdw-punct-face))) + font-lock-syntactic-face-function nil)) ;; Hack key bindings. (local-set-key [?{] 'mdw-self-insert-and-indent) @@ -3119,6 +3449,7 @@ name, as a symbol." (setq-default cperl-indent-level 2 cperl-continued-statement-offset 2 + cperl-indent-region-fix-constructs nil cperl-continued-brace-offset 0 cperl-brace-offset -2 cperl-brace-imaginary-offset 0 @@ -3133,6 +3464,7 @@ name, as a symbol." (modify-syntax-entry ?$ "\\" font-lock-syntax-table) (modify-syntax-entry ?: "." font-lock-syntax-table) (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") + (setq auto-fill-function #'do-auto-fill) ;; Now define fontification things. (make-local-variable 'font-lock-keywords) @@ -3199,11 +3531,12 @@ strip numbers instead." python-indent-offset 2 python-fill-docstring-style 'symmetric) -(defun mdw-fontify-pythonic (keywords) +(defun mdw-fontify-pythonic (keywords soft-keywords builtins) ;; Miscellaneous fiddling. (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") (setq indent-tabs-mode nil) + (set (make-local-variable 'forward-sexp-function) nil) ;; Now define fontification things. (make-local-variable 'font-lock-keywords) @@ -3213,6 +3546,12 @@ strip numbers instead." ;; Set up the keywords defined above. (list (concat "\\_<\\(" keywords "\\)\\_>") '(0 font-lock-keyword-face)) + (list (concat "\\(^\\|[^.]\\)\\_<\\(" soft-keywords "\\)\\_>") + '(2 font-lock-keyword-face)) + (list (concat "\\(^\\|[^.]\\)\\_<\\(" builtins "\\)\\_>") + '(2 font-lock-variable-name-face)) + (list (concat "\\_<\\(__\\(\\sw+\\|\\s_+\\)+__\\)\\_>") + '(0 font-lock-variable-name-face)) ;; At least numbers are simpler than C. (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO]?[0-7]+\\|[bB][01]+\\)\\|" @@ -3228,11 +3567,130 @@ strip numbers instead." (defun mdw-fontify-python () (mdw-fontify-pythonic - (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def" - "del" "elif" "else" "except" "exec" "finally" "for" - "from" "global" "if" "import" "in" "is" "lambda" - "not" "or" "pass" "print" "raise" "return" "try" - "while" "with" "yield"))) + (mdw-regexps "and" "as" "assert" "async" "await" + "break" + "class" "continue" + "def" "del" + "elif" "else" "except" ;"exec" + "finally" "for" "from" + "global" + "if" "import" "in" "is" + "lambda" + "nonlocal" + "not" + "or" + "pass" ;"print" + "raise" "return" + "try" ;"type" + "while" "with" + "yield") + + (mdw-regexps "case" + "match") + + (mdw-regexps "Ellipsis" + "False" + "None" "NotImplemented" + "True" + "__debug__" + + "BaseException" + "BaseExceptionGroup" + "Exception" + "StandardError" + "ArithmeticError" + "FloatingPointError" + "OverflowError" + "ZeroDivisionError" + "AssertionError" + "AttributeError" + "BufferError" + "EnvironmentError" + "IOError" + "OSError" + "BlockingIOError" + "ChildProcessError" + "ConnectionError" + "BrokenPipeError" + "ConnectionAbortedError" + "ConnectionRefusedError" + "ConnectionResetError" + "FileExistsError" + "FileNotFoundError" + "InterruptedError" + "IsADirectoryError" + "NotADirectoryError" + "PermissionError" + "TimeoutError" + "EOFError" + "ExceptionGroup" + "ImportError" + "ModuleNotFoundError" + "LookupError" + "IndexError" + "KeyError" + "MemoryError" + "NameError" + "UnboundLocalError" + "ReferenceError" + "RuntimeError" + "NotImplementedError" + "RecursionError" + "SyntaxError" + "IndentationError" + "TabError" + "SystemError" + "TypeError" + "ValueError" + "UnicodeError" + "UnicodeDecodeError" + "UnicodeEncodeError" + "UnicodeTranslateError" + "StopIteration" + "Warning" + "BytesWarning" + "DeprecationWarning" + "EncodingWarning" + "FutureWarning" + "ImportWarning" + "PendingDeprecationWarning" + "ResourceWarning" + "RuntimeWarning" + "SyntaxWarning" + "UnicodeWarning" + "UserWarning" + "GeneratorExit" + "KeyboardInterrupt" + "SystemExit" + + "abs" "absolute_import" "aiter" + "all" "anext" "any" "apply" "ascii" + "basestring" "bin" "bool" "breakpoint" + "buffer" "bytearray" "bytes" + "callable" "coerce" "chr" "classmethod" + "cmp" "compile" "complex" + "delattr" "dict" "dir" "divmod" + "enumerate" "eval" "exec" "execfile" + "file" "filter" "float" "format" "frozenset" + "getattr" "globals" + "hasattr" "hash" "help" "hex" + "id" "input" "int" "intern" + "isinstance" "issubclass" "iter" + "len" "list" "locals" "long" + "map" "max" "memoryview" "min" + "next" + "object" "oct" "open" "ord" + "pow" "print" "property" + "range" "raw_input" "reduce" "reload" + "repr" "reversed" "round" + "set" "setattr" "slice" "sorted" + "staticmethod" "str" "sum" "super" + "tuple" "type" + "unichr" "unicode" + "vars" + "xrange" + "zip" + "__import__"))) (defun mdw-fontify-pyrex () (mdw-fontify-pythonic @@ -3241,7 +3699,9 @@ strip numbers instead." "extern" "finally" "for" "from" "global" "if" "import" "in" "is" "lambda" "not" "or" "pass" "print" "property" "raise" "return" "struct" "try" "while" "with" - "yield"))) + "yield") + "" + "")) (define-derived-mode pyrex-mode python-mode "Pyrex" "Major mode for editing Pyrex source code") @@ -3709,11 +4169,11 @@ strip numbers instead." (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))) + (cl-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 "\\" @@ -3879,6 +4339,8 @@ strip numbers instead." ;;; Haskell configuration. (setq-default haskell-indent-offset 2) +(setq haskell-doc-prettify-types nil + haskell-interactive-popup-errors nil) (defun mdw-fontify-haskell () @@ -3889,7 +4351,7 @@ strip numbers instead." ;; Make punctuation be punctuation (let ((punct "=<>+-*/|&%!@?$.^:#`")) - (do ((i 0 (1+ i))) + (cl-do ((i 0 (1+ i))) ((>= i (length punct))) (modify-syntax-entry (aref punct i) "."))) @@ -4209,7 +4671,7 @@ strip numbers instead." ;;;-------------------------------------------------------------------------- ;;; HTML, CSS, and other web foolishness. -(setq-default css-indent-offset 2) +(setq-default css-indent-offset 8) ;;;-------------------------------------------------------------------------- ;;; SGML hacking. @@ -4237,21 +4699,21 @@ strip numbers instead." ;;;-------------------------------------------------------------------------- ;;; Configuration files. -(defvar mdw-conf-quote-normal nil - "*Control syntax category of quote characters `\"' and `''. +(defcustom mdw-conf-quote-normal nil + "Control syntax category of quote characters `\"' and `''. If this is `t', consider quote characters to be normal punctuation, as for `conf-quote-normal'. If this is `nil' then leave quote characters as quotes. If this is a list, then consider the quote characters in the list to be normal punctuation. If this is a single quote character, then consider -that character only to be normal punctuation.") +that character only to be normal punctuation." + :type '(choice boolean character (repeat character)) + :safe 'mdw-conf-quote-normal-acceptable-value-p) (defun mdw-conf-quote-normal-acceptable-value-p (value) "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?" (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) + (cl-every (lambda (v) (memq v '(?\" ?'))) + (if (listp value) value (list value))))) (defun mdw-fix-up-quote () "Apply the setting of `mdw-conf-quote-normal'." @@ -4627,8 +5089,13 @@ that character only to be normal punctuation.") ;; Special indentation. -(defvar mdw-lisp-loop-default-indent 2) -(defvar mdw-lisp-setf-value-indent 2) +(defcustom mdw-lisp-loop-default-indent 2 + "Default indent for simple `loop' body." + :type 'integer + :safe 'integerp) +(defcustom mdw-lisp-setf-value-indent 2 + "Default extra indent for `setf' values." + :type 'integer :safe 'integerp) (setq lisp-simple-loop-indentation 0 lisp-loop-keyword-indentation 0 @@ -4680,11 +5147,11 @@ by `mdw-lisp-setf-value-indent' spaces." (while (< (point) start) (condition-case nil (forward-sexp 1) (scan-error (throw 'done nil))) - (incf count)) + (cl-incf count)) (1- count))))))) (and basic-indent offset (list (+ basic-indent - (if (oddp offset) 0 + (if (cl-oddp offset) 0 mdw-lisp-setf-value-indent)) basic-indent))))) (progn @@ -4713,12 +5180,12 @@ align the other subforms beneath it. Otherwise, indent them (save-excursion (goto-char (elt state 1)) (cl-incf loop-indentation - (cond ((eq (char-before) ?,) -1) - ((and (eq (char-before) ?@) - (progn (backward-char) - (eq (char-before) ?,))) - -2) - (t 0))))) + (cond ((eq (char-before) ?,) -1) + ((and (eq (char-before) ?@) + (progn (backward-char) + (eq (char-before) ?,))) + -2) + (t 0))))) ;; If the first loop item is on the same line as the `loop' itself then ;; use that as the baseline. Otherwise advance by the default indent. @@ -4758,18 +5225,21 @@ align the other subforms beneath it. Otherwise, indent them ;; SLIME setup. -(defvar mdw-friendly-name "[mdw]" - "How I want to be addressed.") +(defcustom mdw-friendly-name "[mdw]" + "How I want to be addressed." + :type 'string + :safe 'stringp) (defadvice slime-user-first-name (around mdw-use-friendly-name compile activate) (if mdw-friendly-name (setq ad-return-value mdw-friendly-name) ad-do-it)) -(trap - (if (not mdw-fast-startup) - (progn - (require 'slime-autoloads) - (slime-setup '(slime-autodoc slime-c-p-c))))) +(eval-and-compile + (trap + (if (not mdw-fast-startup) + (progn + (require 'slime-autoloads) + (slime-setup '(slime-autodoc slime-c-p-c)))))) (let ((stuff '((cmucl ("cmucl")) (sbcl ("sbcl") :coding-system utf-8-unix) @@ -4852,6 +5322,11 @@ align the other subforms beneath it. Otherwise, indent them (progn (add-hook 'makefile-mode-hook 'mdw-misc-mode-config t)) +;; nroff/troff. + +(progn + (add-hook 'nroff-mode-hook 'mdw-misc-mode-config t)) + ;;;-------------------------------------------------------------------------- ;;; Text mode. @@ -4901,6 +5376,21 @@ align the other subforms beneath it. Otherwise, indent them (auto-fill-mode -1) (setq tab-width 8)) +(defun comint-send-and-indent () + (interactive) + (comint-send-input) + (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 term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C")) (defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D")) (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_")) @@ -4944,9 +5434,10 @@ This allows you to pass a list of arguments through `ansi-term'." (interactive "sHost: ") (ansi-term (list "ssh" host) (format "ssh@%s" host))) -(defvar git-grep-command +(defcustom git-grep-command "env GIT_PAGER=cat git grep --no-color -nH -e " - "*The default command for \\[git-grep].") + "The default command for \\[git-grep]." + :type 'string) (defvar git-grep-history nil) @@ -4986,7 +5477,9 @@ This allows you to pass a list of arguments through `ansi-term'." magit-diff-refresh-popup magit-diff-mode-refresh-popup magit-revision-mode-refresh-popup)) - (magit-define-popup-switch popup ?R "Reverse diff" "-R")))) + (magit-define-popup-switch popup ?R "Reverse diff" "-R")) + (magit-define-popup-switch 'magit-rebase-popup ?r + "Rebase merges" "--rebase-merges"))) (defadvice magit-wip-commit-buffer-file (around mdw-just-this-buffer activate compile) @@ -5039,6 +5532,35 @@ there is sadness." (smerge-mode 1)))) (add-hook 'find-file-hook 'mdw-try-smerge t) +(defcustom mdw-magit-new-window-modes + '(magit-diff-mode + magit-log-mode + magit-process-mode + magit-revision-mode + magit-stash-mode + magit-status-mode) + "Magit modes which should cause a new window to be used." + :type '(repeat symbol)) + +(defun mdw-display-magit-buffer (buffer) + "Like `magit-display-buffer-traditional'. +But uses `mdw-magit-new-window-modes' for its list of modes +rather than baking the list into the function." + (display-buffer buffer + (let ((mode (with-current-buffer buffer major-mode))) + (if (and (not mdw-designated-window) + (derived-mode-p 'magit-mode) + (mdw-submode-p mode 'magit-mode) + (not (memq mode mdw-magit-new-window-modes))) + '(display-buffer-same-window . nil) + nil)))) +(setq magit-display-buffer-function 'mdw-display-magit-buffer) + +(defun mdw-display-magit-file-buffer (buffer) + "Show a file buffer from a diff." + (select-window (display-buffer buffer))) +(setq magit-display-file-buffer-function 'mdw-display-magit-file-buffer) + ;;;-------------------------------------------------------------------------- ;;; GUD, and especially GDB. @@ -5052,6 +5574,20 @@ there is sadness." "Don't make windows dedicated. Seriously." (set-window-dedicated-p (or window (selected-window)) nil)) +(defadvice gud-find-expr + (around mdw-inhibit-read-only (&rest args) compile activate) + "Inhibit errors caused by my setting of `comint-prompt-read-only'." + (let ((inhibit-read-only t)) ad-do-it)) + +;;;-------------------------------------------------------------------------- +;;; SQL stuff. + +(setq sql-postgres-options '("-n" "-P" "pager=off") + sql-postgres-login-params + '((user :default "mdw") + (database :default "mdw") + (server :default "db.distorted.org.uk"))) + ;;;-------------------------------------------------------------------------- ;;; Man pages. @@ -5176,21 +5712,21 @@ there is sadness." (funcall func) (forward-line))) (let ((n (prefix-numeric-value arg))) - (cond ((minusp n) + (cond ((cl-minusp n) (unless (bolp) (beginning-of-line) (funcall func) - (incf n)) - (while (minusp n) + (cl-incf n)) + (while (cl-minusp n) (forward-line -1) (funcall func) - (incf n))) + (cl-incf n))) (t (beginning-of-line) - (while (plusp n) + (while (cl-plusp n) (funcall func) (forward-line) - (decf n))))))) + (cl-decf n))))))) (defun mdw-mpc-select-one () (when (and (get-char-property (point) 'mpc-file)