dot/emacs, el/dot-emacs.el: Switch to using the `cl-lib' package.
authorMark Wooding <mdw@distorted.org.uk>
Mon, 29 Apr 2024 09:00:47 +0000 (10:00 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Mon, 29 Apr 2024 09:04:03 +0000 (10:04 +0100)
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
el/dot-emacs.el

index da7d116..b78c03c 100644 (file)
--- 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)
                    ("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
 
 (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")
 
 (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)
index cd648c1..a574f71 100644 (file)
@@ -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 "\\<COMMENT\\>"
@@ -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)