[PATCH 2/2] ox-texinfo: Define definition commands using description lists

[Jonas Bernoulli <jonas@bernoul.li>]

* doc/org-manual.org (Plain lists in Texinfo export): Document use
of definition command prefixes in description lists.

* lisp/ox-texinfo.el (org-texinfo--definition-command-alist)
(org-texinfo--definition-command-regexp): New variables.
* lisp/ox-texinfo.el (org-texinfo--filter-parse-tree): Call
org-texinfo--separate-definitions.
* lisp/ox-texinfo.el (org-texinfo--separate-definitions)
(org-texinfo--match-definition, org-texinfo--split-definition)
(org-texinfo--split-plain-list, org-texinfo--massage-key-item):
New functions.
---
 doc/org-manual.org |  98 ++++++++++++++++++++++++++++++++-
 lisp/ox-texinfo.el | 132 ++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 227 insertions(+), 3 deletions(-)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index b8bb391c2..e8d777875 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -15303,7 +15303,99 @@ output can also be produced with:
 ,#+attr_texinfo: :table-type vtable :indic asis
 - foo ::
 + bar ::
-  This is the common text for foo and bar.
+  This is the common text for variables foo and bar.
+#+end_example
+
+Likewise, the Texinfo export back-end supports two approaches to
+writing Texinfo definition commands (see [[info:texinfo::Definition
+Commands]]).  One of them uses description lists and is describe below,
+the other is described in [[*Special blocks in Texinfo export]].
+
+Items in a description list in a Org file that begin with =Function:=
+or certain other prefixes are converted using Texinfo definition
+commands.  This works even if other items in the same list do not have
+such a prefix; if necessary a single description list is converted
+using multiple tables (such as =@vtable=) and definition commands
+(such as =@defun=).
+
+#+begin_example
+- Function: org-texinfo-drawer drawer contents info ::
+  Transcode a DRAWER element from Org to Texinfo.
+#+end_example
+
+#+texinfo: @noindent
+becomes
+
+#+begin_example
+@defun org-texinfo-drawer drawer contents info ::
+  Transcode a DRAWER element from Org to Texinfo.
+@end defun
+#+end_example
+
+The recognized prefixes are =Command:=, =Function:=, =Macro:=,
+=Special Form:=, =Variable:= and =User Option:=.  These are the same
+prefixes that appear in the Info file for the respective definition
+commands.  For example a =Function:= item in the Org file is converted
+to a =@defun= command in the Texinfo file, which in turn is converted
+to a definition prefixed with =-- Function:= in the Info file.
+
+As a special case the prefix =Key:= is also recognized.  No Texinfo
+definition command exists for key bindings and the output in Info
+files also lacks the =Key:= prefix.  Even so this special case is
+supported because it provides a convenient shorthand, as illustrated
+here:
+
+#+begin_example
+- Key: C-n (do-something) ::
+  This command does something.
+
+- User Option: do-something-somehow ::
+  This option controls how exactly ~do-something~ does its thing.
+#+end_example
+
+#+texinfo: @noindent
+becomes
+
+#+begin_example
+@table @asis
+@item @kbd{C-c C-c} (@code{do-something})
+@kindex C-c C-c
+@findex do-something
+This command does something.
+@end table
+
+@defopt do-something-somehow
+This option controls how exactly @code{do-something} does its thing.
+@end defopt
+#+end_example
+
+Key items don't have to specify the respective command in parenthesis
+as done above; that part is optional.
+
+You can get the same result using the alternative approach (see
+[[*Special blocks in Texinfo export]]), which is more verbose and less
+similar to the final Info/HTML/PDF output (but more similar to the
+intermediate Texinfo file):
+
+#+begin_example
+- {{{kbd(C-c C-c)}}} (~do-something~) ::
+
+  #+kindex: C-c C-c
+  #+findex: do-something
+  This command does something.
+
+,#+attr_texinfo: :options do-something-somehow
+,#+begin_defopt
+  This option controls how exactly ~do-something~ does its thing.
+,#+end_defopt
+#+end_example
+
+Regardless of which approach you use, you must define the =kbd= macro
+(see [[*Macro Replacement]]), which you can then use anywhere in the Org
+file:
+
+#+begin_example
+,#+macro: kbd (eval (let ((case-fold-search nil) (regexp (regexp-opt '("SPC" "RET" "LFD" "TAB" "BS" "ESC" "DELETE" "SHIFT" "Ctrl" "Meta" "Alt" "Cmd" "Super" "UP" "LEFT" "RIGHT" "DOWN") 'words))) (format "@@texinfo:@kbd{@@%s@@texinfo:}@@" (replace-regexp-in-string regexp "@@texinfo:@key{@@\\&@@texinfo:}@@" $1 t))))
 #+end_example
 
 *** Tables in Texinfo export
