Update to Org 9.6-3-ga4d38e

1 files changed, 321 insertions, 25 deletions

diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el
index 9a8217583e9..73ba349b1bb 100644
--- a/lisp/org/ox-texinfo.el
+++ b/lisp/org/ox-texinfo.el
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
 ;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
-;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Maintainer: Nicolas Goaziou <mail@nicolasgoaziou.fr>
 ;; Keywords: outlines, hypermedia, calendar, wp
 
 ;; This file is part of GNU Emacs.
@@ -26,11 +26,14 @@
 
 ;;; Code:
 
+(require 'org-macs)
+(org-assert-version)
+
 (require 'cl-lib)
 (require 'ox)
 
 (defvar orgtbl-exp-regexp)
-
+(defvar org-texinfo-supports-math--cache)
 
 
 ;;; Define Back-End
@@ -55,6 +58,8 @@
     (italic . org-texinfo-italic)
     (item . org-texinfo-item)
     (keyword . org-texinfo-keyword)
+    (latex-environment . org-texinfo-latex-environment)
+    (latex-fragment . org-texinfo-latex-fragment)
     (line-break . org-texinfo-line-break)
     (link . org-texinfo-link)
     (node-property . org-texinfo-node-property)
@@ -83,7 +88,8 @@
     (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
@@ -118,8 +124,10 @@
     (:texinfo-table-default-markup nil nil org-texinfo-table-default-markup)
     (:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist)
     (:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function)
-    (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function)))
-
+    (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function)
+    (:texinfo-compact-itemx nil "compact-itemx" org-texinfo-compact-itemx)
+    ;; Redefine regular options.
+    (:with-latex nil "tex" org-texinfo-with-latex)))
 
 
 ;;; User Configurable Variables
@@ -354,6 +362,37 @@ The function should return the string to be exported."
   :group 'org-export-texinfo
   :type 'function)
 
