Refactor hyperbole set functions

hact.el

@@ -1,10 +1,10 @@
-;;; hact.el --- GNU Hyperbole button action handling
+;;; hact.el --- GNU Hyperbole button action handling  -*- lexical-binding: t; -*-
 ;;
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    18-Sep-91 at 02:57:09
 ;;
-;; Copyright (C) 1991-2016  Free Software Foundation, Inc.
+;; Copyright (C) 1991-2021  Free Software Foundation, Inc.
 ;; See the "HY-COPY" file for license information.
 ;;
 ;; This file is part of GNU Hyperbole.
@@ -36,7 +36,8 @@ e.g. to inhibit actions.")
 ;;; ========================================================================
 
 (defvar symtable:category-plist nil
-  "Holds a property list of Hyperbole type category symbols ('actypes or 'ibtypes) and their associated symtables.")
+  "Property list mapping Hyperbole type category symbols to symtables.
+The type categories are either 'actypes or 'ibtypes.")
 
 (defsubst symtable:hash-table (symtable)
   "Return the hash-table containing symbol names and values from SYMTABLE."
@@ -125,7 +126,7 @@ Return the Elisp symbol for SYMBOL-OR-NAME.
 Caller must ensure SYMBOL-OR-NAME is a symbol or string."
   (symtable:operate #'puthash symbol-or-name symtable))
 
-(defalias 'symtable:delete 'symtable:remove)
+(defalias 'symtable:delete #'symtable:remove)
 
 (defun    symtable:get (symbol-or-name symtable)
   "Return the Elisp symbol given by Hyperbole SYMBOL-OR-NAME if it is in existing SYMTABLE, else nil.
@@ -155,18 +156,17 @@ 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."
   (setf (symbol-plist symbol) nil))
 
-(defalias 'symset:delete 'symset:remove)
+(defalias 'symset:delete #'symset:remove)
 
 (defun    symset:get (symbol property)
   "Return SYMBOL's PROPERTY set."
@@ -175,9 +175,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
@@ -247,7 +246,7 @@ Return the Hyperbole symbol for the TYPE if it existed, else nil."
 (defun    htype:names (type-category &optional sym)
   "Return a list of the current definition names for TYPE-CATEGORY in priority order.
 Definition names do not contain the category prefix.
-TYPE-CATEGORY should be 'actypes, 'ibtypes or nil for all.
+TYPE-CATEGORY should be `actypes', `ibtypes' or nil for all.
 When optional SYM is given, returns the name for that symbol only, if any."
   (let ((types (symset:get type-category 'symbols))
 	(sym-name (when sym (symbol-name sym))))

hsys-org.el

@@ -1,10 +1,10 @@
-;;; hsys-org.el --- GNU Hyperbole support functions for Org mode
+;;; hsys-org.el --- GNU Hyperbole support functions for Org mode  -*- lexical-binding: t; -*-
 ;;
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     2-Jul-16 at 14:54:14
 ;;
-;; Copyright (C) 2016-2020  Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021  Free Software Foundation, Inc.
 ;; See the "HY-COPY" file for license information.
 ;;
 ;; This file is part of GNU Hyperbole.
@@ -28,6 +28,7 @@
 ;;; ************************************************************************
 
 (eval-when-compile (require 'hmouse-drv))
+(require 'cl-lib)
 (require 'hbut)
 (require 'org)
 (require 'org-element)
@@ -38,10 +39,12 @@
 (defun hsys-org-meta-return-shared-p ()
   "Return non-nil iff hyperbole-mode is active and it shares the org-meta-return key binding."
   (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
@@ -73,7 +76,8 @@ with different settings of this option.  For example, a nil value makes
 
 ;;;###autoload
 (defvar hsys-org-mode-function #'hsys-org-mode-p
-  "*Boolean function of no arguments that determines whether point is in an Org mode-related buffer or not.")
+  "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

hywconfig.el

@@ -1,10 +1,10 @@
-;;; hywconfig.el --- Save ring of window configurations
+;;; hywconfig.el --- Save ring of window configurations  -*- lexical-binding: t; -*-
 ;;
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    15-Mar-89
 ;;
-;; Copyright (C) 1989-2019  Free Software Foundation, Inc.
+;; Copyright (C) 1989-2021  Free Software Foundation, Inc.
 ;; See the "../HY-COPY" file for license information.
 ;;
 ;; This file is part of GNU Hyperbole.
@@ -75,14 +75,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
@@ -97,8 +99,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))))))
 
@@ -111,7 +114,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)
@@ -174,7 +177,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

@@ -1,10 +1,10 @@
-;;; kotl-mode.el ---  Major mode for editing koutlines and associated commands
+;;; kotl-mode.el ---  Major mode for editing koutlines and associated commands  -*- lexical-binding: t; -*-
 ;;
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    6/30/93
 ;;
-;; Copyright (C) 1993-2019  Free Software Foundation, Inc.
+;; Copyright (C) 1993-2021  Free Software Foundation, Inc.
 ;; See the "../HY-COPY" file for license information.
 ;;
 ;; This file is part of GNU Hyperbole.
@@ -104,16 +104,16 @@ It provides the following keys:
   (unless (and (boundp 'kotl-previous-mode) kotl-previous-mode)
     (setq 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)))
   ;;
   (when (fboundp 'add-to-invisibility-spec)
@@ -2459,9 +2459,10 @@ to one level and kotl-mode:refill-flag is treated as true."
        (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
@@ -2497,15 +2498,16 @@ 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>: "
 					  (kcell-view:label))
-				  (mapcar 'list
+				  (mapcar #'list
 					  (mapcar 'symbol-name
 						  existing-attributes))))))
        (beep))