Merge branch 'master' of orgmode.org:org-mode

This commit is contained in:
Bastien Guerry 2012-08-08 12:11:57 +02:00
commit ee483e98f7
4 changed files with 474 additions and 589 deletions

View File

@ -144,7 +144,7 @@ structure of the values.")
("letter" ".MT 5"
(:heading 'default :type "memo" :last-section "sign"))
("custom" ".so file"
(:heading custom-function :type "custom" :last-section "toc") )
(:heading custom-function :type "custom" :last-section "toc"))
("dummy" ""
(:heading 'default :type "memo"))
("ms" "ms"
@ -394,8 +394,7 @@ in order to mimic default behaviour:
(ldap "ldap") (opa "opa")
(php "php") (postscript "postscript") (prolog "prolog")
(properties "properties") (makefile "makefile")
(tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg")
)
(tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
"Alist mapping languages to their listing language counterpart.
The key is a symbol, the major mode symbol without the \"-mode\".
The value is the string that should be inserted as the language
@ -485,11 +484,9 @@ string defines the replacement string for this quote."
(defcustom org-e-groff-special-char
'(
("(c)" . "\\\\(co")
'(("(c)" . "\\\\(co")
("(tm)" . "\\\\(tm")
("(rg)" . "\\\\(rg")
)
("(rg)" . "\\\\(rg"))
"CONS list in which the value of the car
is replace on the value of the CDR. "
:group 'org-export-e-groff
@ -503,8 +500,7 @@ string defines the replacement string for this quote."
(defcustom org-e-groff-pdf-process
'("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
"pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
"pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
)
"pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf")
"Commands to process a Groff file to a PDF file.
This is a list of strings, each of them will be given to the
@ -518,7 +514,7 @@ extension) and %o by the base directory of the file."
(string :tag "Shell command"))
(const :tag "2 runs of pdfgroff"
("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
"pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf" ))
"pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"))
(const :tag "3 runs of pdfgroff"
("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
"pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
@ -549,11 +545,11 @@ These are the .aux, .log, .out, and .toc files."
;; Adding GROFF as a block parser to make sure that its contents
;; does not execute
(defvar org-e-groff-registered-references '())
(add-to-list 'org-element-block-name-alist
'("GROFF" . org-element-export-block-parser))
(setq registered-references '())
;;; Internal Functions
@ -569,7 +565,7 @@ information.
If there's no caption nor label, return the empty string.
For non-floats, see `org-e-groff--wrap-label'."
(let ((label-str "" ))
(let ((label-str ""))
(cond
((and (not caption) (not label)) "")
((not caption) (format "\\fI%s\\fP" label))
@ -581,9 +577,7 @@ For non-floats, see `org-e-groff--wrap-label'."
(org-export-data (car caption) info)))
;; Standard caption format.
(t (format "\\fR%s\\fP"
(org-export-data (car caption) info)))))
)
(org-export-data (car caption) info))))))
(defun org-e-groff--quotation-marks (text info)
@ -628,7 +622,7 @@ See `org-e-groff-text-markup-alist' for details."
(setq text (substring text (1+ (match-beginning 0))))
(setq char (or (cdr (assoc char trans)) (concat "\\" char))
rtn (concat rtn char)))
(setq text (concat rtn text) )
(setq text (concat rtn text))
(format "\\fC%s\\fP" text)))
;; Else use format string.
(t (format fmt text)))))
@ -650,19 +644,19 @@ holding export options."
(class (plist-get info :groff-class))
(class-options (plist-get info :groff-class-options))
(classes (assoc class org-e-groff-classes))
(classes-options (car (last classes)) )
(heading-option (plist-get classes-options :heading ) )
(type-option (plist-get classes-options :type ) )
(last-option (plist-get classes-options :last-section ) )
(classes-options (car (last classes)))
(heading-option (plist-get classes-options :heading))
(type-option (plist-get classes-options :type))
(last-option (plist-get classes-options :last-section))
(document-class-string
(let ()
(progn
(org-element-normalize-string
(let* ((header (nth 1 (assoc class org-e-groff-classes)))
(document-class-item (if (stringp header) header "") ))
(document-class-item (if (stringp header) header "")))
document-class-item)))))
(concat
(unless (string= type-option "custom")
(let ()
(progn
(concat
(when (and (stringp document-class-string)
(string= type-option "cover"))
@ -672,7 +666,7 @@ holding export options."
(cond
((stringp firm-option)
(format ".AF \"%s\" \n" firm-option))
(t (format ".AF \"%s\" \n" (or org-e-groff-organization "")) )))
(t (format ".AF \"%s\" \n" (or org-e-groff-organization "")))))
;; 2. Title
(let ((subtitle1 (plist-get attr :subtitle1))
(subtitle2 (plist-get attr :subtitle2)))
@ -681,15 +675,15 @@ holding export options."
((string= "" title)
(format ".TL \"%s\" \"%s\" \n%s\n"
(or subtitle1 "")
(or subtitle2 "") " ")
)
(or subtitle2 "") " "))
((not (or subtitle1 subtitle2))
(format ".TL\n%s\n"
(or title "" )) )
(or title "" )))
(t
(format ".TL \"%s\" \"%s \" \n%s\n"
(or subtitle1 "")
(or subtitle2 "") title) )))
(or subtitle2 "") title))))
;; 3. Author.
;; In Groff, .AU *MUST* be placed after .TL
@ -704,9 +698,9 @@ holding export options."
(t ".AU \"\" \n")))
;; 4. Author Title, if present
(let ((at-item (plist-get attr :author-title) ))
(let ((at-item (plist-get attr :author-title)))
(if (and at-item (stringp at-item))
(format ".AT \"%s\" \n" at-item )
(format ".AT \"%s\" \n" at-item)
""))
;; 5. Date.
@ -714,13 +708,11 @@ holding export options."
(and date (format ".ND \"%s\"\n" date)))
(when (string= type-option "cover")
".COVEND\n"
) )))
".COVEND\n"))))
;;6. Hyphenation and Right Justification
(let ()
(set 'hyphenate (plist-get attr :hyphenate))
(set 'justify-right (plist-get attr :justify-right))
(let ((hyphenate (plist-get attr :hyphenate))
(justify-right (plist-get attr :justify-right)))
(concat
(if justify-right
(case justify-right
@ -732,9 +724,8 @@ holding export options."
(case hyphenate
('yes ".nr Hy 1 \n")
('no ".nr Hy 0 \n")
(t "")
)
"") ))
(t ""))
"")))
(when (string= type-option "memo")
document-class-string)
@ -749,8 +740,7 @@ holding export options."
(cond
((string= last-option "toc")
".TC")
((string= last-option "toc") ".TC")
((string= last-option "sign")
(let ((fc-item (plist-get attr :closing)))
(concat (if (stringp fc-item)
@ -758,9 +748,7 @@ holding export options."
".FC\n")
".SG")))
(t ""))
)
))
(t "")))))
@ -855,8 +843,7 @@ holding contextual information. See `org-export-data'."
"Transcode an ENTITY object from Org to Groff.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
(let ((ent (org-element-property :utf8 entity)))
ent))
(let ((ent (org-element-property :utf8 entity))) ent))
;;;; Example Block
@ -912,27 +899,24 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-e-groff-footnote-reference (footnote-reference contents info)
;; Changing from info to footnote-reference
(let* (( raw (org-export-get-footnote-definition footnote-reference info))
(let* ((raw (org-export-get-footnote-definition footnote-reference info))
(n (org-export-get-footnote-number footnote-reference info))
(data (org-trim (org-export-data raw info))))
(setq ref-id (plist-get (nth 1 footnote-reference) :label))
(data (org-trim (org-export-data raw info)))
(ref-id (plist-get (nth 1 footnote-reference) :label)))
;;
;; It is a reference
;;
(if (string-match "fn:rl" ref-id)
(if (member ref-id registered-references)
(if (member ref-id org-e-groff-registered-references)
(format "\\*[%s]" ref-id)
(let ()
(push ref-id registered-references)
(format "\\*(Rf\n.RS \"%s\" \n%s\n.RF\n" ref-id data)) )
(progn
(push ref-id org-e-groff-registered-references)
(format "\\*(Rf\n.RS \"%s\" \n%s\n.RF\n" ref-id data)))
;;
;; else it is a footnote
;;
(format "\\u\\s-2%s\\d\\s+2\n.FS %s\n%s\n.FE\n" n n data))
))
(format "\\u\\s-2%s\\d\\s+2\n.FS %s\n%s\n.FE\n" n n data))))
;;;; Headline
@ -946,10 +930,10 @@ holding contextual information."
;; Section formatting will set two placeholders: one for the
;; title and the other for the contents.
(classes (assoc class org-e-groff-classes))
(classes-options (car (last classes)) )
(heading-option (plist-get classes-options :heading ) )
(classes-options (car (last classes)))
(heading-option (plist-get classes-options :heading))
(section-fmt
(let ()
(progn
(cond
((and (symbolp heading-option)
(fboundp heading-option))
@ -1025,12 +1009,12 @@ holding contextual information."
(if (not (org-export-last-sibling-p headline info)) low-level-body
(replace-regexp-in-string
"[ \t\n]*\\'"
(concat "\n.LE" )
(concat "\n.LE")
low-level-body))))
;; Case 3. Standard headline. Export it as a section.
(t
(format section-fmt full-text
(concat headline-label pre-blanks contents)) ))))
(concat headline-label pre-blanks contents))))))
;;;; Horizontal Rule
@ -1052,11 +1036,11 @@ contextual information."
(org-e-groff-source-highlight
(let* ((tmpdir (if (featurep 'xemacs)
temp-directory
temporary-file-directory ))
temporary-file-directory))
(in-file (make-temp-name
(expand-file-name "srchilite" tmpdir)) )
(expand-file-name "srchilite" tmpdir)))
(out-file (make-temp-name
(expand-file-name "reshilite" tmpdir)) )
(expand-file-name "reshilite" tmpdir)))
(org-lang (org-element-property :language inline-src-block))
(lst-lang (cadr (assq (intern org-lang)
org-e-groff-source-highlight-langs)))
@ -1065,27 +1049,22 @@ contextual information."
" -s " lst-lang
" -f groff_mm_color "
" -i " in-file
" -o " out-file
)
))
" -o " out-file)))
(if lst-lang
(let ((code-block "" ))
(let ((code-block ""))
(with-temp-file in-file (insert code))
(shell-command cmd)
(setq code-block (org-file-contents out-file) )
(setq code-block (org-file-contents out-file))
(delete-file in-file)
(delete-file out-file)
code-block)
(format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n"
code))
))
code))))
;; Do not use a special package: transcode it verbatim.
(t
(concat ".DS I\n" "\\fC" code "\\fP\n.DE\n"))
)))
(concat ".DS I\n" "\\fC" code "\\fP\n.DE\n")))))
;;;; Inlinetask
@ -1157,7 +1136,7 @@ contextual information."
(checkbox (case (org-element-property :checkbox item)
(on "\\o'\\(sq\\(mu'")
(off "\\(sq")
(trans "\\o'\\(sq\\(mi'" )))
(trans "\\o'\\(sq\\(mi'")))
(tag (let ((tag (org-element-property :tag item)))
;; Check-boxes must belong to the tag.
@ -1169,21 +1148,18 @@ contextual information."
((or checkbox tag)
(concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\""
"\n"
(org-trim (or contents " " ) )) )
(org-trim (or contents " "))))
((eq type 'ordered)
(concat ".LI"
"\n"
(org-trim (or contents " " ) )))
(org-trim (or contents " "))))
(t
(let* ((bullet (org-trim bullet))
(marker (cond ((string= "-" bullet) "\\(em")
((string= "*" bullet) "\\(bu")
(t "\\(dg") ) ))
(t "\\(dg"))))
(concat ".LI " marker "\n"
(org-trim (or contents " " ) )))))
))
(org-trim (or contents " " ))))))))
;;;; Keyword
@ -1249,45 +1225,32 @@ 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)"
(attr (read (format "(%s)"
(mapconcat
#'identity
(org-element-property :attr_groff parent)
" "))))
;; Retrieve groff attributes from the element around.
;; Attributes are going to be
;; :position (left|center|right)
;; :width id
;; :height id
)
;; Now clear ATTR from any special keyword and set a default
;; value if nothing is left.
(setq placement
(placement
(case (plist-get attr :position)
('center "")
('left "-L")
('right "-R")
(t "")))
(setq width (or (plist-get attr :width) "") )
(setq height (or (plist-get attr :height) "" ) )
(width (or (plist-get attr :width) ""))
(height (or (plist-get attr :height) ""))
(setq disable-caption (plist-get attr :disable-caption))
(disable-caption (plist-get attr :disable-caption))
(setq caption
(caption
(org-e-groff--caption/label-string
(org-element-property :caption parent)
(org-element-property :name parent)
info)
)
info)))
;;
;; Now clear ATTR from any special keyword and set a default
;; value if nothing is left.
;;
;; Return proper string.
;;
@ -1295,12 +1258,11 @@ used as a communication channel."
(concat
(cond
((string-match ".\.pic$" raw-path)
(format "\n.PS\ncopy \"%s\"\n.PE" raw-path ))
((string-match ".\.pic$" path)
(format "\n.PS\ncopy \"%s\"\n.PE" path))
(t (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE "
placement raw-path width height )))
(unless disable-caption (format "\n.FG \"%s\"" caption )))
))
placement path width height)))
(unless disable-caption (format "\n.FG \"%s\"" caption)))))
@ -1331,17 +1293,20 @@ INFO is a plist holding contextual information. See
(cond
;; Image file.
(imagep (org-e-groff-link--inline-image link info))
;; import groff files
((and (string= type "file")
(string-match ".\.groff$" raw-path))
(concat ".so " raw-path "\n"))
;; Radio link: Transcode target's contents and use them as link's
;; description.
((string= type "radio")
(let ((destination (org-export-resolve-radio-link link info)))
(when destination
(format "\\fI [%s] \\fP"
(org-export-solidify-link-text path) ))))
(org-export-solidify-link-text path)))))
;; Links pointing to an headline: Find destination and build
;; appropriate referencing command.
((member type '("custom-id" "fuzzy" "id"))
@ -1385,7 +1350,6 @@ INFO is a plist holding contextual information. See
;; No path, only description. Try to do something useful.
(t (format org-e-groff-link-with-unknown-path-format desc)))))
;;;; Macro
(defun org-e-groff-macro (macro contents info)
@ -1401,35 +1365,32 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode a PARAGRAPH element from Org to Groff.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
(setq parent (plist-get (nth 1 paragraph) :parent))
(let ((parent (plist-get (nth 1 paragraph) :parent)))
(when parent
(let* ((parent-type (car parent))
(fixed-paragraph "")
(class (plist-get info :groff-class))
(class-options (plist-get info :groff-class-options))
(classes (assoc class org-e-groff-classes))
(classes-options (car (last classes)) )
(paragraph-option (plist-get classes-options :paragraph ) ))
(classes-options (car (last classes)))
(paragraph-option (plist-get classes-options :paragraph)))
(cond
((and (symbolp paragraph-option)
(fboundp paragraph-option))
(funcall paragraph-option parent-type parent contents))
((and (eq parent-type 'item)
(plist-get (nth 1 parent) :bullet ) )
(setq fixed-paragraph (concat "" contents)) )
(plist-get (nth 1 parent) :bullet))
(setq fixed-paragraph (concat "" contents)))
((eq parent-type 'section)
(setq fixed-paragraph (concat ".P\n" contents) ) )
(setq fixed-paragraph (concat ".P\n" contents)))
((eq parent-type 'footnote-definition)
(setq fixed-paragraph (concat "" contents) ))
(setq fixed-paragraph (concat "" contents)))
(t (setq fixed-paragraph (concat "" contents)) )
)
fixed-paragraph)
)
)
(t (setq fixed-paragraph (concat "" contents))))
fixed-paragraph))))
;;;; Plain List
@ -1448,9 +1409,7 @@ contextual information."
((eq type 'descriptive) ".VL 2.0i"))))
(org-e-groff--wrap-label
plain-list
(format "%s\n%s\n.LE"
groff-type
contents ))))
(format "%s\n%s\n.LE" groff-type contents))))
;;;; Plain Text
@ -1472,9 +1431,7 @@ contextual information."
(dolist (special-char-list org-e-groff-special-char)
(setq text
(replace-regexp-in-string (car special-char-list)
(cdr special-char-list) text ))
)
)
(cdr special-char-list) text))))
;; Handle Special Characters
@ -1604,13 +1561,11 @@ contextual information."
(new 0)))
(retain-labels (org-element-property :retain-labels src-block))
(attr
(read
(format "(%s)"
(read (format "(%s)"
(mapconcat #'identity
(org-element-property :attr_groff src-block)
" ")))))
(setq disable-caption (plist-get attr :disable-caption))
" "))))
(disable-caption (plist-get attr :disable-caption)))
(cond
;; Case 1. No source fontification.
@ -1619,46 +1574,39 @@ contextual information."
(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 )))))
(unless disable-caption (format ".EX \"%s\" " caption-str)))))
( (and org-e-groff-source-highlight)
((and org-e-groff-source-highlight)
(let* ((tmpdir (if (featurep 'xemacs)
temp-directory
temporary-file-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)) )
(expand-file-name "srchilite" tmpdir)))
(out-file (make-temp-name
(expand-file-name "reshilite" tmpdir)) )
(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)) )
org-e-groff-source-highlight-langs)))
(cmd (concat "source-highlight"
" -s " lst-lang
" -f groff_mm_color "
" -i " in-file
" -o " out-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) )
(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) )
)
))
)))
(unless disable-caption (format ".EX \"%s\" " caption-str))))))))
;;;; Statistics Cookie
@ -1711,14 +1659,10 @@ contextual information."
(cond
;; Case 1: verbatim table.
((or org-e-groff-tables-verbatim
(let ((attr
(read
(format
"(%s)"
(let ((attr (read (format "(%s)"
(mapconcat
#'identity
(org-element-property :attr_groff table)
" ")))) )
(org-element-property :attr_groff table) " ")))))
(and attr (plist-get attr :verbatim))))
@ -1727,6 +1671,7 @@ contextual information."
(org-trim
(org-element-interpret-data
`(table nil ,@(org-element-contents table))))))
;; Case 2: Standard table.
(t (org-e-groff-table--org-table table contents info))))
@ -1734,20 +1679,15 @@ contextual information."
"Return an appropriate Groff alignment string.
TABLE is the considered table. INFO is a plist used as
a communication channel."
(let ((attr
(read
(format
"(%s)"
(mapconcat
#'identity
(let* ((attr (read (format "(%s)"
(mapconcat #'identity
(org-element-property :attr_groff table)
" ")))))
(setq align
" "))))
(align
(case (plist-get attr :align)
('center "c")
('left "l")
('right "r")))
('right "r"))))
(let (alignment)
;; Extract column groups and alignment from first (non-rule)
@ -1763,23 +1703,21 @@ a communication channel."
(let* ((borders (org-export-table-cell-borders cell info))
(raw-width (org-export-table-cell-width cell info))
(width-cm (when raw-width (/ raw-width 5)))
(width (if raw-width (format "w(%dc)" (if (< width-cm 1) 1 width-cm)) "") ))
(width (if raw-width (format "w(%dc)" (if (< width-cm 1) 1 width-cm)) "")))
;; Check left border for the first cell only.
(when (and (memq 'left borders) (not alignment))
(push "|" alignment))
(push
(if (not align)
(case (org-export-table-cell-alignment cell info)
(left (concat "l" width divider) )
(left (concat "l" width divider))
(right (concat "r" width divider))
(center (concat "c" width divider)))
(concat align divider))
alignment)
(when (memq 'right borders) (push "|" alignment))))
info)
(apply 'concat (reverse alignment)))
))
(apply 'concat (reverse alignment)))))
(defun org-e-groff-table--org-table (table contents info)
"Return appropriate Groff code for an Org table.
@ -1792,12 +1730,8 @@ 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
(attr (read (format "(%s)"
(mapconcat #'identity
(org-element-property :attr_groff table)
" "))))
@ -1808,20 +1742,14 @@ This function assumes TABLE has `org' as its `:type' attribute."
;; Determine alignment string.
(alignment (org-e-groff-table--align-string divider table info))
;; Extract others display options.
(lines (org-split-string contents "\n"))
)
;; Prepare the final format string for the table.
(setq lines (org-split-string contents "\n"))
(setq attr-list
(attr-list
(let ((result-list '()))
(dolist (attr-item
(list
(if (plist-get attr :expand)
"expand"
nil
)
"expand" nil)
(case (plist-get attr :placement)
('center "center")
@ -1829,40 +1757,37 @@ This function assumes TABLE has `org' as its `:type' attribute."
(t
(if org-e-groff-tables-centered
"center"
"" )))
"")))
(case (plist-get attr :boxtype)
('box "box")
('doublebox "doublebox")
('allbox "allbox")
('none nil)
(t "box"))
))
(t "box"))))
(if (not (null attr-item))
(add-to-list 'result-list attr-item)
))
result-list ))
(add-to-list 'result-list attr-item)))
result-list))
(title-line (plist-get attr :title-line))
(disable-caption (plist-get attr :disable-caption))
(long-cells (plist-get attr :long-cells))
(setq title-line (plist-get attr :title-line))
(setq disable-caption (plist-get attr :disable-caption))
(setq long-cells (plist-get attr :long-cells))
(setq table-format (concat
(table-format
(concat
(format "%s"
(or (car attr-list) "" ))
(or (car attr-list) ""))
(or
(let ((output-list '()))
(when (cdr attr-list)
(dolist (attr-item (cdr attr-list))
(setq output-list (concat output-list (format ",%s" attr-item )) ) ))
output-list)
"") ))
(setq output-list (concat output-list (format ",%s" attr-item)))))
output-list) "")))
(when lines
(setq first-line (org-split-string (car lines) "\t")))
(first-line
(when lines (org-split-string (car lines) "\t"))))
;; Prepare the final format string for the table.
(cond
;; Others.
@ -1872,19 +1797,20 @@ This function assumes TABLE has `org' as its `:type' attribute."
(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 "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 ))
final-line))
(format "%s\n.TE\n"
(let ((final-line ""))
(setq lines (org-split-string contents "\n"))
(let ((final-line "")
(long-line ""))
(dolist (line-item lines)
(setq long-line "")
@ -1892,26 +1818,23 @@ This function assumes TABLE has `org' as its `:type' attribute."
(if (string= line-item "_")
(setq long-line (format "%s\n" line-item))
;; else
(let ((cell-item-list (org-split-string line-item "\t") ))
(dolist (cell-item cell-item-list)
(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 ) )))
(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 ) ))
)))
(setq long-line (concat long-line (format "T{\n%s\nT}\t" cell-item))))))
long-line)
(setq final-line (concat final-line long-line )))
(setq final-line (concat final-line long-line)))
;; else
(setq final-line (concat final-line line-item "\n"))
)
) final-line))
(setq final-line (concat final-line line-item "\n")))) final-line))
(if (not disable-caption)
(format ".TB \"%s\""
caption)
"") )))))
(format ".TB \"%s\"" caption)
""))))))
;;;; Table Cell
@ -1919,7 +1842,6 @@ This function assumes TABLE has `org' as its `:type' attribute."
"Transcode a TABLE-CELL element from Org to Groff
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
(let* ()
(concat (if (and contents
org-e-groff-table-scientific-notation
(string-match orgtbl-exp-regexp contents))
@ -1928,10 +1850,8 @@ a communication channel."
(format org-e-groff-table-scientific-notation
(match-string 1 contents)
(match-string 2 contents))
contents )
(when (org-export-get-next-element table-cell info) "\t"))
)
)
contents)
(when (org-export-get-next-element table-cell info) "\t")))
;;;; Table Row
@ -1955,7 +1875,7 @@ a communication channel."
;; Mark "hline" for horizontal lines.
(cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
contents
;;; "\\\\\n"
(cond
;; When BOOKTABS are activated enforce bottom rule even when
;; no hline was specifically marked.
@ -2044,10 +1964,10 @@ When optional argument PUB-DIR is set, use it as the publishing
directory.
Return output file's name."
(setq registered-references '())
(interactive)
(setq org-e-groff-registered-references '())
(let ((outfile (org-export-output-file-name ".groff" subtreep pub-dir)))
(org-export-to-file
'e-groff outfile subtreep visible-only body-only ext-plist)))
@ -2147,7 +2067,7 @@ none."
(save-excursion
(goto-char (point-max))
;; Find final run
nil )))
nil)))
(provide 'org-e-groff)

View File

@ -35,7 +35,7 @@
;; It introduces one new buffer keywords:
;; "MAN_CLASS_OPTIONS".
;;; Code:
;;;; Code:
(require 'org-export)
@ -47,7 +47,9 @@
;;; Define Back-End
;;;; Define Back-End
(defvar org-e-man-translate-alist
'((babel-call . org-e-man-babel-call)
@ -116,13 +118,16 @@ structure of the values.")
;;; User Configurable Variables
(defgroup org-export-e-man nil
"Options for exporting Org mode files to Man."
:tag "Org Export Man"
:group 'org-export)
;;;; Tables
@ -136,7 +141,6 @@ structure of the values.")
:group 'org-export-e-man
:type 'boolean)
(defcustom org-e-man-table-scientific-notation "%sE%s"
"Format string to display numbers in scientific notation.
The format should have \"%s\" twice, for mantissa and exponent
@ -150,6 +154,8 @@ When nil, no transformation is made."
;;;; Inlinetasks
;; Src blocks
(defcustom org-e-man-source-highlight nil
@ -157,10 +163,8 @@ When nil, no transformation is made."
:group 'org-export-e-man
:type 'boolean)
(defcustom org-e-man-source-highlight-langs
'(
(emacs-lisp "lisp") (lisp "lisp") (clojure "lisp")
'((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp")
(scheme "scheme")
(c "c") (cc "cpp") (csharp "csharp") (d "d")
(fortran "fortran") (cobol "cobol") (pascal "pascal")
@ -177,8 +181,7 @@ When nil, no transformation is made."
(ldap "ldap") (opa "opa")
(php "php") (postscript "postscript") (prolog "prolog")
(properties "properties") (makefile "makefile")
(tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg")
)
(tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
"Alist mapping languages to their listing language counterpart.
The key is a symbol, the major mode symbol without the \"-mode\".
The value is the string that should be inserted as the language
@ -192,7 +195,6 @@ in this list - but it does not hurt if it is present."
(string :tag "Listings language"))))
(defvar org-e-man-custom-lang-environments nil
"Alist mapping languages to language-specific Man environments.
@ -204,9 +206,7 @@ man packages. For example,
would have the effect that if org encounters begin_src python
during man export."
)
)
;;;; Plain text
@ -250,8 +250,7 @@ string defines the replacement string for this quote."
(defcustom org-e-man-pdf-process
'("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
"tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
"tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
)
"tbl %f | eqn | groff -man | ps2pdf - > %b.pdf")
"Commands to process a Man file to a PDF file.
This is a list of strings, each of them will be given to the
@ -271,7 +270,7 @@ its single argument."
(string :tag "Shell command"))
(const :tag "2 runs of pdfgroff"
("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
"tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" ))
"tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"))
(const :tag "3 runs of pdfgroff"
("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
"tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
@ -294,6 +293,7 @@ These are the .aux, .log, .out, and .toc files."
;; Preamble
;; Adding MAN as a block parser to make sure that its contents
;; does not execute
@ -302,9 +302,10 @@ These are the .aux, .log, .out, and .toc files."
;;; Internal Functions
;;; Internal Functions
(defun org-e-man--caption/label-string (caption label info)
"Return caption and label Man string for floats.
@ -316,7 +317,7 @@ information.
If there's no caption nor label, return the empty string.
For non-floats, see `org-e-man--wrap-label'."
(let ((label-str "" ))
(let ((label-str ""))
(cond
((and (not caption) (not label)) "")
((not caption) (format "\\fI%s\\fP" label))
@ -328,11 +329,7 @@ For non-floats, see `org-e-man--wrap-label'."
(org-export-data (car caption) info)))
;; Standard caption format.
(t (format "\\fR%s\\fP"
(org-export-data (car caption) info)))))
)
(org-export-data (car caption) info))))))
(defun org-e-man--quotation-marks (text info)
"Export quotation marks depending on language conventions.
@ -358,46 +355,42 @@ This function shouldn't be used for floats. See
(concat (format "%s\n.br\n" label) output))))
;;; Template
(defun org-e-man-template (contents info)
"Return complete document string after Man conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(let ((title (org-export-data (plist-get info :title) info))
(let* ((title (org-export-data (plist-get info :title) info))
(attr
(read
(format
"(%s)"
(read (format "(%s)"
(mapconcat
#'identity
(list (plist-get info :man-class-options))
" ")))) )
(setq section-item (plist-get attr :section-id))
" "))))
(section-item (plist-get attr :section-id)))
(concat
(cond
((and title (stringp section-item))
(format ".TH \"%s\" \"%s\" \n" title section-item )
)
(format ".TH \"%s\" \"%s\" \n" title section-item))
((and (string= "" title) (stringp section-item))
(format ".TH \"%s\" \"%s\" \n" " " section-item )
)
(format ".TH \"%s\" \"%s\" \n" " " section-item))
(title
(format ".TH \"%s\" \"1\" \n" title )
)
(format ".TH \"%s\" \"1\" \n" title))
(t
".TH \" \" \"1\" "))
contents )))
contents)))
;;; Transcode Functions
;;;; Babel Call
;;
;; Babel Calls are ignored.
@ -407,7 +400,7 @@ holding export options."
"Transcode BOLD from Org to Man.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
(format "\\fB%s\\fP" contents) )
(format "\\fB%s\\fP" contents))
;;;; Center Block
@ -419,7 +412,7 @@ holding contextual information."
(org-e-man--wrap-label
center-block
(format ".ce %d\n.nf\n%s\n.fi"
(- (length (split-string contents "\n")) 1 )
(- (length (split-string contents "\n")) 1)
contents)))
@ -429,7 +422,7 @@ holding contextual information."
"Transcode a CLOCK element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual
information."
"" )
"")
;;;; Code
@ -438,16 +431,14 @@ information."
"Transcode a CODE object from Org to Man.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(format "\\fC%s\\fP" code) )
(format "\\fC%s\\fP" code))
;;;; Comment
;;
;; Comments are ignored.
;;;; Comment Block
;;
;; Comment Blocks are ignored.
@ -488,8 +479,8 @@ information."
(org-e-man--wrap-label
example-block
(format ".RS\n.nf\n%s\n.fi\n.RE"
(org-export-format-code-default example-block info))
))
(org-export-format-code-default example-block info))))
;;;; Export Block
(defun org-e-man-export-block (export-block contents info)
@ -521,11 +512,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Footnote Definition
;;
;; Footnote Definitions are ignored.
;;;; Footnote References
;;
;; Footnote References are Ignored
@ -544,12 +533,13 @@ holding contextual information."
(1 ".SH \"%s\"\n%s")
(2 ".SS \"%s\"\n%s")
(3 ".SS \"%s\"\n%s")
(t nil)) )
(text (org-export-data (org-element-property :title headline) info)) )
(t nil)))
(text (org-export-data (org-element-property :title headline) info)))
(cond
;; Case 1: This is a footnote section: ignore it.
((org-element-property :footnote-section-p headline) nil)
;; Case 2. This is a deep sub-tree: export it as a list item.
;; Also export as items headlines for which no section
;; format has been found.
@ -570,16 +560,19 @@ holding contextual information."
(replace-regexp-in-string
"[ \t\n]*\\'" ""
low-level-body))))
;; Case 3. Standard headline. Export it as a section.
(t (format section-fmt text contents )))))
(t (format section-fmt text contents)))))
;;;; Horizontal Rule
;; Not supported
;;;; Inline Babel Call
;;
;; Inline Babel Calls are ignored.
;;;; Inline Src Block
(defun org-e-man-inline-src-block (inline-src-block contents info)
@ -591,11 +584,11 @@ contextual information."
(org-e-man-source-highlight
(let* ((tmpdir (if (featurep 'xemacs)
temp-directory
temporary-file-directory ))
temporary-file-directory))
(in-file (make-temp-name
(expand-file-name "srchilite" tmpdir)) )
(expand-file-name "srchilite" tmpdir)))
(out-file (make-temp-name
(expand-file-name "reshilite" tmpdir)) )
(expand-file-name "reshilite" tmpdir)))
(org-lang (org-element-property :language inline-src-block))
(lst-lang (cadr (assq (intern org-lang)
org-e-man-source-highlight-langs)))
@ -604,28 +597,23 @@ contextual information."
" -s " lst-lang
" -f groff_man"
" -i " in-file
" -o " out-file
)
))
" -o " out-file)))
(if lst-lang
(let ((code-block "" ))
(let ((code-block ""))
(with-temp-file in-file (insert code))
(shell-command cmd)
(setq code-block (org-file-contents out-file) )
(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\n"
code))
))
code))))
;; Do not use a special package: transcode it verbatim.
(t
(concat ".RS\n.nf\n" "\\fC" "\n" code "\n"
"\\fP\n.fi\n.RE\n"))
)))
"\\fP\n.fi\n.RE\n")))))
;;;; Inlinetask
@ -640,10 +628,8 @@ contextual information."
;;;; Item
(defun org-e-man-item (item contents info)
"Transcode an ITEM element from Org to Man.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
@ -662,7 +648,7 @@ contextual information."
(checkbox (case (org-element-property :checkbox item)
(on "\\o'\\(sq\\(mu'") ;;
(off "\\(sq ") ;;
(trans "\\o'\\(sq\\(mi'" ))) ;;
(trans "\\o'\\(sq\\(mi'"))) ;;
(tag (let ((tag (org-element-property :tag item)))
;; Check-boxes must belong to the tag.
@ -670,28 +656,23 @@ contextual information."
(concat checkbox
(org-export-data tag info)))))))
(if (and (null tag )
(if (and (null tag)
(null checkbox))
(let* ((bullet (org-trim bullet))
(marker (cond ((string= "-" bullet) "\\(em")
((string= "*" bullet) "\\(bu")
((eq type 'ordered)
(format "%s " (org-trim bullet)))
(t "\\(dg") ) ))
(t "\\(dg"))))
(concat ".IP " marker " 4\n"
(org-trim (or contents " " ) )))
(org-trim (or contents " "))))
; else
(concat ".TP\n" (or tag (concat " " checkbox)) "\n"
(org-trim (or contents " " ) )
;; If there are footnotes references in tag, be sure to
;; add their definition at the end of the item. This
)) ))
(org-trim (or contents " "))))))
;;;; Keyword
(defun org-e-man-keyword (keyword contents info)
"Transcode a KEYWORD element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
@ -702,7 +683,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string= key "INDEX") nil)
;; Invisible targets.
((string= key "TARGET") nil)
((string= key "TOC" ) nil))))
((string= key "TOC") nil))))
;;;; Man Environment
@ -743,7 +724,6 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Link
(defun org-e-man-link (link desc info)
"Transcode a LINK object from Org to Man.
@ -773,9 +753,7 @@ INFO is a plist holding contextual information. See
;; External link without a description part.
(path (format "\\fI%s\\fP" path))
;; No path, only description. Try to do something useful.
(t (format "\\fI%s\\fP" desc))
)
))
(t (format "\\fI%s\\fP" desc)))))
;;;; Macro
@ -793,22 +771,19 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode a PARAGRAPH element from Org to Man.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
(setq parent (plist-get (nth 1 paragraph) :parent))
(let ((parent (plist-get (nth 1 paragraph) :parent)))
(when parent
(let ((parent-type (car parent))
(fixed-paragraph ""))
(cond ((and (eq parent-type 'item)
(plist-get (nth 1 parent) :bullet ) )
(setq fixed-paragraph (concat "" contents)) )
(plist-get (nth 1 parent) :bullet))
(setq fixed-paragraph (concat "" contents)))
((eq parent-type 'section)
(setq fixed-paragraph (concat ".PP\n" contents) ) )
(setq fixed-paragraph (concat ".PP\n" contents)))
((eq parent-type 'footnote-definition)
(setq fixed-paragraph contents))
(t (setq fixed-paragraph (concat "" contents) ) )
)
fixed-paragraph)
)
)
(t (setq fixed-paragraph (concat "" contents))))
fixed-paragraph))))
;;;; Plain List
@ -820,7 +795,6 @@ contextual information."
contents)
;;;; Plain Text
(defun org-e-man-plain-text (text info)
@ -844,10 +818,8 @@ contextual information."
text)
;;;; Planning
;;;; Property Drawer
@ -861,6 +833,7 @@ holding contextual information."
quote-block
(format ".RS\n%s\n.RE" contents)))
;;;; Quote Section
(defun org-e-man-quote-section (quote-section contents info)
@ -877,7 +850,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode a RADIO-TARGET object from Org to Man.
TEXT is the text of the target. INFO is a plist holding
contextual information."
text )
text)
;;;; Section
@ -928,44 +901,37 @@ contextual information."
(or float-env "%s")
(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)
(org-export-format-code-default src-block info))))))
((and org-e-man-source-highlight)
(let* ((tmpdir (if (featurep 'xemacs)
temp-directory
temporary-file-directory ))
temporary-file-directory))
(in-file (make-temp-name
(expand-file-name "srchilite" tmpdir)) )
(expand-file-name "srchilite" tmpdir)))
(out-file (make-temp-name
(expand-file-name "reshilite" tmpdir)) )
(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)) )
org-e-man-source-highlight-langs)))
(cmd (concat "source-highlight"
" -s " lst-lang
" -f groff_man "
" -i " in-file
" -o " out-file
)
))
" -o " out-file)))
(if lst-lang
(let ((code-block "" ))
(let ((code-block ""))
(with-temp-file in-file (insert code))
(shell-command cmd)
(setq code-block (org-file-contents out-file) )
(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))
)
)
)))
code)))))))
;;;; Statistics Cookie
@ -984,6 +950,7 @@ CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
(format "\\fI%s\\fP" contents))
;;;; Subscript
(defun org-e-man-subscript (subscript contents info)
@ -992,6 +959,7 @@ CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
(format "\\d\\s-2%s\\s+2\\u" contents))
;;;; Superscript "^_%s$
(defun org-e-man-superscript (superscript contents info)
@ -1026,7 +994,7 @@ contextual information."
(mapconcat
#'identity
(org-element-property :attr_man table)
" ")))) )
" ")))))
(and attr (plist-get attr :verbatim))))
@ -1042,20 +1010,20 @@ contextual information."
"Return an appropriate Man alignment string.
TABLE is the considered table. INFO is a plist used as
a communication channel."
(let ((attr
(let* ((attr
(read
(format
"(%s)"
(mapconcat
#'identity
(org-element-property :attr_man table)
" ")))))
" "))))
(setq align
(align
(case (plist-get attr :align)
('center "c")
('left "l")
('right "r")))
('right "r"))))
(let (alignment)
;; Extract column groups and alignment from first (non-rule)
@ -1071,23 +1039,22 @@ a communication channel."
(let* ((borders (org-export-table-cell-borders cell info))
(raw-width (org-export-table-cell-width cell info))
(width-cm (when raw-width (/ raw-width 5)))
(width (if raw-width (format "w(%dc)" (if (< width-cm 1) 1 width-cm)) "") ))
(width (if raw-width (format "w(%dc)"
(if (< width-cm 1) 1 width-cm)) "")))
;; Check left border for the first cell only.
(when (and (memq 'left borders) (not alignment))
(push "|" alignment))
(push
(if (not align)
(case (org-export-table-cell-alignment cell info)
(left (concat "l" width divider) )
(left (concat "l" width divider))
(right (concat "r" width divider))
(center (concat "c" width divider)))
(concat align divider))
alignment)
(when (memq 'right borders) (push "|" alignment))))
info)
(apply 'concat (reverse alignment)))
))
(apply 'concat (reverse alignment)))))
(defun org-e-man-table--org-table (table contents info)
"Return appropriate Man code for an Org table.
@ -1116,59 +1083,52 @@ This function assumes TABLE has `org' as its `:type' attribute."
;; Determine alignment string.
(alignment (org-e-man-table--align-string divider table info))
;; Extract others display options.
(lines (org-split-string contents "\n"))
)
;; Prepare the final format string for the table.
(setq lines (org-split-string contents "\n"))
(setq attr-list
(attr-list
(let ((result-list '()))
(dolist (attr-item
(list
(if (plist-get attr :expand)
"expand"
nil
)
nil)
(case (plist-get attr :placement)
('center "center")
('left nil)
(t
(if org-e-man-tables-centered
"center"
"" )))
"center" "")))
(case (plist-get attr :boxtype)
('box "box")
('doublebox "doublebox")
('allbox "allbox")
('none nil)
(t "box"))
))
(t "box"))))
(if attr-item
(add-to-list 'result-list attr-item)
))
result-list ))
(add-to-list 'result-list attr-item)))
result-list))
(setq title-line (plist-get attr :title-line))
(title-line (plist-get attr :title-line))
(setq table-format (concat
(table-format
(concat
(format "%s"
(or (car attr-list) "" ))
(or (car attr-list) ""))
(or
(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)
"") ))
"")))
(when lines
(setq first-line (org-split-string (car lines) "\t")))
(first-line
(when lines (org-split-string (car lines) "\t"))))
;; Prepare the final format string for the table.
(cond
;; Others.
@ -1179,15 +1139,15 @@ This function assumes TABLE has `org' as its `:type' attribute."
(when title-line
(dotimes (i (length first-line))
(setq final-line (concat final-line "cb" divider))
))
(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 ))
final-line))
(format "%s.TE"
(let ((final-line ""))
(dolist (line-item lines)
@ -1196,13 +1156,9 @@ This function assumes TABLE has `org' as its `:type' attribute."
(setq lines (org-split-string contents "\n"))
(setq final-line (concat final-line
(car (org-split-string line-item "\\\\")) "\n"))
)
)
(car (org-split-string line-item "\\\\")) "\n")))))
final-line)))))))
) final-line) )
)))))
;;;; Table Cell
@ -1266,7 +1222,7 @@ information."
"Transcode a TIMESTAMP object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual
information."
"" )
"")
;;;; Underline
@ -1429,7 +1385,7 @@ none."
(save-excursion
(goto-char (point-max))
;; Find final run
nil )))
nil)))
(provide 'org-e-man)

View File

@ -20677,11 +20677,11 @@ This puts point at the start of the current subtree, and mark at
the end. If a numeric prefix UP is given, move up into the
hierarchy of headlines by UP levels before marking the subtree."
(interactive "P")
(when (org-with-limited-levels (org-before-first-heading-p))
(error "Not currently in a subtree"))
(if (org-at-heading-p) (beginning-of-line)
(org-with-limited-levels (outline-previous-visible-heading 1)))
(when up (dotimes (c (abs up)) (ignore-errors (org-element-up))))
(org-with-limited-levels
(cond ((org-at-heading-p) (beginning-of-line))
((org-before-first-heading-p) (error "Not in a subtree"))
(t (outline-previous-visible-heading 1))))
(when up (while (and (> up 0) (org-up-heading-safe)) (decf up)))
(org-element-mark-element))
;;; Indentation

View File

@ -363,9 +363,18 @@ http://article.gmane.org/gmane.emacs.orgmode/21459/"
(progn (transient-mark-mode 1)
(forward-line 2)
(org-mark-subtree 1)
(list (region-beginning) (region-end)))))))
(list (region-beginning) (region-end))))))
;; Do not get fooled with inlinetasks.
(when (featurep 'org-inlinetask)
(should
(= 1
(org-test-with-temp-text "* Headline\n*************** Task\nContents"
(progn (transient-mark-mode 1)
(forward-line 1)
(let ((org-inlinetask-min-level 15)) (org-mark-subtree))
(region-beginning))))))
(provide 'test-org)
(provide 'test-org))
;;; test-org.el ends here