From: Mark Wooding <mdw@distorted.org.uk>
Date: Mon, 5 Apr 2021 16:54:52 +0000 (+0100)
Subject: bin/hyperspec: Track changes to Emacs hyperspec internals.
X-Git-Url: https://git.distorted.org.uk/~mdw/profile/commitdiff_plain/b958e20c9583b18f85b3fd034799fef9ec9fbd5d

bin/hyperspec: Track changes to Emacs hyperspec internals.
---

diff --git a/bin/hyperspec b/bin/hyperspec
index 9f902fe..507910c 100755
--- a/bin/hyperspec
+++ b/bin/hyperspec
@@ -44,6 +44,9 @@
 			  signal))))
     (fset 'message original-message)))
 
+;; No.
+(setq kill-emacs-hook nil)
+
 ;;;--------------------------------------------------------------------------
 ;;; Utilities.
 
@@ -62,11 +65,18 @@
 ;;;--------------------------------------------------------------------------
 ;;; Look up a string and find its URL in the Hyperspec.
 
+(defmacro some-var (&rest vars)
+  (let ((v (gensym)))
+    `(let ((,v (find-if #'boundp ',vars)))
+       (if ,v (symbol-value ,v)
+	 (error "huh")))))
+
 (defun hyperspec-urls (key)
   "Return a list of hyperspec URLs corresponding to KEY."
   (let ((urls nil)
 	(lookups (list (list (downcase key)
-			     common-lisp-hyperspec-symbols
+			     (some-var common-lisp-hyperspec--symbols
+				       common-lisp-hyperspec-symbols)
 			     #'(lambda (values)
 				 (mapcar (lambda (value)
 					   (concat common-lisp-hyperspec-root
@@ -74,49 +84,73 @@
 						   value))
 					 values)))
 		       (list (downcase key)
-			     common-lisp-hyperspec-issuex-symbols
+			     (some-var common-lisp-hyperspec--issuex-symbols
+				       common-lisp-hyperspec-issuex-symbols)
 			     #'(lambda (value)
 				 (list (concat common-lisp-hyperspec-root
 					       "Issues/"
 					       value)))))))
     (when (= (aref key 0) ?~)
       (push (list (substring key 1)
-		  common-lisp-hyperspec-format-characters
+		  (some-var common-lisp-hyperspec--format-characters
+			    common-lisp-hyperspec-format-characters)
 		  #'(lambda (values)
-		      (mapcar #'common-lisp-hyperspec-section values)))
+		      (mapcar #'common-lisp-hyperspec-section
+			      values)))
 	    lookups))
     (dolist (lookup lookups)
       (let* ((name (car lookup))
-	     (obarray (cadr lookup))
+	     (table (cadr lookup))
 	     (format (car (cddr lookup)))
-	     (symbol (intern-soft name obarray)))
-	(when (and symbol (boundp symbol))
-	  (setq urls (nconc urls
-			    (funcall format (symbol-value symbol)))))))
+	     (value (cond ((vectorp table)
+			   (let ((symbol (intern-soft name table)))
+			     (and symbol
+				  (boundp symbol)
+				  (symbol-value symbol))))
+			  ((hash-table-p table)
+			   (gethash name table))
+			  (t
+			   (error "what even?")))))
+	(when value
+	  (setq urls (nconc urls (funcall format value))))))
     urls))
 
-(defun good-symbols (obarray &optional filter)
-  "Return the list of bound symbols in OBARRAY for which FILTER returns
+(defun good-symbols (table &optional filter)
+  "Return the list of bound symbols in TABLE for which FILTER returns
 non-nil; FILTER defaults to always-true if unspecified."
   (let ((syms nil))
-    (mapatoms (lambda (sym)
-		(when (and (boundp sym)
-			   (or (not filter)
-			       (funcall filter sym)))
-		  (setq syms (cons sym syms))))
-	      obarray)
+    (cond ((vectorp table)
+	   (mapatoms (lambda (sym)
+		       (when (and (boundp sym)
+				  (or (not filter)
+				      (funcall filter sym)))
+			 (push (symbol-name sym) syms)))
+		     table))
+	  ((hash-table-p table)
+	   (maphash (lambda (key value)
+		      (when (or (not filter) (funcall filter key))
+			(push key syms)))
+		    table))
+	  (t
+	   (error "what even?")))
     (sort syms #'string<)))
 
 (defun hyperspec-keys ()
   "Return the list of all valid hyperspec lookup keys.  Useful for
 completion."
-  (nconc (good-symbols common-lisp-hyperspec-symbols)
+  (nconc (good-symbols (some-var common-lisp-hyperspec--symbols
+				 common-lisp-hyperspec-symbols))
 	 (mapcar #'(lambda (name)
-		     (format "~%s" name))
-		 (good-symbols common-lisp-hyperspec-format-characters
-			       #'(lambda (sym)
-				   (= (length (symbol-name sym)) 1))))
-	 (good-symbols common-lisp-hyperspec-issuex-symbols)))
+		     (format "~%c" (aref name 0)))
+		 (good-symbols (some-var common-lisp-hyperspec--format-characters
+					 common-lisp-hyperspec-format-characters)
+			       #'(lambda (name)
+				   (and (>= (length name) 3)
+					(= (aref name 2) ?-)
+					(let ((ch (aref name 0)))
+					  (= ch (downcase ch)))))))
+	 (good-symbols (some-var common-lisp-hyperspec--issuex-symbols
+				 common-lisp-hyperspec-issuex-symbols))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Parse the command line.