Skip to content

Commit

Permalink
Rewrite generate.el in "insert style"
Browse files Browse the repository at this point in the history 
Rather than build up big strings to insert, just insert as we go.

Although this is best practice in Emacs for efficiency, that's mostly
N/A for this doc build process. Instead I think the code is just
clearer and simpler. Yes it's imperative not functional, but this is
about output.

Also, because this runs just in a batch Emacs process, don't worry too
much about namespace prefixing names (aside from defvar where the byte
compiler would warn). The shorter names further simplify writing and
reading the code.
  • Loading branch information
@greghendershott
greghendershott committed Nov 4, 2024
1 parent 69dd900 commit e7e121a
Show file tree
Hide file tree
Showing 2 changed files with 111 additions and 118 deletions.
177 changes: 85 additions & 92 deletions doc/generate.el
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
;;; generate.el -*- lexical-binding: t -*-

;; Copyright (c) 2013-2022 by Greg Hendershott.
;; Copyright (c) 2013-2024 by Greg Hendershott.
;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Generate a reference.org file from doc strings
Expand All @@ -10,7 +10,8 @@
;; Info and HTML format documentation.
;;
;; Note that this file is /not/ loaded when running Racket Mode --
;; just used as part of the build process.
;; just used as part of the build process, when we run Emacs in batch
;; mode. As a result we don't bother with namespace prefixes.

(require 'racket-mode)
(require 'racket-debug)
Expand All @@ -29,15 +30,18 @@
(defun racket-generate-reference.org ()
(find-file "reference.org")
(delete-region (point-min) (point-max))
(insert (racket-generate--commands))
(insert (racket-generate--variables))
(insert (racket-generate--configuration-functions))
(insert (racket-generate--faces))
(insert-org-contents)
(save-buffer 0)) ;don't create reference.org~ backup

(defun insert-org-contents ()
(insert-commands)
(insert-variables)
(insert-configuration-functions)
(insert-faces))

;;; Interactive command functions

(defconst racket-generate--commands
(defconst the-commands
`("Edit"
racket-mode
racket-insert-lambda
Expand Down Expand Up @@ -123,37 +127,35 @@
racket-mode-start-slower)
"Commands to include in the Reference.")

(defun racket-generate--commands ()
(apply
#'concat
"* Commands\n\n"
(mapcar (lambda (s)
(pcase s
((and str (pred stringp))
(format "** %s\n\n" s))
((and sym (pred symbolp))
(racket-generate--command-or-function sym racket-mode-map))
(`(,sym ,keymap)
(racket-generate--command-or-function sym keymap))))
racket-generate--commands)))
(defun insert-commands ()
(insert "* Commands\n\n")
(dolist (s the-commands)
(pcase s
((and str (pred stringp))
(insert (format "** %s\n\n" str)))
((and sym (pred symbolp))
(insert-command-or-function sym racket-mode-map))
(`(,sym ,keymap)
(insert-command-or-function sym keymap)))))

(defun racket-generate--command-or-function (sym keymap)
(defun insert-command-or-function (sym keymap)
(unless (fboundp sym)
(error "not defined %s" sym))
(concat (format "*** %s\n" sym)
(insert (format "*** %s\n" sym)
(if keymap
(when (interactive-form sym)
(racket-generate--bindings-as-kbd sym keymap))
(if (interactive-form sym)
(bindings-as-kbd sym keymap)
"")
(format "~%s~\n" (cons sym (help-function-arglist sym))))
"\n\n"
(racket-generate--format-doc-string
(format-doc-string
(or (documentation sym t)
"No documentation.\n\n"))
"\n\n"))

;;; Configuration functions

(defconst racket-generate--configuration-functions
(defconst the-functions
`("Showing information"
racket-show-pseudo-tooltip
racket-show-echo-area
Expand All @@ -175,21 +177,18 @@
racket-vterm)
"Configuration functions to include in the Reference.")

(defun racket-generate--configuration-functions ()
(apply
#'concat
"* Configuration functions\n\n"
(mapcar (lambda (s)
(pcase s
((and str (pred stringp))
(format "** %s\n\n" s))
((and sym (pred symbolp))
(racket-generate--command-or-function sym nil))))
racket-generate--configuration-functions)))
(defun insert-configuration-functions ()
(insert "* Configuration functions\n\n")
(dolist (s the-functions)
(pcase s
((and str (pred stringp))
(insert (format "** %s\n\n" str)))
((and sym (pred symbolp))
(insert-command-or-function sym nil)))))

;;; Variables

(defconst racket-generate--variables
(defconst the-variables
'("General variables"
racket-program
racket-command-timeout
Expand Down Expand Up @@ -241,30 +240,27 @@
racket-input-translations)
"Variables to include in the Reference.")

(defun racket-generate--variables ()
(apply
#'concat
"* Variables\n\n"
(mapcar (lambda (s)
(if (stringp s)
(format "** %s\n\n" s)
(unless (boundp s)
(error "variable does not exist: %s" s))
(concat
(format "*** %s\n" s)
(racket-generate--format-doc-string
(or (documentation-property s 'variable-documentation t)
;; Do check for function documentation here,
;; to support documenting values for
;; `-functions' variables.
(documentation s t)
"No documentation.\n\n"))
"\n\n")))
racket-generate--variables)))
(defun insert-variables ()
(insert "* Variables\n\n")
(dolist (s the-variables)
(if (stringp s)
(insert (format "** %s\n\n" s))
(unless (boundp s)
(error "variable does not exist: %s" s))
(insert
(format "*** %s\n" s)
(format-doc-string
(or (documentation-property s 'variable-documentation t)
;; Do check for function documentation here,
;; to support documenting values for
;; `-functions' variables.
(documentation s t)
"No documentation.\n\n"))
"\n\n"))))

;;; Faces

(defconst racket-generate--faces
(defconst the-faces
'(racket-keyword-argument-face
racket-reader-quoted-symbol-face
racket-reader-syntax-quoted-symbol-face
Expand Down Expand Up @@ -301,23 +297,20 @@
racket-hash-lang-text)
"Faces to include in the Reference.")

(defun racket-generate--faces ()
(apply
#'concat
"* Faces\n\n"
"** All\n\n"
(mapcar (lambda (symbol)
(concat
(format "*** %s\n" symbol)
(racket-generate--format-doc-string
(or (documentation-property symbol 'face-documentation t)
"No documentation.\n\n"))
"\n\n"))
racket-generate--faces)))
(defun insert-faces ()
(insert "* Faces\n\n"
"** All\n\n")
(dolist (s the-faces)
(insert
(format "*** %s\n" s)
(format-doc-string
(or (documentation-property s 'face-documentation t)
"No documentation.\n\n"))
"\n\n")))

;;; Utility

(defun racket-generate--format-doc-string (docstring)
(defun format-doc-string (docstring)
"Convert command key references and keymap references
in DOCSTRING to buttons.
Expand All @@ -344,7 +337,7 @@ unescaping too."
(name (match-string-no-properties 1))
(sym (intern-soft name)))
(delete-region (point) (+ (point) len))
(insert (racket-generate--ref-or-code sym))))
(insert (ref-or-code sym))))
((looking-at
;; Text of the form `contents' or `contents`
(rx "`" (group (+ (not (in "`'")))) (in "`'")))
Expand Down Expand Up @@ -372,7 +365,7 @@ unescaping too."
;; Insert an org-mode table
(when km
(insert "|Key|Binding|\n")
(racket-generate--insert-keymap km)
(insert-keymap km)
(newline))))
((looking-at
;; Text of the form \\[foo-command]
Expand All @@ -384,13 +377,13 @@ unescaping too."
(insert
(if (string-equal name "universal-argument")
"{{{kbd(C-u)}}}"
(racket-generate--bindings-as-kbd (intern-soft name) keymap)))))
(bindings-as-kbd (intern-soft name) keymap)))))
;; Don't modify other characters.
(t
(forward-char 1))))
(buffer-string))))

