mdw@git.distorted.org.uk Git - profile/blob - bin/hyperspec

   1 #! /bin/sh
   2 '': "-*-emacs-lisp-*-"; exec emacs --no-site-file --batch --load "$0" -- "$@"
   3 ;;;
   4 ;;; Look things up in the Common Lisp Hyperspec.
   5 ;;;
   6 ;;; (c) 2008 Mark Wooding
   7 ;;;
   8
   9 ;;;----- Licensing notice ---------------------------------------------------
  10 ;;;
  11 ;;; This program is free software; you can redistribute it and/or modify
  12 ;;; it under the terms of the GNU General Public License as published by
  13 ;;; the Free Software Foundation; either version 2 of the License, or
  14 ;;; (at your option) any later version.
  15 ;;;
  16 ;;; This program is distributed in the hope that it will be useful,
  17 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;;; GNU General Public License for more details.
  20 ;;;
  21 ;;; You should have received a copy of the GNU General Public License
  22 ;;; along with this program; if not, write to the Free Software
  23 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
  24
  25 ;;;--------------------------------------------------------------------------
  26 ;;; External dependencies.
  27
  28 ;; We need the hyperspec library, obviously.
  29 (require 'hyperspec)
  30
  31 ;; The init file probably has customizations for the Hyperspec library, in
  32 ;; particular where the local Hyperspec files are.
  33 ;;
  34 ;; Hacking here to suppress messages from the init file, and also to protect
  35 ;; us from errors in it.
  36 (setq mdw-fast-startup t)
  37 (let ((original-message (symbol-function 'message)))
  38   (unwind-protect
  39       (progn
  40         (fset 'message #'(lambda (&rest hunoz) nil))
  41         (condition-case signal (load-file "~/.emacs")
  42           (error (funcall original-message
  43                           "hyperspec (warning): .emacs erred: %s."
  44                           signal))))
  45     (fset 'message original-message)))
  46
  47 ;; No.
  48 (setq kill-emacs-hook nil)
  49
  50 ;;;--------------------------------------------------------------------------
  51 ;;; Utilities.
  52
  53 (defvar quis "hyperspec")
  54
  55 (defun die (&rest format-args)
  56   (message "%s: %s" quis (apply #'format format-args))
  57   (kill-emacs 1))
  58
  59 (defvar usage-string "Usage: hyperspec -l | KEY")
  60
  61 (defun die-usage ()
  62   (message "%s" usage-string)
  63   (kill-emacs 1))
  64
  65 ;;;--------------------------------------------------------------------------
  66 ;;; Look up a string and find its URL in the Hyperspec.
  67
  68 (defmacro some-var (&rest vars)
  69   (let ((v (gensym)))
  70     `(let ((,v (find-if #'boundp ',vars)))
  71        (if ,v (symbol-value ,v)
  72          (error "huh")))))
  73
  74 (defun hyperspec-urls (key)
  75   "Return a list of hyperspec URLs corresponding to KEY."
  76   (let ((urls nil)
  77         (lookups (list (list (downcase key)
  78                              (some-var common-lisp-hyperspec--symbols
  79                                        common-lisp-hyperspec-symbols)
  80                              #'(lambda (values)
  81                                  (mapcar (lambda (value)
  82                                            (concat common-lisp-hyperspec-root
  83                                                    "Body/"
  84                                                    value))
  85                                          values)))
  86                        (list (downcase key)
  87                              (some-var common-lisp-hyperspec--issuex-symbols
  88                                        common-lisp-hyperspec-issuex-symbols)
  89                              #'(lambda (value)
  90                                  (list (concat common-lisp-hyperspec-root
  91                                                "Issues/"
  92                                                value)))))))
  93     (when (= (aref key 0) ?~)
  94       (push (list (substring key 1)
  95                   (some-var common-lisp-hyperspec--format-characters
  96                             common-lisp-hyperspec-format-characters)
  97                   #'(lambda (values)
  98                       (mapcar #'common-lisp-hyperspec-section
  99                               values)))
 100             lookups))
 101     (dolist (lookup lookups)
 102       (let* ((name (car lookup))
 103              (table (cadr lookup))
 104              (format (car (cddr lookup)))
 105              (value (cond ((vectorp table)
 106                            (let ((symbol (intern-soft name table)))
 107                              (and symbol
 108                                   (boundp symbol)
 109                                   (symbol-value symbol))))
 110                           ((hash-table-p table)
 111                            (gethash name table))
 112                           (t
 113                            (error "what even?")))))
 114         (when value
 115           (setq urls (nconc urls (funcall format value))))))
 116     urls))
 117
 118 (defun good-symbols (table &optional filter)
 119   "Return the list of bound symbols in TABLE for which FILTER returns
 120 non-nil; FILTER defaults to always-true if unspecified."
 121   (let ((syms nil))
 122     (cond ((vectorp table)
 123            (mapatoms (lambda (sym)
 124                        (when (and (boundp sym)
 125                                   (or (not filter)
 126                                       (funcall filter sym)))
 127                          (push (symbol-name sym) syms)))
 128                      table))
 129           ((hash-table-p table)
 130            (maphash (lambda (key value)
 131                       (when (or (not filter) (funcall filter key))
 132                         (push key syms)))
 133                     table))
 134           (t
 135            (error "what even?")))
 136     (sort syms #'string<)))
 137
 138 (defun hyperspec-keys ()
 139   "Return the list of all valid hyperspec lookup keys.  Useful for
 140 completion."
 141   (nconc (good-symbols (some-var common-lisp-hyperspec--symbols
 142                                  common-lisp-hyperspec-symbols))
 143          (mapcar #'(lambda (name)
 144                      (format "~%c" (aref name 0)))
 145                  (good-symbols (some-var common-lisp-hyperspec--format-characters
 146                                          common-lisp-hyperspec-format-characters)
 147                                #'(lambda (name)
 148                                    (and (>= (length name) 3)
 149                                         (= (aref name 2) ?-)
 150                                         (let ((ch (aref name 0)))
 151                                           (= ch (downcase ch)))))))
 152          (good-symbols (some-var common-lisp-hyperspec--issuex-symbols
 153                                  common-lisp-hyperspec-issuex-symbols))))
 154
 155 ;;;--------------------------------------------------------------------------
 156 ;;; Parse the command line.
 157
 158 (defvar key nil)
 159 (defvar mode 'url)
 160
 161 (defvar options
 162   '((("-h" "--help") . help)
 163     (("-l" "--list") . (lambda () (setq mode 'list)))))
 164
 165 (defun help ()
 166   (princ usage-string)
 167   (princ "
 168
 169 Write to stdout a URL to the Hyperspec page describing KEY.
 170
 171 Options:
 172   -h, --help            Show this help message.
 173   -l, --list            Write to stdout a list of acceptable KEYS.
 174 ")
 175   (kill-emacs))
 176
 177 ;; Parse the command-line options.
 178 (pop command-line-args-left)
 179 (catch 'done
 180   (while t
 181     (unless command-line-args-left
 182       (throw 'done nil))
 183     (let ((opt (pop command-line-args-left)))
 184       (cond ((string= opt "--")
 185              (throw 'done nil))
 186             ((not (eq (aref opt 0) ?-))
 187              (push opt command-line-args-left)
 188              (throw 'done nil))
 189             (t
 190              (catch 'found
 191                (dolist (def options)
 192                  (when (member opt (car def))
 193                    (funcall (cdr def))
 194                    (throw 'found nil)))
 195                (die "Unknown option `%s'." opt)))))))
 196
 197 ;; Check the non-option arguments.
 198 (cond ((eq mode 'url)
 199        (unless (= (length command-line-args-left) 1)
 200          (die-usage))
 201        (let* ((key (car command-line-args-left))
 202               (urls (hyperspec-urls key)))
 203          (mapcar #'(lambda (url) (princ url) (terpri)) urls)))
 204       ((eq mode 'list)
 205        (unless (null command-line-args-left)
 206          (die-usage))
 207        (mapc (lambda (item) (princ item) (terpri))
 208              (hyperspec-keys))))
 209
 210 ;;;----- That's all, folks --------------------------------------------------