+;;;; LaTeX
+
+(defcustom org-texinfo-with-latex (and org-export-with-latex 'detect)
+  "When non-nil, the Texinfo exporter attempts to process LaTeX math.
+
+When set to t, the exporter will process LaTeX environments and
+fragments as Texinfo \"@displaymath\" and \"@math\" commands
+respectively.  Alternatively, when set to `detect', the exporter
+does so only if the installed version of Texinfo supports the
+necessary commands."
+  :group 'org-export-texinfo
+  :package-version '(Org . "9.6")
+  :type '(choice
+          (const :tag "Detect" detect)
+          (const :tag "Yes" t)
+          (const :tag "No" nil)))
+
+;;;; Itemx
+
+(defcustom org-texinfo-compact-itemx nil
+  "Non-nil means certain items in description list become `@itemx'.
+
+If this is non-nil and an item in a description list has no
+body but is followed by another item, then the second item is
+transcoded to `@itemx'.  See info node `(org)Plain lists in
+Texinfo export' for how to enable this for individual lists."
+  :package-version '(Org . "9.6")
+  :group 'org-export-texinfo
+  :type 'boolean
+  :safe t)
+
 ;;;; Compilation
 
 (defcustom org-texinfo-info-process '("makeinfo --no-split %f")
@@ -407,6 +446,30 @@ If two strings share the same prefix (e.g. \"ISO-8859-1\" and
 	      (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.")
+
 
 ;;; Internal Functions
 
@@ -570,6 +633,130 @@ INFO is a plist holding export options."
       (`(,_ ,_ . ,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 info))
+		(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 info)
+  "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 respective values in this item,
+then move them to the next item.
+
+INFO is a plist used as a communication channel."
+  (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
+             (or (plist-get info :texinfo-compact-itemx)
+	         (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)
@@ -990,25 +1177,42 @@ contextual information."
 CONTENTS holds the contents of the item.  INFO is a plist holding
 contextual information."
   (let* ((tag (org-element-property :tag item))
-	 (split (org-string-nw-p
-		 (org-export-read-attribute :attr_texinfo
-					    (org-element-property :parent item)
-					    :sep)))
-	 (items (and tag
-		     (let ((tag (org-export-data tag info)))
-		       (if split
-			   (split-string tag (regexp-quote split) t "[ \t\n]+")
-			 (list tag))))))
-    (format "%s\n%s"
-	    (pcase items
-	      (`nil "@item")
-	      (`(,item) (concat "@item " item))
-	      (`(,item . ,items)
-	       (concat "@item " item "\n"
-		       (mapconcat (lambda (i) (concat "@itemx " i))
-				  items
-				  "\n"))))
-	    (or contents ""))))
+         (plain-list (org-element-property :parent item))
+         (compact (and (eq (org-element-property :type plain-list) 'descriptive)
+                       (or (plist-get info :texinfo-compact-itemx)
+                           (org-not-nil (org-export-read-attribute
+                                         :attr_texinfo plain-list :compact)))))
+         (previous-item nil))
+    (when (and compact
+               (org-export-get-next-element item info)
+               (not (org-element-contents item))
+               (eq 1 (org-element-property :post-blank item)))
+      (org-element-put-property item :post-blank 0))
+    (if (and compact
+             (setq previous-item (org-export-get-previous-element item info))
+             (not (org-element-contents previous-item))
+	     (eq 0 (org-element-property :post-blank previous-item)))
+        (format "@itemx%s\n%s"
+                (if tag (concat " " (org-export-data tag info)) "")
+                (or contents ""))
+      (let* ((split (org-string-nw-p (org-export-read-attribute
+                                      :attr_texinfo plain-list :sep)))
+	     (items (and tag
+		         (let ((tag (org-export-data tag info)))
+		           (if split
+			       (split-string tag (regexp-quote split)
+                                             t "[ \t\n]+")
+			     (list tag))))))
+        (format "%s\n%s"
+	        (pcase items
+	          (`nil "@item")
+	          (`(,item) (concat "@item " item))
+	          (`(,item . ,items)
+	           (concat "@item " item "\n"
+		           (mapconcat (lambda (i) (concat "@itemx " i))
+				      items
+				      "\n"))))
+	        (or contents ""))))))
 
 ;;;; Keyword
 
@@ -1032,6 +1236,52 @@ CONTENTS is nil.  INFO is a plist holding contextual information."
 	      (concat "@listoffloats "
 		      (org-export-translate "Listing" :utf-8 info))))))))
 
+;;;; LaTeX Environment
+
+(defun org-texinfo-latex-environment (environment _contents info)
+  "Transcode a LaTeX ENVIRONMENT from Org to Texinfo.
+CONTENTS is ignored.  INFO is a plist holding contextual information."
+  (let ((with-latex (plist-get info :with-latex)))
+    (when (or (eq with-latex t)
+              (and (eq with-latex 'detect)
+                   (org-texinfo-supports-math-p)))
+      (let ((value (org-element-property :value environment)))
+        (string-join (list "@displaymath"
+                           (string-trim (org-remove-indentation value))
+                           "@end displaymath")
+                     "\n")))))
+
+;;;; LaTeX Fragment
+
+(defun org-texinfo-latex-fragment (fragment _contents info)
+  "Transcode a LaTeX FRAGMENT from Org to Texinfo.
+INFO is a plist holding contextual information."
+  (let ((with-latex (plist-get info :with-latex)))
+    (when (or (eq with-latex t)
+              (and (eq with-latex 'detect)
+                   (org-texinfo-supports-math-p)))
+      (let ((value (org-remove-indentation
+                    (org-element-property :value fragment))))
+        (cond
+         ((or (string-match-p "^\\\\\\[" value)
+              (string-match-p "^\\$\\$" value))
+          (concat "\n"
+                  "@displaymath"
+                  "\n"
+                  (string-trim (substring value 2 -2))
+                  "\n"
+                  "@end displaymath"
+                  "\n"))
+         ((string-match-p "^\\$" value)
+          (concat "@math{"
+                  (string-trim (substring value 1 -1))
+                  "}"))
+         ((string-match-p "^\\\\(" value)
+          (concat "@math{"
+                  (string-trim (substring value 2 -2))
+                  "}"))
+         (t value))))))
+
 ;;;; Line Break
 
 (defun org-texinfo-line-break (_line-break _contents _info)
@@ -1611,7 +1861,28 @@ contextual information."
   (format "@display\n%s@end display" contents))
 
 
-;;; Interactive functions
+;;; Public Functions
+
+(defun org-texinfo-kbd-macro (key &optional noquote)
+  "Quote KEY using @kbd{...} and if necessary @key{...}.
+
+This is intended to be used as an Org macro like so:
+
+  #+macro: kbd (eval (org-texinfo-kbd-macro $1))
+  Type {{{kbd(C-c SPC)}}}.
+
+Also see info node `(org)Key bindings in Texinfo export'.
+
+If optional NOQOUTE is non-nil, then do not add the quoting
+that is necessary when using this in an Org macro."
+  (format (if noquote "@kbd{%s}" "@@texinfo:@kbd{@@%s@@texinfo:}@@")
+	  (let ((case-fold-search nil))
+	    (replace-regexp-in-string
+	     org-texinfo--quoted-keys-regexp
+	     (if noquote "@key{\\&}" "@@texinfo:@key{@@\\&@@texinfo:}@@")
+	     key t))))
+
+;;; Interactive Functions
 
 ;;;###autoload
 (defun org-texinfo-export-to-texinfo
@@ -1747,6 +2018,31 @@ Return INFO file name or an error if it couldn't be produced."
     (message "Process completed.")
     output))
 
+(defun org-texinfo-supports-math-p ()
+  "Return t if the installed version of Texinfo supports \"@math\".
+
+Once computed, the results remain cached."
+  (unless (boundp 'org-texinfo-supports-math--cache)
+    (setq org-texinfo-supports-math--cache
+          (let ((math-example "1 + 1 = 2"))
+            (let* ((input-file
+                    (make-temp-file "test" nil ".info"))
+                   (input-content
+                    (concat (format "@setfilename %s" input-file) "\n"
+                            "@node Top" "\n"
+                            (format "@displaymath{%s}" math-example) "\n")))
+              (with-temp-file input-file
+                (insert input-content))
+              (let* ((output-file (org-texinfo-compile input-file))
+                     (output-content (with-temp-buffer
+                                       (insert-file-contents output-file)
+                                       (buffer-string))))
+                (let ((result (string-match-p (regexp-quote math-example)
+                                              output-content)))
+                  (delete-file input-file)
+                  (delete-file output-file)
+                  (if result t nil)))))))
+  org-texinfo-supports-math--cache)
 
 (provide 'ox-texinfo)