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.