chiark / gitweb /
bin/hyperspec: Track changes to Emacs hyperspec internals.
authorMark Wooding <mdw@distorted.org.uk>
Mon, 5 Apr 2021 16:54:52 +0000 (17:54 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Mon, 5 Apr 2021 16:55:15 +0000 (17:55 +0100)
bin/hyperspec

index 9f902fe5cfb2d6f39ac94d00e4285818d4dc7767..507910cf9a1f791ca625166049375e124f0e8aa6 100755 (executable)
@@ -44,6 +44,9 @@
                          signal))))
     (fset 'message original-message)))
 
+;; No.
+(setq kill-emacs-hook nil)
+
 ;;;--------------------------------------------------------------------------
 ;;; Utilities.
 
 ;;;--------------------------------------------------------------------------
 ;;; 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
                                                   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.