(eval-when-compile
(unless (fboundp 'make-regexp) (load "make-regexp"))
- (require 'cl))
+ (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 (sort (copy-list list) #'string<)))
+ `',(make-regexp (sort (cl-copy-list list) #'string<)))
(defun mdw-wrong ()
"This is not the key sequence you're looking for."
"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" "")
(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)
(and (consp register-value)
(window-configuration-p (car register-value))
(integer-or-marker-p (cadr register-value))
- (null (caddr register-value)))))
+ (null (cl-caddr register-value)))))
(error "Register `%c' is not a window configuration" register))
(t
(cond ((null register-value)
(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
(interactive "P")
(let ((window (selected-window)))
(cond (cancel
- (setq mdw-designated-window nil)
- (unless (mdw-emacs-version-p 24)
- (setq display-buffer-function nil))
- (message "Window designation cleared."))
+ (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
(ad-set-arg 2 nil))
(setq even-window-sizes nil
- even-window-heights nil)
-
-(setq display-buffer-reuse-frames 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."
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.
(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)))
(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))
(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
"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
((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))
'(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
(line-height . 10.55)
(space-width . 5.1)
(avg-char-width . 5.1)))
- (remove* 'CourierCondensed ps-font-info-database
- :key #'car)))))
+ (cl-remove 'CourierCondensed ps-font-info-database
+ :key #'car)))))
;; Arrange to strip overlays from the buffer before we print . This will
;; prevent `flyspell' from interfering with the printout. (It would be less
(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)
(((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))
(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
: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))))
(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)))
(if (let* ((key-name (symbol-name key))
(key-len (length key-name)))
(and (>= key-len 6)
- (string= (subseq key-name (- key-len 6)) "-alist")))
+ (string= (substring key-name (- key-len 6)) "-alist")))
(push (cons key
(mdw-merge-style-alists value
(cdr (assoc key second))))
(push item output)))
(nreverse output)))
-(defmacro* mdw-define-c-style (name (&optional parent) &rest assocs)
+(cl-defmacro mdw-define-c-style (name (&optional parent) &rest assocs)
"Define a C style, called NAME (a symbol) based on PARENT, 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
(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)
(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) ".")))
(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 "\\<COMMENT\\>"
;;; Haskell configuration.
(setq-default haskell-indent-offset 2)
+(setq haskell-doc-prettify-types nil
+ haskell-interactive-popup-errors nil)
(defun mdw-fontify-haskell ()
;; 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) ".")))
(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)))))
+ (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'."
(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
(eq lisp-indent-backquote-substitution-mode 'corrected))
(save-excursion
(goto-char (elt state 1))
- (incf loop-indentation
- (cond ((eq (char-before) ?,) -1)
- ((and (eq (char-before) ?@)
- (progn (backward-char)
- (eq (char-before) ?,)))
- -2)
- (t 0)))))
+ (cl-incf loop-indentation
+ (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.
(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.
"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.
(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)