[PATCH v2 3/3] 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: Add org-texinfo--separate-definitions to the
list of :filter-parse-tree functions of the texinfo backend.
* lisp/ox-texinfo.el (org-texinfo--quoted-keys-regexp)
(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 |  70 +++++++++++++++++++++++
 lisp/ox-texinfo.el | 139 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 209 insertions(+)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index b3c4a9bef..daa207a5d 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 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 8f671ea13..a79f620c6 100644
--- a/lisp/ox-texinfo.el
+++ b/lisp/ox-texinfo.el
@@ -84,6 +84,7 @@ (org-export-define-backend 'texinfo
   :filters-alist
   '((:filter-headline . org-texinfo--filter-section-blank-lines)
     (:filter-parse-tree . (org-texinfo--normalize-headlines
+			   org-texinfo--separate-definitions
 			   org-texinfo--combine-items))
     (:filter-section . org-texinfo--filter-section-blank-lines)
     (:filter-final-output . org-texinfo--untabify))
@@ -408,6 +409,30 @@ (defconst org-texinfo-inline-image-rules
 	      (regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg"))))
   "Rules characterizing image files that can be inlined.")
 
+(defvar org-texinfo--quoted-keys-regexp
+  (regexp-opt '("BS" "TAB" "RET" "ESC" "SPC" "DEL"
+		"LFD" "DELETE" "SHIFT" "Ctrl" "Meta" "Alt"
+		"Cmd" "Super" "UP" "LEFT" "RIGHT" "DOWN")
+	      '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.")
+
 \f
 ;;; Internal Functions
 
@@ -602,6 +627,120 @@ (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.
+
+_BACKEND is the symbol `texinfo'; the back-end used for export.
+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 :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 (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 (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))))
+      (cond
+       ((and next-item
+	     (org-not-nil
+	      (org-export-read-attribute :attr_texinfo plain-list :compact))
+	     (not (org-element-contents item))
+	     (= (org-element-property :post-blank item) 1))
+	(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.34.1