diff options
author | Nicolas Goaziou <n.goaziou@gmail.com> | 2012-09-13 17:00:55 +0200 |
---|---|---|
committer | Nicolas Goaziou <n.goaziou@gmail.com> | 2012-09-13 17:33:46 +0200 |
commit | 1e1a47682463dbd01b1fdae0daa2d8d3eaa1ffd6 (patch) | |
tree | f6ec90dd3c3c3da5e6f663896457bbefa598faef | |
parent | 28f8ca60c76f931327eef9c0365c51de300bb958 (diff) | |
download | org-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.el | 245 | ||||
-rw-r--r-- | contrib/lisp/org-e-man.el | 137 |
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 |