From c996768f3e4bced81b26981a5813a516774cdb70 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Mon, 29 Apr 2024 10:00:47 +0100 Subject: [PATCH] dot/emacs, el/dot-emacs.el: Switch to using the `cl-lib' package. I can't say I'm thrilled about having to remember which functions I have to stick `cl-...' on the front of now, but it will shut up some deprecation warnings. There are probably lurking runtime problems where I've failed to notice that a function (or, worse, a macro) needs to be renamed. --- dot/emacs | 20 ++++---- el/dot-emacs.el | 152 +++++++++++++++++++++++++++++++------------------------- 2 files changed, 94 insertions(+), 78 deletions(-) diff --git a/dot/emacs b/dot/emacs index da7d116..b78c03c 100644 --- a/dot/emacs +++ b/dot/emacs @@ -33,7 +33,7 @@ (if (file-exists-p boot) (load boot)))) -(require 'cl) +(require 'cl-lib) (require 'dot-emacs) (unless (mdw-emacs-version-p 25) @@ -520,8 +520,8 @@ ("application/x-pdf" "\\.pdf\\'" ("xdg-open" file) nil)))) (dolist (e entries) (setq w3m-content-type-alist - (cons e (remove* (car e) w3m-content-type-alist - :key #'car :test #'string=)))))) + (cons e (cl-remove (car e) w3m-content-type-alist + :key #'car :test #'string=)))))) (setq w3-do-incremental-display t w3-use-menus '(file edit view go bookmark options @@ -813,10 +813,10 @@ (eval-after-load "hippie-exp" '(setq hippie-expand-try-functions-list - (remove-if (lambda (name) - (memq name '(try-expand-list - try-expand-list-all-buffers))) - hippie-expand-try-functions-list))) + (cl-remove-if (lambda (name) + (memq name '(try-expand-list + try-expand-list-all-buffers))) + hippie-expand-try-functions-list))) (autoload 'dired-jump "dired-x") (autoload 'dired-jump-other-window "dired-x") @@ -909,9 +909,9 @@ (setq completion-ignored-extensions (append `(".hc" ".hi") completion-ignored-extensions)) -(dolist (dir (remove-if-not (lambda (ext) - (= (aref ext (- (length ext) 1)) ?/)) - completion-ignored-extensions)) +(dolist (dir (cl-remove-if-not (lambda (ext) + (= (aref ext (- (length ext) 1)) ?/)) + completion-ignored-extensions)) (if (/= (aref dir 0) ?/) (setq completion-ignored-extensions (cons (concat "/" dir) diff --git a/el/dot-emacs.el b/el/dot-emacs.el index cd648c1..a574f71 100644 --- a/el/dot-emacs.el +++ b/el/dot-emacs.el @@ -56,13 +56,13 @@ This may be at the expense of cool features.") (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." @@ -105,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" "") @@ -215,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) @@ -352,7 +353,7 @@ prevailing configuration." (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) @@ -496,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 @@ -909,14 +910,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))) @@ -926,13 +927,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)) @@ -1074,12 +1075,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 @@ -1413,7 +1414,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 @@ -1484,12 +1485,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)) @@ -1609,7 +1610,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 @@ -1631,8 +1632,8 @@ case." (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 @@ -1779,11 +1780,11 @@ 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) @@ -1858,6 +1859,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)) @@ -1924,6 +1928,15 @@ doesn't match any of the regular expressions in (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 @@ -2313,11 +2326,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)))) @@ -2390,7 +2403,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))) @@ -2407,7 +2420,7 @@ indentation anyway." (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)))) @@ -2418,7 +2431,7 @@ indentation anyway." (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 @@ -2487,11 +2500,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) @@ -3035,7 +3049,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) "."))) @@ -4088,11 +4102,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 "\\" @@ -4258,6 +4272,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 () @@ -4268,7 +4284,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) "."))) @@ -4629,8 +4645,8 @@ that character only to be normal punctuation." (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'." @@ -5064,11 +5080,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 @@ -5096,13 +5112,13 @@ align the other subforms beneath it. Otherwise, indent them (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. @@ -5619,21 +5635,21 @@ rather than baking the list into the function." (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) -- 2.11.0