summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2012-09-13 17:00:55 +0200
committerNicolas Goaziou <n.goaziou@gmail.com>2012-09-13 17:33:46 +0200
commit1e1a47682463dbd01b1fdae0daa2d8d3eaa1ffd6 (patch)
treef6ec90dd3c3c3da5e6f663896457bbefa598faef
parent28f8ca60c76f931327eef9c0365c51de300bb958 (diff)
downloadorg-mode-1e1a47682463dbd01b1fdae0daa2d8d3eaa1ffd6.tar.gz
org-e-groff/org-e-man: Changes to caption handling
* contrib/lisp/org-e-groff.el (org-e-groff--caption/label-string): Change signature. (org-e-groff-link--inline-image, org-e-groff-src-block, org-e-groff-table--org-table): Use `org-export-read-attribute'. Apply signature change. * contrib/lisp/org-e-man.el (org-e-man--caption/label-string): Change signature. (org-e-man-src-block): Remove unused caption code. (org-e-man-table--org-table): Use `org-export-read-attribute'. Apply signature change.
-rw-r--r--contrib/lisp/org-e-groff.el245
-rw-r--r--contrib/lisp/org-e-man.el137
2 files changed, 165 insertions, 217 deletions
diff --git a/contrib/lisp/org-e-groff.el b/contrib/lisp/org-e-groff.el
index 9651e23..a7464c6 100644
--- a/contrib/lisp/org-e-groff.el
+++ b/contrib/lisp/org-e-groff.el
@@ -540,30 +540,24 @@ These are the .aux, .log, .out, and .toc files."
;;; Internal Functions
-(defun org-e-groff--caption/label-string (caption label info)
- "Return caption and label Groff string for floats.
+(defun org-e-groff--caption/label-string (element info)
+ "Return caption and label Groff string for ELEMENT.
-CAPTION is a cons cell of secondary strings, the car being the
-standard caption and the cdr its short form. LABEL is a string
-representing the label. INFO is a plist holding contextual
-information.
-
-If there's no caption nor label, return the empty string.
+INFO is a plist holding contextual information. If there's no
+caption nor label, return the empty string.
For non-floats, see `org-e-groff--wrap-label'."
- (let ((label-str ""))
- (cond
- ((and (not caption) (not label)) "")
- ((not caption) (format "\\fI%s\\fP" label))
- ;; Option caption format with short name.
- ((cdr caption)
- (format "%s\n.br\n%s - %s\n"
- (org-export-data (cdr caption) info)
- label-str
- (org-export-data (car caption) info)))
- ;; Standard caption format.
- (t (format "\\fR%s\\fP"
- (org-export-data (car caption) info))))))
+ (let ((main (org-export-get-caption element))
+ (short (org-export-get-caption element t))
+ (label (org-element-property :name element)))
+ (cond ((and (not main) (not label)) "")
+ ((not main) (format "\\fI%s\\fP" label))
+ ;; Option caption format with short name.
+ (short (format "%s\n.br\n - %s\n"
+ (org-export-data short info)
+ (org-export-data main info)))
+ ;; Standard caption format.
+ (t (format "\\fR%s\\fP" (org-export-data main info))))))
(defun org-e-groff--quotation-marks (text info)
"Export quotation marks depending on language conventions.
@@ -1296,28 +1290,17 @@ used as a communication channel."
(path (let ((raw-path (org-element-property :path link)))
(if (not (file-name-absolute-p raw-path)) raw-path
(expand-file-name raw-path))))
- (attr (read (format "(%s)"
- (mapconcat
- #'identity
- (org-element-property :attr_groff parent)
- " "))))
+ (attr (org-export-read-attribute :attr_groff link))
(placement
(case (plist-get attr :position)
('center "")
('left "-L")
('right "-R")
(t "")))
- (width (or (plist-get attr :width) ""))
- (height (or (plist-get attr :height) ""))
-
- (disable-caption (plist-get attr :disable-caption))
-
- (caption
- (org-e-groff--caption/label-string
- (org-element-property :caption parent)
- (org-element-property :name parent)
- info)))
-
+ (width (or (plist-get attr :width) ""))
+ (height (or (plist-get attr :height) ""))
+ (caption (and (not (plist-get attr :disable-caption))
+ (org-e-groff--caption/label-string parent info))))
;; Now clear ATTR from any special keyword and set a default value
;; if nothing is left. Return proper string.
(concat
@@ -1333,7 +1316,7 @@ used as a communication channel."
(format "\n.PS\ncopy \"%s\"\n.PE" path))
(t (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE "
placement path width height)))
- (unless disable-caption (format "\n.FG \"%s\"" caption)))))
+ (and caption (format "\n.FG \"%s\"" caption)))))
(defun org-e-groff-link (link desc info)
"Transcode a LINK object from Org to Groff.
@@ -1587,7 +1570,6 @@ holding contextual information."
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((lang (org-element-property :language src-block))
- (caption (org-element-property :caption src-block))
(label (org-element-property :name src-block))
(code (org-element-property :value src-block))
(custom-env (and lang
@@ -1597,55 +1579,50 @@ contextual information."
(continued (org-export-get-loc src-block info))
(new 0)))
(retain-labels (org-element-property :retain-labels src-block))
- (attr
- (read (format "(%s)"
- (mapconcat #'identity
- (org-element-property :attr_groff src-block)
- " "))))
- (disable-caption (plist-get attr :disable-caption)))
+ (caption (and (not (org-export-read-attribute
+ :attr_groff src-block :disable-caption))
+ (org-e-groff--caption/label-string src-block info))))
(cond
;; Case 1. No source fontification.
((not org-e-groff-source-highlight)
- (let ((caption-str (org-e-groff--caption/label-string caption label info)))
- (concat
- (format ".DS I\n\\fC%s\\fP\n.DE\n"
- (org-export-format-code-default src-block info))
- (unless disable-caption (format ".EX \"%s\" " caption-str)))))
+ (concat
+ (format ".DS I\n\\fC%s\\fP\n.DE\n"
+ (org-export-format-code-default src-block info))
+ (and caption (format ".EX \"%s\" " caption))))
;; Case 2. Source fontification.
(org-e-groff-source-highlight
- (let* ((tmpdir (if (featurep 'xemacs)
- temp-directory
- temporary-file-directory))
- (caption-str (org-e-groff--caption/label-string caption label info))
- (in-file (make-temp-name
- (expand-file-name "srchilite" tmpdir)))
- (out-file (make-temp-name
- (expand-file-name "reshilite" tmpdir)))
-
- (org-lang (org-element-property :language src-block))
- (lst-lang (cadr (assq (intern org-lang)
- org-e-groff-source-highlight-langs)))
-
- (cmd (concat "source-highlight"
- " -s " lst-lang
- " -f groff_mm_color "
- " -i " in-file
- " -o " out-file)))
-
- (concat
- (if lst-lang
- (let ((code-block ""))
- (with-temp-file in-file (insert code))
- (shell-command cmd)
- (setq code-block (org-file-contents out-file))
- (delete-file in-file)
- (delete-file out-file)
- (format "%s\n" code-block))
- (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n"
- code))
- (unless disable-caption (format ".EX \"%s\" " caption-str))))))))
+ (let* ((tmpdir (if (featurep 'xemacs)
+ temp-directory
+ temporary-file-directory))
+ (in-file (make-temp-name
+ (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name
+ (expand-file-name "reshilite" tmpdir)))
+
+ (org-lang (org-element-property :language src-block))
+ (lst-lang (cadr (assq (intern org-lang)
+ org-e-groff-source-highlight-langs)))
+
+ (cmd (concat "source-highlight"
+ " -s " lst-lang
+ " -f groff_mm_color "
+ " -i " in-file
+ " -o " out-file)))
+
+ (concat
+ (if lst-lang
+ (let ((code-block ""))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ (format "%s\n" code-block))
+ (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n"
+ code))
+ (and caption (format ".EX \"%s\" " caption))))))))
;;; Statistics Cookie
@@ -1756,13 +1733,10 @@ contents, as a string. INFO is a plist used as a communication
channel.
This function assumes TABLE has `org' as its `:type' attribute."
- (let* ((label (org-element-property :name table))
- (caption (org-e-groff--caption/label-string
- (org-element-property :caption table) label info))
- (attr (read (format "(%s)"
- (mapconcat #'identity
- (org-element-property :attr_groff table)
- " "))))
+ (let* ((attr (org-export-read-attribute :attr_groff table))
+ (label (org-element-property :name table))
+ (caption (and (not (plist-get attr :disable-caption))
+ (org-e-groff--caption/label-string table info)))
(divider (if (plist-get attr :divider) "|" " "))
;; Determine alignment string.
@@ -1798,7 +1772,6 @@ This function assumes TABLE has `org' as its `:type' attribute."
result-list))
(title-line (plist-get attr :title-line))
- (disable-caption (plist-get attr :disable-caption))
(long-cells (plist-get attr :long-cells))
(table-format
@@ -1807,8 +1780,8 @@ This function assumes TABLE has `org' as its `:type' attribute."
(or (car attr-list) ""))
(or
(let (output-list)
- (when (cdr attr-list)
- (dolist (attr-item (cdr attr-list))
+ (when (cdr attr-list)
+ (dolist (attr-item (cdr attr-list))
(setq output-list (concat output-list
(format ",%s" attr-item)))))
output-list) "")))
@@ -1821,52 +1794,50 @@ This function assumes TABLE has `org' as its `:type' attribute."
;; Others.
(lines
(concat ".TS\n " table-format ";\n"
- (format "%s.\n"
- (let ((final-line ""))
- (when title-line
- (dotimes (i (length first-line))
- (setq final-line (concat final-line "cb" divider))))
-
- (setq final-line (concat final-line "\n"))
-
- (if alignment
- (setq final-line (concat final-line alignment))
- (dotimes (i (length first-line))
- (setq final-line (concat final-line "c" divider))))
- final-line))
-
- (format "%s.TE\n"
- (let ((final-line "")
- (long-line "")
- (lines (org-split-string contents "\n")))
-
- (dolist (line-item lines)
- (setq long-line "")
-
- (if long-cells
- (progn
- (if (string= line-item "_")
- (setq long-line (format "%s\n" line-item))
- ;; else string =
- (let ((cell-item-list (org-split-string line-item "\t")))
- (dolist (cell-item cell-item-list)
-
- (cond ((eq cell-item (car (last cell-item-list)))
- (setq long-line (concat long-line
- (format "T{\n%s\nT}\t\n" cell-item))))
- (t
- (setq long-line (concat long-line
- (format "T{\n%s\nT}\t" cell-item))))))
- long-line))
- ;; else long cells
- (setq final-line (concat final-line long-line)))
-
- (setq final-line (concat final-line line-item "\n"))))
- final-line))
-
- (if (not disable-caption)
- (format ".TB \"%s\""
- caption) ""))))))
+ (format "%s.\n"
+ (let ((final-line ""))
+ (when title-line
+ (dotimes (i (length first-line))
+ (setq final-line (concat final-line "cb" divider))))
+
+ (setq final-line (concat final-line "\n"))
+
+ (if alignment
+ (setq final-line (concat final-line alignment))
+ (dotimes (i (length first-line))
+ (setq final-line (concat final-line "c" divider))))
+ final-line))
+
+ (format "%s.TE\n"
+ (let ((final-line "")
+ (long-line "")
+ (lines (org-split-string contents "\n")))
+
+ (dolist (line-item lines)
+ (setq long-line "")
+
+ (if long-cells
+ (progn
+ (if (string= line-item "_")
+ (setq long-line (format "%s\n" line-item))
+ ;; else string =
+ (let ((cell-item-list (org-split-string line-item "\t")))
+ (dolist (cell-item cell-item-list)
+
+ (cond ((eq cell-item (car (last cell-item-list)))
+ (setq long-line (concat long-line
+ (format "T{\n%s\nT}\t\n" cell-item))))
+ (t
+ (setq long-line (concat long-line
+ (format "T{\n%s\nT}\t" cell-item))))))
+ long-line))
+ ;; else long cells
+ (setq final-line (concat final-line long-line)))
+
+ (setq final-line (concat final-line line-item "\n"))))
+ final-line))
+
+ (if caption (format ".TB \"%s\"" caption) ""))))))
;;; Table Cell
diff --git a/contrib/lisp/org-e-man.el b/contrib/lisp/org-e-man.el
index d3c55f9..68c95e7 100644
--- a/contrib/lisp/org-e-man.el
+++ b/contrib/lisp/org-e-man.el
@@ -291,30 +291,24 @@ These are the .aux, .log, .out, and .toc files."
;;; Internal Functions
-(defun org-e-man--caption/label-string (caption label info)
- "Return caption and label Man string for floats.
+(defun org-e-man--caption/label-string (element info)
+ "Return caption and label Man string for ELEMENT.
-CAPTION is a cons cell of secondary strings, the car being the
-standard caption and the cdr its short form. LABEL is a string
-representing the label. INFO is a plist holding contextual
-information.
-
-If there's no caption nor label, return the empty string.
+INFO is a plist holding contextual information. If there's no
+caption nor label, return the empty string.
For non-floats, see `org-e-man--wrap-label'."
- (let ((label-str "" ))
- (cond
- ((and (not caption) (not label)) "")
- ((not caption) (format "\\fI%s\\fP" label))
- ;; Option caption format with short name.
- ((cdr caption)
- (format "\\fR%s\\fP - \\fI%s\\P - %s\n"
- (org-export-data (cdr caption) info)
- label-str
- (org-export-data (car caption) info)))
- ;; Standard caption format.
- (t (format "\\fR%s\\fP"
- (org-export-data (car caption) info))))))
+ (let ((label (org-element-property :label element))
+ (main (org-export-get-caption element))
+ (short (org-export-get-caption element t)))
+ (cond ((and (not main) (not label)) "")
+ ((not main) (format "\\fI%s\\fP" label))
+ ;; Option caption format with short name.
+ (short (format "\\fR%s\\fP - \\fI\\P - %s\n"
+ (org-export-data short info)
+ (org-export-data main info)))
+ ;; Standard caption format.
+ (t (format "\\fR%s\\fP" (org-export-data main info))))))
@@ -849,10 +843,7 @@ holding contextual information."
"Transcode a SRC-BLOCK element from Org to Man.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
-
(let* ((lang (org-element-property :language src-block))
- (caption (org-element-property :caption src-block))
- (label (org-element-property :name src-block))
(code (org-element-property :value src-block))
(custom-env (and lang
(cadr (assq (intern lang)
@@ -864,40 +855,37 @@ contextual information."
(cond
;; Case 1. No source fontification.
((not org-e-man-source-highlight)
- (let ((caption-str (org-e-man--caption/label-string caption label info)))
- (concat
- (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
- (org-export-format-code-default src-block info)))))
- ( (and org-e-man-source-highlight)
- (let* ((tmpdir (if (featurep 'xemacs)
- temp-directory
- temporary-file-directory ))
-
- (in-file (make-temp-name
- (expand-file-name "srchilite" tmpdir)))
- (out-file (make-temp-name
- (expand-file-name "reshilite" tmpdir)))
-
- (org-lang (org-element-property :language src-block))
- (lst-lang (cadr (assq (intern org-lang)
- org-e-man-source-highlight-langs)))
-
- (cmd (concat "source-highlight"
- " -s " lst-lang
- " -f groff_man "
- " -i " in-file
- " -o " out-file)))
-
- (if lst-lang
- (let ((code-block "" ))
- (with-temp-file in-file (insert code))
- (shell-command cmd)
- (setq code-block (org-file-contents out-file))
- (delete-file in-file)
- (delete-file out-file)
- code-block)
- (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE"
- code)))))))
+ (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
+ (org-export-format-code-default src-block info)))
+ (org-e-man-source-highlight
+ (let* ((tmpdir (if (featurep 'xemacs)
+ temp-directory
+ temporary-file-directory ))
+
+ (in-file (make-temp-name
+ (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name
+ (expand-file-name "reshilite" tmpdir)))
+
+ (org-lang (org-element-property :language src-block))
+ (lst-lang (cadr (assq (intern org-lang)
+ org-e-man-source-highlight-langs)))
+
+ (cmd (concat "source-highlight"
+ " -s " lst-lang
+ " -f groff_man "
+ " -i " in-file
+ " -o " out-file)))
+
+ (if lst-lang
+ (let ((code-block ""))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ code-block)
+ (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))))
;;; Statistics Cookie
@@ -1008,19 +996,11 @@ contents, as a string. INFO is a plist used as a communication
channel.
This function assumes TABLE has `org' as its `:type' attribute."
- (let* ((label (org-element-property :name table))
- (caption (org-e-man--caption/label-string
- (org-element-property :caption table) label info))
- (attr (read
- (format "(%s)"
- (mapconcat
- #'identity
- (org-element-property :attr_man table)
- " "))))
-
- (divider (if (plist-get attr :divider)
- "|"
- " "))
+ (let* ((attr (org-export-read-attribute :attr_man table))
+ (label (org-element-property :name table))
+ (caption (and (not (plist-get attr :disable-caption))
+ (org-e-man--caption/label-string table info)))
+ (divider (if (plist-get attr :divider) "|" " "))
;; Determine alignment string.
(alignment (org-e-man-table--align-string divider table info))
@@ -1055,7 +1035,6 @@ This function assumes TABLE has `org' as its `:type' attribute."
(title-line (plist-get attr :title-line))
- (disable-caption (plist-get attr :disable-caption))
(long-cells (plist-get attr :long-cells))
(table-format (concat
@@ -1064,11 +1043,11 @@ This function assumes TABLE has `org' as its `:type' attribute."
(let ((output-list '()))
(when (cdr attr-list)
(dolist (attr-item (cdr attr-list))
- (setq output-list (concat output-list (format ",%s" attr-item)))))
+ (setq output-list (concat output-list (format ",%s" attr-item)))))
output-list)
"")))
- (first-line (when lines (org-split-string (car lines) "\t"))))
+ (first-line (when lines (org-split-string (car lines) "\t"))))
;; Prepare the final format string for the table.
@@ -1112,16 +1091,14 @@ This function assumes TABLE has `org' as its `:type' attribute."
(t
(setq long-line (concat long-line
(format "T{\n%s\nT}\t" cell-item ))))))
- long-line))
- ;; else long cells
- (setq final-line (concat final-line long-line )))
+ long-line))
+ ;; else long cells
+ (setq final-line (concat final-line long-line )))
(setq final-line (concat final-line line-item "\n"))))
final-line))
- (if (not disable-caption)
- (format ".TB \"%s\""
- caption) ""))))))
+ (and caption (format ".TB \"%s\"" caption)))))))
;;; Table Cell