Refactor hyperbole set functions - patch piece 3

ChangeLog

@@ -1,3 +1,11 @@
+2023-01-07  Mats Lidell  <matsl@gnu.org>
+
+* Part three of patch from Stefan monnier. Thank you Stefan.
+  Contains:
+  - Replace use of functions from set.el with standard functions from
+    cl-lib.
+  - Use #' short hand
+
 2022-12-18  Mats Lidell  <matsl@gnu.org>
 
 * Makefile (ELC_COMPILE, ELC_KOTL): Use function to derive elc files.

hact.el

@@ -1,9 +1,9 @@
-;;; hact.el --- GNU Hyperbole button action handling  -*- lexical-binding: t; -let*-
+;;; hact.el --- GNU Hyperbole button action handling  -*- lexical-binding: t; -*-
 ;;
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    18-Sep-91 at 02:57:09
-;; Last-Mod:      7-Oct-22 at 23:01:56 by Mats Lidell
+;; Last-Mod:      7-Jan-23 at 23:58:55 by Mats Lidell
 ;;
 ;; Copyright (C) 1991-2022  Free Software Foundation, Inc.
 ;; See the "HY-COPY" file for license information.
@@ -158,12 +158,11 @@ If no SYMBOLS are given, set it to the empty set.  Return the symset.  Uses
 
 (defun    symset:add (elt symbol property)
   "Add ELT to SYMBOL's PROPERTY set.
-Return nil iff ELT is already in SET; otherwise, return PROPERTY's value.
+Return PROPERTY's value.
 Use `eq' for comparison."
   (let* ((set (get symbol property))
-	 (set:equal-op 'eq)
-	 (new-set (set:add elt set)))
-    (and new-set (put symbol property new-set))))
+	 (new-set (if (memq elt set) set (cons elt set))))
+    (put symbol property new-set)))
 
 (defun    symset:clear (symbol)
   "Set SYMBOL's symset to nil."
@@ -178,9 +177,8 @@ Use `eq' for comparison."
 (defun    symset:remove (elt symbol property)
   "Remove ELT from SYMBOL's PROPERTY set and return the new set.
 Assume PROPERTY is a valid set.  Use `eq' for comparison."
-  (let ((set (get symbol property))
-	(set:equal-op 'eq))
-    (put symbol property (set:remove elt set))))
+  (let ((set (get symbol property)))
+    (put symbol property (delq elt set))))
 
 ;;; ========================================================================
 ;;; htype class - Hyperbole Types, e.g. action and implicit button types

hsys-org.el

@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     2-Jul-16 at 14:54:14
-;; Last-Mod:      3-Dec-22 at 02:33:37 by Bob Weiner
+;; Last-Mod:      7-Jan-23 at 23:59:42 by Mats Lidell
 ;;
 ;; Copyright (C) 2016-2021  Free Software Foundation, Inc.
 ;; See the "HY-COPY" file for license information.
@@ -29,6 +29,7 @@
 ;;; ************************************************************************
 
 (eval-when-compile (require 'hmouse-drv))
+(require 'cl-lib)
 (require 'hbut)
 (require 'org)
 (require 'org-element)
@@ -39,10 +40,12 @@
 (defun hsys-org-meta-return-shared-p ()
   "Return non-nil if hyperbole-mode is active and shares the org-meta-return key."
   (let ((org-meta-return-keys (where-is-internal #'org-meta-return org-mode-map)))
-    (when (or (set:intersection org-meta-return-keys
-				(where-is-internal #'hkey-either hyperbole-mode-map))
-	      (set:intersection org-meta-return-keys
-				(where-is-internal #'action-key hyperbole-mode-map)))
+    (when (or (cl-intersection org-meta-return-keys
+			       (where-is-internal #'hkey-either hyperbole-mode-map)
+			       :test #'equal)
+	      (cl-intersection org-meta-return-keys
+			       (where-is-internal #'action-key hyperbole-mode-map)
+			       :test #'equal))
       t)))
 
 ;;;###autoload
@@ -82,7 +85,8 @@ with different settings of this option.  For example, a nil value makes
 
 ;;;###autoload
 (defvar hsys-org-mode-function #'hsys-org-mode-p
-"*Zero arg bool func that returns non-nil if point is in an Org-related buffer.")
+  "Function that determines whether point is in an Org mode-related buffer.
+Called with no argument and should return non-nil if and only if it is.")
 
 ;;; ************************************************************************
 ;;; Public Action Types

hyrolo.el

@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     7-Jun-89 at 22:08:29
-;; Last-Mod:     27-Nov-22 at 23:45:24 by Bob Weiner
+;; Last-Mod:      8-Jan-23 at 01:13:50 by Mats Lidell
 ;;
 ;; Copyright (C) 1991-2022  Free Software Foundation, Inc.
 ;; See the "HY-COPY" file for license information.
@@ -550,10 +550,10 @@ Return number of entries matched.  See also documentation for the variable
 		(or (not (integerp max-matches))
 		    (< total-matches (max max-matches (- max-matches)))))
       (setq hyrolo-buf (hyrolo-find-file-noselect file)
-	    hyrolo-entry-regexps (set:add (buffer-local-value 'hyrolo-entry-regexp hyrolo-buf)
-					  hyrolo-entry-regexps)
-	    outline-regexps (set:add (buffer-local-value 'outline-regexp hyrolo-buf)
-				     outline-regexps)
+	    hyrolo-entry-regexps (seq-uniq (append (list (buffer-local-value 'hyrolo-entry-regexp hyrolo-buf))
+					           hyrolo-entry-regexps))
+	    outline-regexps (seq-uniq (append (list (buffer-local-value 'outline-regexp hyrolo-buf))
+				              outline-regexps))
 	    hyrolo-file-list (cdr hyrolo-file-list)
 	    num-matched (cond ((and (featurep 'bbdb) (equal file bbdb-file))
 			       (hyrolo-bbdb-grep-file file regexp max-matches count-only))

hywconfig.el

@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    15-Mar-89
-;; Last-Mod:      6-Nov-22 at 13:04:26 by Bob Weiner
+;; Last-Mod:      7-Jan-23 at 23:59:53 by Mats Lidell
 ;;
 ;; Copyright (C) 1989-2022  Free Software Foundation, Inc.
 ;; See the "../HY-COPY" file for license information.
@@ -77,14 +77,16 @@ NAME, confirms whether or not to replace it."
   (interactive "sName for current window configuration: ")
   (or (stringp name)
       (error "(hywconfig-add-by-name): `name' argument is not a string: %s" name))
-  (let ((set:equal-op  (lambda (key elt) (equal key (car elt))))
-	(wconfig-names (hywconfig-get-names)))
+  (let ((wconfig-names (hywconfig-get-names))
+	(old (assoc name wconfig-names)))
     (if (or (not (called-interactively-p 'interactive))
-	    (not (set:member name wconfig-names))
+	    (not old)
 	    (y-or-n-p
 	     (format "Replace existing `%s' window configuration? " name)))
-	(progn (hywconfig-set-names (set:replace name (current-window-configuration)
-						 wconfig-names))
+	(progn (if old (setcdr old (current-window-configuration))
+		 (hywconfig-set-names
+		  (cons (cons name (current-window-configuration))
+			wconfig-names)))
 	       (if (called-interactively-p 'interactive)
 		   (message
 		    (substitute-command-keys
@@ -99,8 +101,9 @@ NAME, confirms whether or not to replace it."
 	 (message "There is no named window configuration to delete."))
 	((not (stringp name))
 	 (error "(hywconfig-delete-by-name): `name' argument is not a string: %s" name))
-	(t (let ((set:equal-op (lambda (key elt) (equal key (car elt)))))
-	     (hywconfig-set-names (set:remove name (hywconfig-get-names)))
+	(t (let ((confnames (hywconfig-get-names)))
+	     (hywconfig-set-names
+	      (delq (assoc name confnames) confnames))
 	     (if (called-interactively-p 'interactive)
 		 (message "Window configuration `%s' has been deleted." name))))))
 
@@ -113,7 +116,7 @@ NAME, confirms whether or not to replace it."
 	 (message "There is no named window configuration to restore."))
 	((not (stringp name))
 	 (error "(hywconfig-restore-by-name): `name' argument is not a string: %s" name))
-	(t (let ((wconfig (set:get name (hywconfig-get-names))))
+	(t (let ((wconfig (cdr (assoc name (hywconfig-get-names)))))
 	     (if wconfig
 		 (progn (hywconfig-set-window-configuration wconfig)
 			(if (called-interactively-p 'interactive)
@@ -201,7 +204,7 @@ oldest one comes the newest one."
   (let* ((frame (selected-frame))
 	 (names (frame-parameter frame 'hywconfig-names)))
     (if (not names)
-	(set-frame-parameter frame 'hywconfig-names (setq names (set:create))))
+	(set-frame-parameter frame 'hywconfig-names (setq names nil)))
     names))
 
 (defun hywconfig-set-names (names)

kotl/kotl-mode.el

@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    6/30/93
-;; Last-Mod:     16-Oct-22 at 19:29:20 by Mats Lidell
+;; Last-Mod:      8-Jan-23 at 00:12:51 by Mats Lidell
 ;;
 ;; Copyright (C) 1993-2022  Free Software Foundation, Inc.
 ;; See the "../HY-COPY" file for license information.
@@ -125,16 +125,17 @@ It provides the following keys:
     (setq hyrolo-entry-regexp (concat "^" kview:outline-regexp)
 	  kotl-previous-mode major-mode
 	  ;; Remove outline minor-mode mode-line indication.
+	  ;; FIXME: Why?
 	  minor-mode-alist (copy-sequence minor-mode-alist)
-	  minor-mode-alist (set:remove '(outline-minor-mode " Outl")
-				       minor-mode-alist)
- 	  minor-mode-alist (set:remove '(selective-display " Outline")
-				       minor-mode-alist)
-	  minor-mode-alist (set:remove '(selective-display " Otl")
-				       minor-mode-alist)
+	  minor-mode-alist (delete '(outline-minor-mode " Outl")
+				   minor-mode-alist)
+ 	  minor-mode-alist (delete '(selective-display " Outline")
+				   minor-mode-alist)
+	  minor-mode-alist (delete '(selective-display " Otl")
+				   minor-mode-alist)
 	  ;; Remove indication that buffer is narrowed.
-	  mode-line-format (copy-sequence mode-line-format)
-	  mode-line-format (set:remove "%n" mode-line-format)
+	  mode-line-format (remove "%n" mode-line-format)
+	  outline-regexp (concat " *[0-9][0-9a-z.]*" kview:default-label-separator)
 	  outline-level  #'kcell-view:level
 	  outline-regexp kview:outline-regexp))
   ;;
@@ -2563,9 +2564,10 @@ ATTRIBUTE and ignore any value of POS."
        (setq plist (cdr plist)))
      ;; Remove read-only attributes
      (setq existing-attributes (apply #'set:create existing-attributes)
-	   existing-attributes (set:difference
+	   existing-attributes (cl-set-difference
 				existing-attributes
-				kcell:read-only-attributes))
+				kcell:read-only-attributes
+				:test #'equal))
 
      (while (zerop (length (setq attribute
 				 (completing-read
@@ -2612,17 +2614,18 @@ confirmation."
        (setq plist (cdr plist)))
      ;; Remove read-only attributes
      (setq existing-attributes (apply #'set:create existing-attributes)
-	   existing-attributes (set:difference
+	   existing-attributes (cl-set-difference
 				existing-attributes
-				kcell:read-only-attributes))
+				kcell:read-only-attributes
+				:test #'equal))
 
      (while (zerop (length (setq attribute
 				 (completing-read
 				  (format "Name of attribute to set in cell <%s>: "
 					  (if top-cell-flag
 					      "0"
 					    (kcell-view:label)))
-				  (mapcar 'list
+				  (mapcar #'list
 					  (mapcar 'symbol-name
 						  existing-attributes))))))
        (beep))