(defun racket-generate--insert-keymap (km)
(defun insert-keymap (km)
"Insert org table describing keymap KM.
Filter \"noise\" like bindings for `negative-argument' and
Expand Down Expand Up @@ -428,16 +421,16 @@ table, sorted shortest first."
(dolist (v (seq-sort-by (lambda (v) (symbol-name (car v)))
#'string<
alist))
(let* ((command-str (racket-generate--ref-or-code (car v)))
(let* ((command-str (ref-or-code (car v)))
(keys-strs (seq-map (lambda (binding)
(format "{{{kbd(%s)}}}"
(racket-generate--key-description binding)))
(escaped-key-description binding)))
(cdr v)))
(keys-str (string-join (seq-sort-by #'length #'< keys-strs)
", ")))
" or ")))
(insert "|" keys-str "|" command-str "|\n"))))))

(defun racket-generate--key-description (xs)
(defun escaped-key-description (xs)
"Like `key-description' but escapes some chars for our \"KBD\" texi macro."
(with-temp-buffer
(insert (key-description xs))
Expand All @@ -449,38 +442,38 @@ table, sorted shortest first."
(insert str)))
(buffer-string)))

(defun racket-generate--bindings-as-kbd (symbol keymap)
(let* ((bindings (or (racket-generate--where-is/no-menu symbol keymap)
(racket-generate--where-is/no-menu symbol racket-mode-map)))
(defun bindings-as-kbd (symbol keymap)
(let* ((bindings (or (where-is/no-menu symbol keymap)
(where-is/no-menu symbol racket-mode-map)))
(strs (and
bindings
(seq-filter
#'identity
(mapcar (lambda (binding)
(let ((desc (racket-generate--key-description binding)))
(let ((desc (escaped-key-description binding)))
;; I don't know how to escape { or }
;; for texi
(unless (string-match-p "[{}]" desc)
(format "{{{kbd(%s)}}}" desc))))
bindings)))))
(if strs
(string-join strs " or ")
(string-join strs "or ")
(format "{{{kbd(M-x)}}} ~%s~" symbol))))

(defun racket-generate--where-is/no-menu (symbol keymap)
(defun where-is/no-menu (symbol keymap)
(seq-filter (lambda (binding) (not (eq (aref binding 0) 'menu-bar)))
(where-is-internal symbol keymap)))

(defun racket-generate--ref-or-code (sym)
(defun ref-or-code (sym)
"Return either a reference or code formatting for SYM."
(if (or (seq-some (lambda (v)
(or (eq v sym)
(and (listp v)
(eq (car v) sym))))
racket-generate--commands)
(member sym racket-generate--configuration-functions)
(member sym racket-generate--variables)
(member sym racket-generate--faces))
the-commands)
(member sym the-functions)
(member sym the-variables)
(member sym the-faces))
(format "@@texinfo:@ref{%s}@@" sym)
(format "~%s~" sym)))

Expand Down
Loading

0 comments on commit e7e121a

Please sign in to comment.