[PATCH v5 3/4] ox-texinfo: Define definition commands using description lists

[Jonas Bernoulli]

* doc/org-manual.org (Plain lists in Texinfo export): Document use
of definition command prefixes in description lists.
* lisp/ox-texinfo.el: Add org-texinfo--separate-definitions to the
list of :filter-parse-tree functions of the texinfo backend.
* lisp/ox-texinfo.el (org-texinfo--definition-command-alist)
(org-texinfo--definition-command-regexp): New variables.
* 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 |  70 ++++++++++++++++++++++
 lisp/ox-texinfo.el | 141 ++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 210 insertions(+), 1 deletion(-)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index 4a4a048aa..d7d81c1d4 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -15307,6 +15307,72 @@ example is transcoded to the same output as above.
   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-c C-c (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
+
+#+texinfo: @noindent
+Command in parenthesis, as done above, is optional.
+
 *** Tables in Texinfo export
 :PROPERTIES:
 :DESCRIPTION: Table attributes.
@@ -15401,6 +15467,10 @@ Type @kbd{C-c @key{SPC}}.
 :DESCRIPTION: Special block attributes.
 :END:
 
+The Texinfo export back-end supports two approaches to writing Texinfo
+definition commands.  One of them is described 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 83868a69e..673084859 100644
--- a/lisp/ox-texinfo.el
+++ b/lisp/ox-texinfo.el
@@ -83,7 +83,8 @@ (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--normalize-headlines
+                          org-texinfo--separate-definitions))
     (:filter-section . org-texinfo--filter-section-blank-lines)
     (:filter-final-output . org-texinfo--untabify))
   :menu-entry
@@ -414,6 +415,23 @@ (defvar org-texinfo--quoted-keys-regexp
              'words)
   "Regexp matching keys that have to be quoted using @key{KEY}.")
 
+(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))
+          t))
+  "Regexp used to match definition commands in descriptive lists.")
+
 
 ;;; Internal Functions
 
@@ -577,6 +595,127 @@ (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 in TREE that contain Texinfo definition commands.
+INFO is a plist used as a communication channel.
+Return new tree."
+  (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))
+             (items nil))
+         (dolist (item 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
+                :attr_texinfo (org-element-property :attr_texinfo plain-list)
+                :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 determine the arguments for the
+`@findex' and `@kindex' commands for ITEM and store them in ITEM
+using the `:findex' and `:kindex' properties.
+
+If PLAIN-LIST is a description list whose `:compact' attribute is
+non-nil and ITEM has no content but is followed by another item,
+then store the `@findex' and `@kindex' values in the next item.
+If the previous item stored its respecive values in this item,
+then move them to the next item."
+  (let ((key nil)
+       (cmd nil))
+    (if (string-match (rx (+ " ")
+                         "(" (group (+ (not (any "()")))) ")"
+                         (* " ")
+                         eos)
+                     args)
+       (setq key (substring args 0 (match-beginning 0))
+             cmd (match-string 1 args))
+      (setq key args))
+    (org-element-put-property
+     item :tag
+     (cons (org-export-raw-string (org-texinfo-kbd-macro key t))
+          (and cmd `(" (" (code (:value ,cmd :post-blank 0)) ")"))))
+    (let ((findex (org-element-property :findex item))
+         (kindex (org-element-property :kindex item))
+         (next-item (org-export-get-next-element item nil))
+         (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))))
+      (cond
+       ((and next-item
+            (org-not-nil
+             (org-export-read-attribute :attr_texinfo plain-list :compact))
+            (not (org-element-contents item))
+            (eq 1 (org-element-property :post-blank item)))
+       (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))
+       (t
+       (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.35.1