@@ -15373,6 +15465,10 @@ your king.
 :DESCRIPTION: Special block attributes.
 :END:
 
+The Texinfo export back-end supports two approaches to writing Texinfo
+definition commands.  One of them is describe here, the other in
+[[*Plain lists in Texinfo export]].
+
 #+cindex: @samp{ATTR_TEXINFO}, keyword
 
 The Texinfo export back-end converts special blocks to commands with
diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el
index 35862357d..cc9fca918 100644
--- a/lisp/ox-texinfo.el
+++ b/lisp/ox-texinfo.el
@@ -83,7 +83,7 @@ (org-export-define-backend 'texinfo
     (verse-block . org-texinfo-verse-block))
   :filters-alist
   '((:filter-headline . org-texinfo--filter-section-blank-lines)
-    (:filter-parse-tree . org-texinfo--normalize-headlines)
+    (:filter-parse-tree . org-texinfo--filter-parse-tree)
     (:filter-section . org-texinfo--filter-section-blank-lines)
     (:filter-final-output . org-texinfo--untabify))
   :menu-entry
@@ -407,6 +407,23 @@ (defconst org-texinfo-inline-image-rules
 	      (regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg"))))
   "Rules characterizing image files that can be inlined.")
 
+(defconst org-texinfo--definition-command-alist
+  '(("deffn Command" . "Command")
+    ("defun" . "Function")
+    ("defmac" . "Macro")
+    ("defspec" . "Special Form")
+    ("defvar" . "Variable")
+    ("defopt" . "User Option")
+    (nil . "Key"))
+  "Alist mapping Texinfo definition commands to output in Info files.")
+
+(defconst org-texinfo--definition-command-regexp
+  (format "\\`%s: \\(.+\\)"
+          (regexp-opt
+           (delq nil (mapcar #'cdr org-texinfo--definition-command-alist))
+           1))
+  "Regexp used to match definition commands in descriptive lists.")
+
 \f
 ;;; Internal Functions
 
@@ -421,7 +438,8 @@ (defun org-texinfo--filter-section-blank-lines (headline _backend _info)
 (defun org-texinfo--filter-parse-tree (tree backend info)
   "Normalize headlines and items."
   (org-texinfo--normalize-headlines tree backend info)
-  (org-texinfo--normalize-items tree info))
+  (org-texinfo--normalize-items tree info)
+  (org-texinfo--separate-definitions tree backend info))
 
 (defun org-texinfo--normalize-headlines (tree _backend info)
   "Normalize headlines in TREE.
@@ -598,6 +616,116 @@ (defun org-texinfo--sectioning-structure (info)
       (`(,_ ,_ . ,sections) sections)
       (_ (user-error "Unknown Texinfo class: %S" class)))))
 
+(defun org-texinfo--separate-definitions (tree _backend info)
+  "Split up descriptive lists that contain Texinfo definition commands."
+  (org-element-map tree 'plain-list
+    (lambda (plain-list)
+      (when (eq (org-element-property :type plain-list) 'descriptive)
+        (let ((contents (org-element-contents plain-list))
+              item items)
+          (while (setq item (pop contents))
+            (pcase-let ((`(,cmd . ,args) (org-texinfo--match-definition item)))
+              (cond
+               (cmd
+                (when items
+                  (org-texinfo--split-plain-list plain-list (nreverse items))
+                  (setq items nil))
+                (org-texinfo--split-definition plain-list item cmd args))
+               (t
+                (when args
+                  (org-texinfo--massage-key-item plain-list item args))
+                (push item items)))))
+          (unless (org-element-contents plain-list)
+            (org-element-extract-element plain-list)))))
+    info)
+  tree)
+
+(defun org-texinfo--match-definition (item)
+  "Return a cons-cell if ITEM specifies a Texinfo definition command.
+The car is the command and the cdr is its arguments."
+  (let ((tag (car-safe (org-element-property :tag item))))
+    (and tag
+         (stringp tag)
+         (string-match org-texinfo--definition-command-regexp tag)
+         (pcase-let*
+             ((cmd (car (rassoc (match-string-no-properties 1 tag)
+                                 org-texinfo--definition-command-alist)))
+              (`(,cmd ,category)
+               (and cmd (save-match-data (split-string cmd " "))))
+              (args (match-string-no-properties 2 tag)))
+           (cons cmd (if category (concat category " " args) args))))))
+
+(defun org-texinfo--split-definition (plain-list item cmd args)
+  "Insert a definition command before list PLAIN-LIST.
+Replace list item ITEM with a special-block that inherits the
+contents of ITEM and whose type and Texinfo attributes are
+specified by CMD and ARGS."
+  (let ((contents (org-element-contents item)))
+    (org-element-insert-before
+     (apply #'org-element-create 'special-block
+            (list :type cmd
+                  :attr_texinfo (list (format ":options %s" args))
+                  :post-blank (if contents 1 0))
+            (mapc #'org-element-extract-element contents))
+     plain-list))
+  (org-element-extract-element item))
+
+(defun org-texinfo--split-plain-list (plain-list items)
+  "Insert a new plain list before the plain list PLAIN-LIST.
+Remove ITEMS from PLAIN-LIST and use them as the contents of the
+new plain list."
+  (org-element-insert-before
+   (apply #'org-element-create 'plain-list
+          (list :type 'descriptive :post-blank 1)
+          (mapc #'org-element-extract-element items))
+   plain-list))
+
+(defun org-texinfo--massage-key-item (plain-list item args)
+  "In PLAIN-LIST modify ITEM based on ARGS.
+Reformat ITEM's tag property and add findex and kindex entries to
+its content.  If the bullet is \"+\" then use \"@itemx\" and deal with
+data from preceeding siblings that use such a bullet."
+  (let (key cmd)
+    (if (string-match " +(\\([^()]+\\)) *\\'" args)
+        (setq key (substring args 0 (match-beginning 0))
+              cmd (match-string 1 args))
+      (setq key args))
+    (org-element-put-property
+     item :tag
+     (nconc (if (assoc "kbd" org-macro-templates)
+                (let ((templates org-macro-templates))
+                  (with-temp-buffer
+                    (insert (format "{{{kbd(%s)}}}" key))
+                    (org-macro-replace-all templates)
+                    (let ((tags (car (org-element-map (org-element-parse-buffer)
+		                         'paragraph #'org-element-contents t))))
+	              (dolist (tag tags)
+	                (org-element-put-property tag :parent tags))
+	              tags)))
+              `((code (:value ,key :post-blank 0))))
+            (and cmd `(" (" (code (:value ,cmd :post-blank 0)) ")"))))
+    (let ((findex (org-element-property :findex item))
+          (kindex (org-element-property :kindex item))
+          (next-item (cadr (memq item (org-element-contents plain-list))))
+          (mx (string-prefix-p "M-x " key)))
+      (when (and (not cmd) mx)
+        (setq cmd (substring key 4)))
+      (when (and cmd (not (member cmd findex)))
+        (setq findex (nconc findex (list cmd))))
+      (unless mx
+        (setq kindex (nconc kindex (list key))))
+      (if (and next-item
+               (equal (org-element-property :bullet next-item) "+ "))
+          (progn (org-element-put-property next-item :findex findex)
+                 (org-element-put-property next-item :kindex kindex)
+                 (org-element-put-property item :findex nil)
+                 (org-element-put-property item :kindex nil))
+        (org-element-set-contents
+         item (nconc
+               (mapcar (lambda (key) `(keyword (:key "KINDEX" :value ,key))) kindex)
+               (mapcar (lambda (cmd) `(keyword (:key "FINDEX" :value ,cmd))) findex)
+               (org-element-contents item)))))))
+
 ;;; Template
 
 (defun org-texinfo-template (contents info)
-- 
2.34.1