From 4e36b533e06d3efc7209eebdaec73f43b91bb22c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 9 Dec 2011 14:38:36 +0100 Subject: [PATCH] Code indentation fix (tabify) --- EXPERIMENTAL/org-latex.el | 1214 ++++++------- contrib/lisp/org-element.el | 3360 +++++++++++++++++------------------ contrib/lisp/org-export.el | 1306 +++++++------- 3 files changed, 2940 insertions(+), 2940 deletions(-) diff --git a/EXPERIMENTAL/org-latex.el b/EXPERIMENTAL/org-latex.el index 61cfa7c5d..17e6c76fb 100644 --- a/EXPERIMENTAL/org-latex.el +++ b/EXPERIMENTAL/org-latex.el @@ -164,19 +164,19 @@ the headline should be numbered. It must return a format string in which the section title will be added." :group 'org-export-latex :type '(repeat - (list (string :tag "LaTeX class") - (string :tag "LaTeX header") - (repeat :tag "Levels" :inline t - (choice - (cons :tag "Heading" - (string :tag " numbered") - (string :tag "unnumbered")) - (list :tag "Environment" - (string :tag "Opening (numbered)") - (string :tag "Closing (numbered)") - (string :tag "Opening (unnumbered)") - (string :tag "Closing (unnumbered)")) - (function :tag "Hook computing sectioning")))))) + (list (string :tag "LaTeX class") + (string :tag "LaTeX header") + (repeat :tag "Levels" :inline t + (choice + (cons :tag "Heading" + (string :tag " numbered") + (string :tag "unnumbered")) + (list :tag "Environment" + (string :tag "Opening (numbered)") + (string :tag "Closing (numbered)") + (string :tag "Opening (unnumbered)") + (string :tag "Closing (unnumbered)")) + (function :tag "Hook computing sectioning")))))) (defcustom org-latex-inputenc-alist nil "Alist of inputenc coding system names, and what should really be used. @@ -188,9 +188,9 @@ will cause \\usepackage[utf8x]{inputenc} to be used for buffers that are written as utf8 files." :group 'org-export-latex :type '(repeat - (cons - (string :tag "Derived from buffer") - (string :tag "Use this instead")))) + (cons + (string :tag "Derived from buffer") + (string :tag "Use this instead")))) (defcustom org-latex-date-format "\\today" @@ -227,9 +227,9 @@ order to reproduce the default set-up: \(defun org-latex-format-headline-default \(todo todo-type priority text tags\) \"Default format function for an headline.\" \(concat \(when todo \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo\)\) - \(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\) - text - \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)" + \(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\) + text + \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)" :group 'org-export-latex :type 'function) @@ -374,20 +374,20 @@ in order to mimic default behaviour: \(defun org-latex-format-inlinetask-default \(todo type priority name tags contents\) \"Format an inline task element for LaTeX export.\" \(let \(\(full-title - \(concat - \(when todo \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo\)\) - \(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\) - title - \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)\) + \(concat + \(when todo \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo\)\) + \(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\) + title + \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)\) \(format \(concat \"\\\\begin{center}\\n\" - \"\\\\fbox{\\n\" - \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\" - \"%s\\n\\n\" - \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\" - \"%s\" - \"\\\\end{minipage}}\" - \"\\\\end{center}\"\) - full-title contents\)\)" + \"\\\\fbox{\\n\" + \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\" + \"%s\\n\\n\" + \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\" + \"%s\" + \"\\\\end{minipage}}\" + \"\\\\end{center}\"\) + full-title contents\)\)" :group 'org-export-latex :type 'function) @@ -424,9 +424,9 @@ pygments (http://pygments.org), and to configure the variable passed to pdflatex." :group 'org-export-latex :type '(choice - (const :tag "Use listings" t) - (const :tag "Use minted" 'minted) - (const :tag "Export verbatim" nil))) + (const :tag "Use listings" t) + (const :tag "Use minted" 'minted) + (const :tag "Export verbatim" nil))) (defcustom org-latex-listings-langs '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") @@ -447,9 +447,9 @@ the same, the language does not need an entry in this list - but it does not hurt if it is present." :group 'org-export-latex :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) (defcustom org-latex-listings-options nil "Association list of options for the latex listings package. @@ -470,9 +470,9 @@ Note that the same options will be applied to blocks of all languages." :group 'org-export-latex :type '(repeat - (list - (string :tag "Listings option name ") - (string :tag "Listings option value")))) + (list + (string :tag "Listings option name ") + (string :tag "Listings option value")))) (defcustom org-latex-minted-langs '((emacs-lisp "common-lisp") @@ -493,9 +493,9 @@ with: pygmentize -L lexers" :group 'org-export-latex :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Minted language")))) + (list + (symbol :tag "Major mode ") + (string :tag "Minted language")))) (defcustom org-latex-minted-options nil "Association list of options for the latex minted package. @@ -516,9 +516,9 @@ as the start of the minted environment. Note that the same options will be applied to blocks of all languages." :group 'org-export-latex :type '(repeat - (list - (string :tag "Minted option name ") - (string :tag "Minted option value")))) + (list + (string :tag "Minted option name ") + (string :tag "Minted option value")))) (defvar org-latex-custom-lang-environments nil "Association list mapping languages to language-specific latex @@ -554,15 +554,15 @@ for allowed characters before/after the quote, the second string defines the replacement string for this quote." :group 'org-export-latex :type '(list - (cons :tag "Opening quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")) - (cons :tag "Closing quote" - (string :tag "Regexp for char after ") - (string :tag "Replacement quote ")) - (cons :tag "Single quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")))) + (cons :tag "Opening quote" + (string :tag "Regexp for char before") + (string :tag "Replacement quote ")) + (cons :tag "Closing quote" + (string :tag "Regexp for char after ") + (string :tag "Replacement quote ")) + (cons :tag "Single quote" + (string :tag "Regexp for char before") + (string :tag "Replacement quote ")))) @@ -579,18 +579,18 @@ If there's no caption nor label, return the empty string. For non-floats, see `org-latex--wrap-label'." (let ((caption-str (and caption - (org-export-secondary-string - caption 'latex info))) - (label-str (if label (format "\\label{%s}" label) ""))) + (org-export-secondary-string + caption 'latex info))) + (label-str (if label (format "\\label{%s}" label) ""))) (cond ((and (not caption-str) (not label)) "") ((not caption-str) (format "\\label{%s}\n" label)) ;; Option caption format with short name. ((string-match "\\[\\([^][]*\\)\\]{\\([^{}]*\\)}" caption-str) (format "\\caption[%s]{%s%s}\n" - (org-match-string-no-properties 1 caption-str) - label-str - (org-match-string-no-properties 2 caption-str))) + (org-match-string-no-properties 1 caption-str) + label-str + (org-match-string-no-properties 2 caption-str))) ;; Standard caption format. (t (format "\\caption{%s%s}\n" label-str caption-str))))) @@ -601,24 +601,24 @@ HEADER is the LaTeX header string. Return the new header." (let* ((cs (or (ignore-errors - (latexenc-coding-system-to-inputenc - buffer-file-coding-system)) - "utf8"))) + (latexenc-coding-system-to-inputenc + buffer-file-coding-system)) + "utf8"))) (if (not cs) - header + header ;; First translate if that is requested. (setq cs (or (cdr (assoc cs org-latex-inputenc-alist)) cs)) ;; Then find the \usepackage statement and replace the option. (replace-regexp-in-string "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" - cs header t nil 1)))) + cs header t nil 1)))) (defun org-latex--find-verb-separator (s) "Return a character not used in string S. This is used to choose a separator for constructs like \\verb." (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) (defun org-latex--make-option-string (options) "Return a comma separated string of keywords and values. @@ -626,22 +626,22 @@ OPTIONS is an alist where the key is the options keyword as a string, and the value a list containing the keyword value, or nil." (mapconcat (lambda (pair) - (concat (first pair) - (when (> (length (second pair)) 0) - (concat "=" (second pair))))) - options - ",")) + (concat (first pair) + (when (> (length (second pair)) 0) + (concat "=" (second pair))))) + options + ",")) (defun org-latex--quotation-marks (text info) "Export quotation marks depending on language conventions." (mapc (lambda(l) - (let ((start 0)) - (while (setq start (string-match (car l) text start)) - (let ((new-quote (concat (match-string 1 text) (cdr l)))) - (setq text (replace-match new-quote t t text)))))) - (cdr (or (assoc (plist-get info :language) org-latex-quotes) - ;; Falls back on English. - (assoc "en" org-latex-quotes)))) + (let ((start 0)) + (while (setq start (string-match (car l) text start)) + (let ((new-quote (concat (match-string 1 text) (cdr l)))) + (setq text (replace-match new-quote t t text)))))) + (cdr (or (assoc (plist-get info :language) org-latex-quotes) + ;; Falls back on English. + (assoc "en" org-latex-quotes)))) text) (defun org-latex--wrap-label (element output) @@ -650,7 +650,7 @@ This function shouldn't be used for floats. See `org-latex--caption/label-string'." (let ((label (org-element-get-property :name element))) (if (or (not output) (not label) (string= output "") (string= label "")) - output + output (concat (format "\\label{%s}\n" label) output)))) @@ -662,43 +662,43 @@ This function shouldn't be used for floats. See CONTENTS is the transcoded contents string. INFO is a plist holding export options." (let ((title (org-export-secondary-string - (plist-get info :title) 'latex info))) + (plist-get info :title) 'latex info))) (concat ;; 1. Time-stamp. (and (plist-get info :time-stamp-file) - (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) + (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) ;; 2. Document class and packages. (let ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options))) + (class-options (plist-get info :latex-class-options))) (org-element-normalize-string - (let* ((header (nth 1 (assoc class org-latex-classes))) - (document-class-string - (and (stringp header) - (if class-options - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\[.*?\\]\\)" - class-options header t nil 1) - header)))) - (org-latex--guess-inputenc - (org-splice-latex-header - document-class-string - org-export-latex-default-packages-alist ; defined in org.el - org-export-latex-packages-alist nil ; defined in org.el - (plist-get info :latex-header-extra)))))) + (let* ((header (nth 1 (assoc class org-latex-classes))) + (document-class-string + (and (stringp header) + (if class-options + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\[.*?\\]\\)" + class-options header t nil 1) + header)))) + (org-latex--guess-inputenc + (org-splice-latex-header + document-class-string + org-export-latex-default-packages-alist ; defined in org.el + org-export-latex-packages-alist nil ; defined in org.el + (plist-get info :latex-header-extra)))))) ;; 3. Define alert if not yet defined. "\\providecommand{\\alert}[1]{\\textbf{#1}}\n" ;; 4. Author. (let ((author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-secondary-string - auth 'latex info))))) - (email (and (plist-get info :with-email) - (org-export-secondary-string - (plist-get info :email) 'latex info)))) + (let ((auth (plist-get info :author))) + (and auth (org-export-secondary-string + auth 'latex info))))) + (email (and (plist-get info :with-email) + (org-export-secondary-string + (plist-get info :email) 'latex info)))) (cond ((and author email (not (string= "" email))) - (format "\\author{%s\\thanks{%s}}\n" author email)) - (author (format "\\author{%s}\n" author)) - (t "\\author{}\n"))) + (format "\\author{%s\\thanks{%s}}\n" author email)) + (author (format "\\author{%s}\n" author)) + (t "\\author{}\n"))) ;; 5. Date. (let ((date (plist-get info :date))) (and date (format "\\date{%s}\n" date))) @@ -706,38 +706,38 @@ holding export options." (format "\\title{%s}\n" title) ;; 7. Hyperref options. (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" - (or (plist-get info :keywords) "") - (or (plist-get info :description) "") - (let ((creator-info (plist-get info :with-creator))) - (cond - ((not creator-info) "") - ((eq creator-info 'comment) "") - (t (plist-get info :creator))))) + (or (plist-get info :keywords) "") + (or (plist-get info :description) "") + (let ((creator-info (plist-get info :with-creator))) + (cond + ((not creator-info) "") + ((eq creator-info 'comment) "") + (t (plist-get info :creator))))) ;; 7. Document start. "\\begin{document}\n\n" ;; 8. Title command. (org-element-normalize-string (cond ((string= "" title) nil) - ((not (stringp org-latex-title-command)) nil) - ((string-match "\\(?:[^%]\\|^\\)%s" - org-latex-title-command) - (format org-latex-title-command title)) - (t org-latex-title-command))) + ((not (stringp org-latex-title-command)) nil) + ((string-match "\\(?:[^%]\\|^\\)%s" + org-latex-title-command) + (format org-latex-title-command title)) + (t org-latex-title-command))) ;; 9. Table of contents. (let ((depth (plist-get info :with-toc))) (when depth - (concat (when (wholenump depth) - (format "\\setcounter{tocdepth}{%d}\n" depth)) - "\\tableofcontents\n\\vspace*{1cm}\n\n"))) + (concat (when (wholenump depth) + (format "\\setcounter{tocdepth}{%d}\n" depth)) + "\\tableofcontents\n\\vspace*{1cm}\n\n"))) ;; 10. Document's body. contents ;; 11. Creator. (let ((creator-info (plist-get info :with-creator))) (cond - ((not creator-info)) - ((eq creator-info 'comment) - (format "%% %s\n" (plist-get info :creator))) - (t (concat (plist-get info :creator) "\n")))) + ((not creator-info)) + ((eq creator-info 'comment) + (format "%% %s\n" (plist-get info :creator))) + (t (concat (plist-get info :creator) "\n")))) ;; 12. Document end. "\\end{document}"))) @@ -773,12 +773,12 @@ holding contextual information." CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let* ((name (org-element-get-property :drawer-name drawer)) - (output (if (functionp org-latex-format-drawer-function) - (funcall org-latex-format-drawer-function - name contents) - ;; If there's no user defined function: simply - ;; display contents of the drawer. - contents))) + (output (if (functionp org-latex-format-drawer-function) + (funcall org-latex-format-drawer-function + name contents) + ;; If there's no user defined function: simply + ;; display contents of the drawer. + contents))) (org-latex--wrap-label drawer output))) @@ -799,8 +799,8 @@ holding contextual information. See CONTENTS is the contents of the emphasized text. INFO is a plist holding contextual information.." (format (cdr (assoc (org-element-get-property :marker emphasis) - org-latex-emphasis-alist)) - contents)) + org-latex-emphasis-alist)) + contents)) ;;;; Entity @@ -811,7 +811,7 @@ CONTENTS are the definition itself. INFO is a plist holding contextual information." (let ((ent (org-element-get-property :latex entity))) (if (org-element-get-property :latex-math-p entity) - (format "$%s$" ent) + (format "$%s$" ent) ent))) @@ -821,8 +821,8 @@ contextual information." "Transcode a EXAMPLE-BLOCK element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let* ((options (or (org-element-get-property :options example-block) "")) - (value (org-export-handle-code - (org-element-get-property :value example-block) options info))) + (value (org-export-handle-code + (org-element-get-property :value example-block) options info))) (org-latex--wrap-label example-block value))) @@ -849,9 +849,9 @@ CONTENTS is nil. INFO is a plist holding contextual information." "Transcode a FIXED-WIDTH element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let* ((value (org-element-normalize-string - (replace-regexp-in-string - "^[ \t]*: ?" "" - (org-element-get-property :value fixed-width))))) + (replace-regexp-in-string + "^[ \t]*: ?" "" + (org-element-get-property :value fixed-width))))) (org-latex--wrap-label fixed-width (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) @@ -874,26 +874,26 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;; Use \footnotemark if the footnote has already been defined. ;; Otherwise, define it with \footnote command. (let* ((all-seen (plist-get info :seen-footnote-labels)) - (label (org-element-get-property :label footnote-reference)) - ;; Anonymous footnotes are always new footnotes. - (seenp (and label (member label all-seen))) - (inline-def-p (org-element-get-property - :inline-definition footnote-reference))) + (label (org-element-get-property :label footnote-reference)) + ;; Anonymous footnotes are always new footnotes. + (seenp (and label (member label all-seen))) + (inline-def-p (org-element-get-property + :inline-definition footnote-reference))) (cond (seenp (format "\\footnotemark[%s]" (length seenp))) ;; Inline definitions are secondary strings. (inline-def-p (format "\\footnote{%s}" - (org-trim - (org-export-secondary-string inline-def-p 'latex info)))) + (org-trim + (org-export-secondary-string inline-def-p 'latex info)))) ;; Non-inline footnotes necessarily contain a label. Retrieve ;; match definition in `:footnotes-labels-alist'. (t (format "\\footnote{%s}" - (org-trim - (org-export-data - (cdr (assoc label (plist-get info :footnotes-labels-alist))) - 'latex info)))))))) + (org-trim + (org-export-data + (cdr (assoc label (plist-get info :footnotes-labels-alist))) + 'latex info)))))))) ;;;; Headline @@ -903,69 +903,69 @@ CONTENTS is nil. INFO is a plist holding contextual information." CONTENTS holds the contents of the headline. INFO is a plist holding contextual information." (let* ((class (plist-get info :latex-class)) - (numberedp (plist-get info :section-numbers)) - ;; Get level relative to current parsed data. - (level (+ (org-element-get-property :level headline) - (plist-get info :headline-offset))) - (class-sectionning (assoc class org-latex-classes)) - ;; Section formatting will set two placeholders: one for the - ;; title and the other for the contents. - (section-fmt - (let ((sec (if (and (symbolp (nth 2 class-sectionning)) - (fboundp (nth 2 class-sectionning))) - (funcall (nth 2 class-sectionning) level numberedp) - (nth (1+ level) class-sectionning)))) - (cond - ;; No section available for that LEVEL. - ((not sec) nil) - ;; Section format directly returned by a function. - ((stringp sec) sec) - ;; (numbered-section . unnumbered-section) - ((not (consp (cdr sec))) - (concat (funcall (if numberedp #'car #'cdr) sec) "\n%s")) - ;; (numbered-open numbered-close) - ((= (length sec) 2) - (when numberedp (concat (car sec) "\n%s" (nth 1 sec)))) - ;; (num-in num-out no-num-in no-num-out) - ((= (length sec) 4) - (if numberedp - (concat (car sec) "\n%s" (nth 1 sec)) - (concat (nth 2 sec) "\n%s" (nth 3 sec))))))) - (text (org-export-secondary-string - (org-element-get-property :title headline) 'latex info)) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-get-property - :todo-keyword headline))) - (and todo - (org-export-secondary-string todo 'latex info))))) - (todo-type (and todo (org-element-get-property :todo-type headline))) - (tags (and (plist-get info :with-tags) - (org-element-get-property :tags headline))) - (priority (and (plist-get info :with-priority) - (org-element-get-property :priority headline))) - ;; Create the headline text. - (full-text (if (functionp org-latex-format-headline-function) - ;; User-defined formatting function. - (funcall org-latex-format-headline-function - todo todo-type priority text tags) - ;; Default formatting. - (concat - (when todo - (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) - (when priority (format "\\framebox{\\#%c} " priority)) - text - (when tags (format "\\hfill{}\\textsc{%s}" tags))))) - ;; Associate some \label to the headline for internal links. - (headline-labels (mapconcat - (lambda (p) - (let ((val (org-element-get-property p headline))) - (when val (format "\\label{%s}\n" - (if (eq p :begin) - (format "headline-%s" val) - val))))) - '(:custom-id :id :begin) "")) - (pre-blanks (make-string (org-element-get-property :pre-blank headline) - 10))) + (numberedp (plist-get info :section-numbers)) + ;; Get level relative to current parsed data. + (level (+ (org-element-get-property :level headline) + (plist-get info :headline-offset))) + (class-sectionning (assoc class org-latex-classes)) + ;; Section formatting will set two placeholders: one for the + ;; title and the other for the contents. + (section-fmt + (let ((sec (if (and (symbolp (nth 2 class-sectionning)) + (fboundp (nth 2 class-sectionning))) + (funcall (nth 2 class-sectionning) level numberedp) + (nth (1+ level) class-sectionning)))) + (cond + ;; No section available for that LEVEL. + ((not sec) nil) + ;; Section format directly returned by a function. + ((stringp sec) sec) + ;; (numbered-section . unnumbered-section) + ((not (consp (cdr sec))) + (concat (funcall (if numberedp #'car #'cdr) sec) "\n%s")) + ;; (numbered-open numbered-close) + ((= (length sec) 2) + (when numberedp (concat (car sec) "\n%s" (nth 1 sec)))) + ;; (num-in num-out no-num-in no-num-out) + ((= (length sec) 4) + (if numberedp + (concat (car sec) "\n%s" (nth 1 sec)) + (concat (nth 2 sec) "\n%s" (nth 3 sec))))))) + (text (org-export-secondary-string + (org-element-get-property :title headline) 'latex info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-get-property + :todo-keyword headline))) + (and todo + (org-export-secondary-string todo 'latex info))))) + (todo-type (and todo (org-element-get-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-element-get-property :tags headline))) + (priority (and (plist-get info :with-priority) + (org-element-get-property :priority headline))) + ;; Create the headline text. + (full-text (if (functionp org-latex-format-headline-function) + ;; User-defined formatting function. + (funcall org-latex-format-headline-function + todo todo-type priority text tags) + ;; Default formatting. + (concat + (when todo + (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) + (when priority (format "\\framebox{\\#%c} " priority)) + text + (when tags (format "\\hfill{}\\textsc{%s}" tags))))) + ;; Associate some \label to the headline for internal links. + (headline-labels (mapconcat + (lambda (p) + (let ((val (org-element-get-property p headline))) + (when val (format "\\label{%s}\n" + (if (eq p :begin) + (format "headline-%s" val) + val))))) + '(:custom-id :id :begin) "")) + (pre-blanks (make-string (org-element-get-property :pre-blank headline) + 10))) (cond ;; Case 1: This is a footnote section: ignore it. ((org-element-get-property :footnote-section-p headline) nil) @@ -973,27 +973,27 @@ holding contextual information." ;; Also export as items headlines for which no section ;; format has been found. ((or (not section-fmt) - (and (wholenump (plist-get info :headline-levels)) - (> level (plist-get info :headline-levels)))) + (and (wholenump (plist-get info :headline-levels)) + (> level (plist-get info :headline-levels)))) ;; Build the real contents of the sub-tree. (let ((low-level-body - (concat - ;; If the headline is the first sibling, start a list. - (when (org-export-first-sibling-p headline info) - (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize))) - ;; Itemize headline - "\\item " full-text "\n" headline-labels pre-blanks contents))) - ;; If headline in the last sibling, close the list, before any - ;; blank line. Otherwise, simply return LOW-LEVEL-BODY. - (if (org-export-last-sibling-p headline info) - (replace-regexp-in-string - "[ \t\n]*\\'" - (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize)) - low-level-body) - low-level-body))) + (concat + ;; If the headline is the first sibling, start a list. + (when (org-export-first-sibling-p headline info) + (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize))) + ;; Itemize headline + "\\item " full-text "\n" headline-labels pre-blanks contents))) + ;; If headline in the last sibling, close the list, before any + ;; blank line. Otherwise, simply return LOW-LEVEL-BODY. + (if (org-export-last-sibling-p headline info) + (replace-regexp-in-string + "[ \t\n]*\\'" + (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize)) + low-level-body) + low-level-body))) ;; Case 3. Standard headline. Export it as a section. (t (format section-fmt full-text - (concat headline-labels pre-blanks contents)))))) + (concat headline-labels pre-blanks contents)))))) ;;;; Horizontal Rule @@ -1002,8 +1002,8 @@ holding contextual information." "Transcode an HORIZONTAL-RULE object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let ((attr (mapconcat #'identity - (org-element-get-property :attr_latex horizontal-rule) - " "))) + (org-element-get-property :attr_latex horizontal-rule) + " "))) (org-latex--wrap-label horizontal-rule (concat "\\hrule " attr)))) @@ -1019,7 +1019,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((code (org-element-get-property :value inline-src-block)) - (separator (org-latex--find-verb-separator code))) + (separator (org-latex--find-verb-separator code))) (cond ;; Do not use a special package: transcode it verbatim. ((not org-latex-listings) @@ -1027,27 +1027,27 @@ contextual information." ;; Use minted package. ((eq org-latex-listings 'minted) (let* ((org-lang (org-element-get-property :language inline-src-block)) - (mint-lang (or (cadr (assq (intern org-lang) - org-latex-minted-langs)) - org-lang)) - (options (org-latex--make-option-string - org-latex-minted-options))) - (concat (format "\\mint%s{%s}" - (if (string= options "") "" (format "[%s]" options)) - mint-lang) - separator code separator))) + (mint-lang (or (cadr (assq (intern org-lang) + org-latex-minted-langs)) + org-lang)) + (options (org-latex--make-option-string + org-latex-minted-options))) + (concat (format "\\mint%s{%s}" + (if (string= options "") "" (format "[%s]" options)) + mint-lang) + separator code separator))) ;; Use listings package. (t ;; Maybe translate language's name. (let* ((org-lang (org-element-get-property :language inline-src-block)) - (lst-lang (or (cadr (assq (intern org-lang) - org-latex-listings-langs)) - org-lang)) - (options (org-latex--make-option-string - (append org-latex-listings-options - `(("language" ,lst-lang)))))) - (concat (format "\\lstinline[%s]" options) - separator code separator)))))) + (lst-lang (or (cadr (assq (intern org-lang) + org-latex-listings-langs)) + org-lang)) + (options (org-latex--make-option-string + (append org-latex-listings-options + `(("language" ,lst-lang)))))) + (concat (format "\\lstinline[%s]" options) + separator code separator)))))) ;;;; Inlinetask @@ -1057,41 +1057,41 @@ contextual information." CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let ((title (org-export-secondary-string - (org-element-get-property :title inlinetask) 'latex info)) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-get-property - :todo-keyword inlinetask))) - (and todo - (org-export-secondary-string todo 'latex info))))) - (todo-type (org-element-get-property :todo-type inlinetask)) - (tags (and (plist-get info :with-tags) - (org-element-get-property :tags inlinetask))) - (priority (and (plist-get info :with-priority) - (org-element-get-property :priority inlinetask)))) + (org-element-get-property :title inlinetask) 'latex info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-get-property + :todo-keyword inlinetask))) + (and todo + (org-export-secondary-string todo 'latex info))))) + (todo-type (org-element-get-property :todo-type inlinetask)) + (tags (and (plist-get info :with-tags) + (org-element-get-property :tags inlinetask))) + (priority (and (plist-get info :with-priority) + (org-element-get-property :priority inlinetask)))) ;; If `org-latex-format-inlinetask-function' is provided, call it ;; with appropriate arguments. (if (functionp org-latex-format-inlinetask-function) - (funcall org-latex-format-inlinetask-function - todo todo-type priority title tags contents) + (funcall org-latex-format-inlinetask-function + todo todo-type priority title tags contents) ;; Otherwise, use a default template. (org-latex--wrap-label inlinetask (let ((full-title - (concat - (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) - (when priority (format "\\framebox{\\#%c} " priority)) - title - (when tags (format "\\hfill{}\\textsc{%s}" tags))))) - (format (concat "\\begin{center}\n" - "\\fbox{\n" - "\\begin{minipage}[c]{.6\\textwidth}\n" - "%s\n\n" - "\\rule[.8em]{\\textwidth}{2pt}\n\n" - "%s" - "\\end{minipage}\n" - "}\n" - "\\end{center}") - full-title contents)))))) + (concat + (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) + (when priority (format "\\framebox{\\#%c} " priority)) + title + (when tags (format "\\hfill{}\\textsc{%s}" tags))))) + (format (concat "\\begin{center}\n" + "\\fbox{\n" + "\\begin{minipage}[c]{.6\\textwidth}\n" + "%s\n\n" + "\\rule[.8em]{\\textwidth}{2pt}\n\n" + "%s" + "\\end{minipage}\n" + "}\n" + "\\end{center}") + full-title contents)))))) ;;;; Item @@ -1101,20 +1101,20 @@ holding contextual information." CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((level (plist-get (plist-get info :parent-properties) :level)) - (counter (let ((count (org-element-get-property :counter item))) - (and count - (< level 4) - (format "\\setcounter{enum%s}{%s}\n" - (nth level '("i" "ii" "iii" "iv")) - (1- count))))) - (checkbox (let ((checkbox (org-element-get-property :checkbox item))) - (cond ((eq checkbox 'on) "$\\boxtimes$ ") - ((eq checkbox 'off) "$\\Box$ ") - ((eq checkbox 'trans) "$\\boxminus$ ")))) - (tag (let ((tag (org-element-get-property :tag item))) - (and tag - (format "[%s]" (org-export-secondary-string - tag 'latex info)))))) + (counter (let ((count (org-element-get-property :counter item))) + (and count + (< level 4) + (format "\\setcounter{enum%s}{%s}\n" + (nth level '("i" "ii" "iii" "iv")) + (1- count))))) + (checkbox (let ((checkbox (org-element-get-property :checkbox item))) + (cond ((eq checkbox 'on) "$\\boxtimes$ ") + ((eq checkbox 'off) "$\\Box$ ") + ((eq checkbox 'trans) "$\\boxminus$ ")))) + (tag (let ((tag (org-element-get-property :tag item))) + (and tag + (format "[%s]" (org-export-secondary-string + tag 'latex info)))))) (concat counter "\\item" tag " " checkbox contents))) @@ -1124,7 +1124,7 @@ contextual information." "Transcode a KEYWORD element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let ((key (downcase (org-element-get-property :key keyword))) - (value (org-element-get-property :value keyword))) + (value (org-element-get-property :value keyword))) (cond ((string= key "latex") value) ((string= key "index") (format "\\index{%s}" value)) @@ -1132,18 +1132,18 @@ CONTENTS is nil. INFO is a plist holding contextual information." (format "\\label{%s}" (org-export-solidify-link-text value))) ((string= key "toc") (let ((value (downcase value))) - (cond - ((string-match "\\" value) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc)))) - (concat - (when (wholenump depth) - (format "\\setcounter{tocdepth}{%s}\n" depth)) - "\\tableofcontents"))) - ((string= "tables" value) "\\listoftables") - ((string= "figures" value) "\\listoffigures") - ((string= "listings" value) "\\listoflistings")))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (concat + (when (wholenump depth) + (format "\\setcounter{tocdepth}{%s}\n" depth)) + "\\tableofcontents"))) + ((string= "tables" value) "\\listoftables") + ((string= "figures" value) "\\listoffigures") + ((string= "listings" value) "\\listoflistings")))) ((string= key "include") (org-export-included-file keyword 'latex info))))) @@ -1180,42 +1180,42 @@ CONTENTS is nil. INFO is a plist holding contextual information." "Return LaTeX code for an image at PATH. INFO is a plist containing export options." (let* ((parent-props (plist-get info :parent-properties)) - (caption (org-latex--caption/label-string - (plist-get parent-props :caption) - (plist-get parent-props :name) - info)) - ;; Retrieve latex attributes from the element around. - (attr (let ((raw-attr - (mapconcat #'identity - (plist-get parent-props :attr_latex) " "))) - (unless (string= raw-attr "") raw-attr))) - (disposition - (cond - ((and attr (string-match "\\" attr)) 'wrap) - ((and attr (string-match "\\" attr)) 'multicolumn) - ((or (and attr (string-match "\\" attr)) - (not (string= caption ""))) - 'float))) - (placement - (cond - ((and attr (string-match "\\" attr)) 'wrap) + ((and attr (string-match "\\" attr)) 'multicolumn) + ((or (and attr (string-match "\\" attr)) + (not (string= caption ""))) + 'float))) + (placement + (cond + ((and attr (string-match "\\" paralist-regexp) attr)) - (match-string 1 attr)) - ((eq type 'ordered) "enumerate") - ((eq type 'unordered) "itemize") - ((eq type 'descriptive) "description")))) + (paralist-types '("inparaenum" "asparaenum" "inparaitem" "asparaitem" + "inparadesc" "asparadesc")) + (paralist-regexp (concat + "\\(" + (mapconcat 'identity paralist-types "\\|") + "\\)")) + (attr (mapconcat #'identity + (org-element-get-property :attr_latex plain-list) + " ")) + (latex-type (cond + ((and attr + (string-match + (format "\\<%s\\>" paralist-regexp) attr)) + (match-string 1 attr)) + ((eq type 'ordered) "enumerate") + ((eq type 'unordered) "itemize") + ((eq type 'descriptive) "description")))) (org-latex--wrap-label plain-list (format "\\begin{%s}%s\n%s\\end{%s}" - latex-type - ;; Once special environment, if any, has been removed, the - ;; rest of the attributes will be optional arguments. - ;; They will be put inside square brackets if necessary. - (let ((opt (replace-regexp-in-string - (format " *%s *" paralist-regexp) "" attr))) - (cond ((string= opt "") "") - ((string-match "\\`\\[[^][]+\\]\\'" opt) opt) - (t (format "[%s]" opt)))) - contents - latex-type)))) + latex-type + ;; Once special environment, if any, has been removed, the + ;; rest of the attributes will be optional arguments. + ;; They will be put inside square brackets if necessary. + (let ((opt (replace-regexp-in-string + (format " *%s *" paralist-regexp) "" attr))) + (cond ((string= opt "") "") + ((string-match "\\`\\[[^][]+\\]\\'" opt) opt) + (t (format "[%s]" opt)))) + contents + latex-type)))) ;;;; Plain Text @@ -1383,18 +1383,18 @@ contextual information." ;; Protect %, #, &, $, ~, ^, _, { and }. (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}~^_]\\)" text) (setq text - (replace-match (format "\\%s" (match-string 2 text)) nil t text 2))) + (replace-match (format "\\%s" (match-string 2 text)) nil t text 2))) ;; Protect \ (setq text (replace-regexp-in-string - "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" - "$\\backslash$" text nil t 1)) + "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" + "$\\backslash$" text nil t 1)) ;; LaTeX into \LaTeX{} and TeX into \TeX{}. (let ((case-fold-search nil) - (start 0)) + (start 0)) (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" text start) (setq text (replace-match - (format "\\%s{}" (match-string 1 text)) nil t text) - start (match-end 0)))) + (format "\\%s{}" (match-string 1 text)) nil t text) + start (match-end 0)))) ;; Handle quotation marks (setq text (org-latex--quotation-marks text info)) ;; Convert special strings. @@ -1404,7 +1404,7 @@ contextual information." ;; Handle break preservation if required. (when (plist-get info :preserve-breaks) (setq text (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" - text))) + text))) ;; Return value. text) @@ -1437,7 +1437,7 @@ holding contextual information." "Transcode a QUOTE-SECTION element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-remove-indentation - (org-element-get-property :value quote-section)))) + (org-element-get-property :value quote-section)))) (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) @@ -1448,9 +1448,9 @@ CONTENTS is nil. INFO is a plist holding contextual information." TEXT is the text of the target. INFO is a plist holding contextual information." (format "\\label{%s}%s" - (org-export-solidify-link-text - (org-element-get-property :raw-value radio-target)) - text)) + (org-export-solidify-link-text + (org-element-get-property :raw-value radio-target)) + text)) ;;;; Special Block @@ -1472,57 +1472,57 @@ holding contextual information." CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((lang (org-element-get-property :language src-block)) - (code (org-export-handle-code - (org-element-get-property :value src-block) - (org-element-get-property :switches src-block) - info lang)) - (caption (org-element-get-property :caption src-block)) - (label (org-element-get-property :name src-block)) - (custom-env (and lang - (cadr (assq (intern lang) - org-latex-custom-lang-environments))))) + (code (org-export-handle-code + (org-element-get-property :value src-block) + (org-element-get-property :switches src-block) + info lang)) + (caption (org-element-get-property :caption src-block)) + (label (org-element-get-property :name src-block)) + (custom-env (and lang + (cadr (assq (intern lang) + org-latex-custom-lang-environments))))) (cond ;; No source fontification. ((not org-latex-listings) (let ((caption-str (org-latex--caption/label-string - caption label info)) - (float-env (when caption "\\begin{figure}[H]\n%s\n\\end{figure}"))) - (format (or float-env "%s") - (concat - caption-str - (format "\\begin{verbatim}\n%s\\end{verbatim}" code))))) + caption label info)) + (float-env (when caption "\\begin{figure}[H]\n%s\n\\end{figure}"))) + (format (or float-env "%s") + (concat + caption-str + (format "\\begin{verbatim}\n%s\\end{verbatim}" code))))) ;; Custom environment. (custom-env (format "\\begin{%s}\n%s\\end{%s}\n" custom-env code custom-env)) ;; Use minted package. ((eq org-latex-listings 'minted) (let* ((mint-lang (or (cadr (assq (intern lang) org-latex-minted-langs)) - lang)) - (float-env (when (or label caption) - (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" - (org-latex--caption/label-string - caption label info)))) - (body (format "\\begin{minted}[%s]{%s}\n%s\\end{minted}" - (org-latex--make-option-string - org-latex-minted-options) - mint-lang code))) - (if float-env (format float-env body) body))) + lang)) + (float-env (when (or label caption) + (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" + (org-latex--caption/label-string + caption label info)))) + (body (format "\\begin{minted}[%s]{%s}\n%s\\end{minted}" + (org-latex--make-option-string + org-latex-minted-options) + mint-lang code))) + (if float-env (format float-env body) body))) ;; Use listings package. (t (let ((lst-lang (or (cadr (assq (intern lang) org-latex-listings-langs)) - lang)) - (caption-str (and caption - (org-export-secondary-string - (org-element-get-property :caption src-block) - 'latex info)))) - (concat (format "\\lstset{%s}\n" - (org-latex--make-option-string - (append org-latex-listings-options - `(("language" ,lst-lang)) - (when label `(("label" ,label))) - (when caption-str - `(("caption" ,caption-str)))))) - (format "\\begin{lstlisting}\n%s\\end{lstlisting}" code))))))) + lang)) + (caption-str (and caption + (org-export-secondary-string + (org-element-get-property :caption src-block) + 'latex info)))) + (concat (format "\\lstset{%s}\n" + (org-latex--make-option-string + (append org-latex-listings-options + `(("language" ,lst-lang)) + (when label `(("label" ,label))) + (when caption-str + `(("caption" ,caption-str)))))) + (format "\\begin{lstlisting}\n%s\\end{lstlisting}" code))))))) ;;;; Statistics Cookie @@ -1561,67 +1561,67 @@ returned by `org-export-table-format-info'. The format string one placeholder for the body of the table." (let* ((label (org-element-get-property :name table)) - (caption (org-latex--caption/label-string - (org-element-get-property :caption table) label info)) - (attr (mapconcat #'identity - (org-element-get-property :attr_latex table) - " ")) - ;; Determine alignment string. - (alignment (org-latex-table--align-string attr info)) - ;; Determine environment for the table: longtable, tabular... - (table-env (cond - ((not attr) org-latex-default-table-environment) - ((string-match "\\" attr) "longtable") - ((string-match "\\(tabular.\\)" attr) - (org-match-string-no-properties 1 attr)) - (t org-latex-default-table-environment))) - ;; If table is a float, determine environment: table or table*. - (float-env (cond - ((string= "longtable" table-env) nil) - ((and attr - (or (string-match (regexp-quote "table*") attr) - (string-match "\\" attr))) - "table*") - ((or (not (string= caption "")) label) "table"))) - ;; Extract others display options. - (width (and attr - (string-match "\\" attr) "longtable") + ((string-match "\\(tabular.\\)" attr) + (org-match-string-no-properties 1 attr)) + (t org-latex-default-table-environment))) + ;; If table is a float, determine environment: table or table*. + (float-env (cond + ((string= "longtable" table-env) nil) + ((and attr + (or (string-match (regexp-quote "table*") attr) + (string-match "\\" attr))) + "table*") + ((or (not (string= caption "")) label) "table"))) + ;; Extract others display options. + (width (and attr + (string-match "\\" attr))) + (and attr (string-match "\\" attr))) (format "\\begin{verbatim}\n%s\n\\end{verbatim}" - (org-export-clean-table - raw-table - (plist-get (org-export-table-format-info raw-table) - :special-column-p)))) + (org-export-clean-table + raw-table + (plist-get (org-export-table-format-info raw-table) + :special-column-p)))) ;; Case 2: table.el table. Convert it using appropriate tools. ((eq (org-element-get-property :type table) 'table.el) (require 'table) ;; Ensure "*org-export-table*" buffer is empty. (and (get-buffer "*org-export-table*") - (kill-buffer (get-buffer "*org-export-table*"))) + (kill-buffer (get-buffer "*org-export-table*"))) (let ((output (with-temp-buffer - (insert raw-table) - (goto-char 1) - (re-search-forward "^[ \t]*|[^|]" nil t) - (table-generate-source 'latex "*org-export-table*") - (with-current-buffer "*org-export-table*" - (org-trim (buffer-string)))))) - (kill-buffer (get-buffer "*org-export-table*")) - ;; Remove left out comments. - (while (string-match "^%.*\n" output) - (setq output (replace-match "" t t output))) - ;; When the "rmlines" attribute is provided, remove all hlines - ;; but the the one separating heading from the table body. - (when (and attr (string-match "\\" attr)) - (let ((n 0) (pos 0)) - (while (and (< (length output) pos) - (setq pos (string-match "^\\\\hline\n?" output pos))) - (incf n) - (unless (= n 2) (setq output (replace-match "" nil nil output)))))) - (if org-latex-tables-centered - (format "\\begin{center}\n%s\n\\end{center}" output) - output))) + (insert raw-table) + (goto-char 1) + (re-search-forward "^[ \t]*|[^|]" nil t) + (table-generate-source 'latex "*org-export-table*") + (with-current-buffer "*org-export-table*" + (org-trim (buffer-string)))))) + (kill-buffer (get-buffer "*org-export-table*")) + ;; Remove left out comments. + (while (string-match "^%.*\n" output) + (setq output (replace-match "" t t output))) + ;; When the "rmlines" attribute is provided, remove all hlines + ;; but the the one separating heading from the table body. + (when (and attr (string-match "\\" attr)) + (let ((n 0) (pos 0)) + (while (and (< (length output) pos) + (setq pos (string-match "^\\\\hline\n?" output pos))) + (incf n) + (unless (= n 2) (setq output (replace-match "" nil nil output)))))) + (if org-latex-tables-centered + (format "\\begin{center}\n%s\n\\end{center}" output) + output))) ;; Case 3: Standard table. (t (let* ((table-info (org-export-table-format-info raw-table)) @@ -1744,9 +1744,9 @@ CONTENTS is nil. INFO is a plist holding contextual information." TEXT is the text of the target. INFO is a plist holding contextual information." (format "\\label{%s}%s" - (org-export-solidify-link-text - (org-element-get-property :raw-value target)) - text)) + (org-export-solidify-link-text + (org-element-get-property :raw-value target)) + text)) ;;;; Time-stamp @@ -1755,20 +1755,20 @@ contextual information." "Transcode a TIME-STAMP object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-element-get-property :value time-stamp)) - (type (org-element-get-property :type time-stamp)) - (appt-type (org-element-get-property :appt-type time-stamp))) + (type (org-element-get-property :type time-stamp)) + (appt-type (org-element-get-property :appt-type time-stamp))) (concat (cond ((eq appt-type 'scheduled) - (format "\\textbf{\\textsc{%s}} " org-scheduled-string)) - ((eq appt-type 'deadline) - (format "\\textbf{\\textsc{%s}} " org-deadline-string)) - ((eq appt-type 'closed) - (format "\\textbf{\\textsc{%s}} " org-closed-string))) - (cond ((memq type '(active active-range)) - (format org-latex-active-timestamp-format value)) - ((memq type '(inactive inactive-range)) - (format org-latex-inactive-timestamp-format value)) - (t - (format org-latex-diary-timestamp-format value)))))) + (format "\\textbf{\\textsc{%s}} " org-scheduled-string)) + ((eq appt-type 'deadline) + (format "\\textbf{\\textsc{%s}} " org-deadline-string)) + ((eq appt-type 'closed) + (format "\\textbf{\\textsc{%s}} " org-closed-string))) + (cond ((memq type '(active active-range)) + (format org-latex-active-timestamp-format value)) + ((memq type '(inactive inactive-range)) + (format org-latex-inactive-timestamp-format value)) + (t + (format org-latex-diary-timestamp-format value)))))) ;;;; Verbatim @@ -1776,33 +1776,33 @@ CONTENTS is nil. INFO is a plist holding contextual information." (defun org-latex-verbatim (element contents info) "Return verbatim text in LaTeX." (let ((fmt (cdr (assoc (org-element-get-property :marker element) - org-latex-emphasis-alist))) - (value (org-element-get-property :value element))) + org-latex-emphasis-alist))) + (value (org-element-get-property :value element))) (cond ;; Handle the `verb' special case. ((eq 'verb fmt) (let ((separator (org-latex--find-verb-separator value))) - (concat "\\verb" separator value separator))) + (concat "\\verb" separator value separator))) ;; Handle the `protectedtexttt' special case. ((eq 'protectedtexttt fmt) (let ((start 0) - (trans '(("\\" . "\\textbackslash{}") - ("~" . "\\textasciitilde{}") - ("^" . "\\textasciicircum{}"))) - (rtn "") - char) - (while (string-match "[\\{}$%&_#~^]" value) - (setq char (match-string 0 value)) - (if (> (match-beginning 0) 0) - (setq rtn (concat rtn (substring value 0 (match-beginning 0))))) - (setq value (substring value (1+ (match-beginning 0)))) - (setq char (or (cdr (assoc char trans)) (concat "\\" char)) - rtn (concat rtn char))) - (setq value (concat rtn value) - fmt "\\texttt{%s}") - (while (string-match "--" value) - (setq value (replace-match "-{}-" t t value))) - (format fmt value))) + (trans '(("\\" . "\\textbackslash{}") + ("~" . "\\textasciitilde{}") + ("^" . "\\textasciicircum{}"))) + (rtn "") + char) + (while (string-match "[\\{}$%&_#~^]" value) + (setq char (match-string 0 value)) + (if (> (match-beginning 0) 0) + (setq rtn (concat rtn (substring value 0 (match-beginning 0))))) + (setq value (substring value (1+ (match-beginning 0)))) + (setq char (or (cdr (assoc char trans)) (concat "\\" char)) + rtn (concat rtn char))) + (setq value (concat rtn value) + fmt "\\texttt{%s}") + (while (string-match "--" value) + (setq value (replace-match "-{}-" t t value))) + (format fmt value))) ;; Else use format string. (t (format fmt value))))) @@ -1820,17 +1820,17 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;; a vertical space of 1 em. (progn (setq contents (replace-regexp-in-string - "^ *\\\\\\\\$" "\\\\vspace*{1em}" - (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" - (org-remove-indentation - (org-export-secondary-string - (org-element-get-property :value verse-block) - 'latex info))))) + "^ *\\\\\\\\$" "\\\\vspace*{1em}" + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" + (org-remove-indentation + (org-export-secondary-string + (org-element-get-property :value verse-block) + 'latex info))))) (while (string-match "^[ \t]+" contents) (let ((new-str (format "\\hspace*{%dem}" - (length (match-string 0 contents))))) - (setq contents (replace-match new-str nil t contents)))) + (length (match-string 0 contents))))) + (setq contents (replace-match new-str nil t contents)))) (format "\\begin{verse}\n%s\\end{verse}" contents)))) diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el index 9b4d0b0a7..73942084c 100644 --- a/contrib/lisp/org-element.el +++ b/contrib/lisp/org-element.el @@ -142,28 +142,28 @@ containing `:begin', `:end', `:hiddenp', `:contents-begin', Assume point is at beginning or end of the block." (save-excursion (let* ((case-fold-search t) - (keywords (progn - (end-of-line) - (re-search-backward - (concat "^[ \t]*#\\+begin_center") nil t) - (org-element-collect-affiliated-keywords))) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (contents-end (progn (re-search-forward - (concat "^[ \t]*#\\+end_center") nil t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (keywords (progn + (end-of-line) + (re-search-backward + (concat "^[ \t]*#\\+begin_center") nil t) + (org-element-collect-affiliated-keywords))) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (contents-end (progn (re-search-forward + (concat "^[ \t]*#\\+end_center") nil t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'center-block - `(:begin ,begin - :end ,end - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-center-block-interpreter (center-block contents) "Interpret CENTER-BLOCK element as Org syntax. @@ -181,33 +181,33 @@ Return a list whose car is `drawer' and cdr is a plist containing Assume point is at beginning of drawer." (save-excursion (let* ((case-fold-search t) - (name (progn (looking-at org-drawer-regexp) - (org-match-string-no-properties 1))) - (keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (contents-end (progn (re-search-forward "^[ \t]*:END:" nil t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (name (progn (looking-at org-drawer-regexp) + (org-match-string-no-properties 1))) + (keywords (org-element-collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (contents-end (progn (re-search-forward "^[ \t]*:END:" nil t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'drawer - `(:begin ,begin - :end ,end - :drawer-name ,name - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :drawer-name ,name + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-drawer-interpreter (drawer contents) "Interpret DRAWER element as Org syntax. CONTENTS is the contents of the element." (format ":%s:\n%s:END:" - (org-element-get-property :drawer-name drawer) - contents)) + (org-element-get-property :drawer-name drawer) + contents)) ;;;; Dynamic Block (defun org-element-dynamic-block-parser () @@ -221,37 +221,37 @@ containing `:block-name', `:begin', `:end', `:hiddenp', Assume point is at beginning of dynamic block." (save-excursion (let* ((case-fold-search t) - (name (progn (looking-at org-dblock-start-re) - (org-match-string-no-properties 1))) - (arguments (org-match-string-no-properties 3)) - (keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (contents-end (progn (re-search-forward org-dblock-end-re nil t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (name (progn (looking-at org-dblock-start-re) + (org-match-string-no-properties 1))) + (arguments (org-match-string-no-properties 3)) + (keywords (org-element-collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (contents-end (progn (re-search-forward org-dblock-end-re nil t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'dynamic-block - `(:begin ,begin - :end ,end - :block-name ,name - :arguments ,arguments - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :block-name ,name + :arguments ,arguments + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-dynamic-block-interpreter (dynamic-block contents) "Interpret DYNAMIC-BLOCK element as Org syntax. CONTENTS is the contents of the element." (format "#+BEGIN: %s%s\n%s#+END:" - (org-element-get-property :block-name dynamic-block) - (let ((args (org-element-get-property :arguments dynamic-block))) - (and arg (concat " " args))) - contents)) + (org-element-get-property :block-name dynamic-block) + (let ((args (org-element-get-property :arguments dynamic-block))) + (and arg (concat " " args))) + contents)) ;;;; Footnote Definition @@ -263,33 +263,33 @@ a plist containing `:label', `:begin' `:end', `:contents-begin', `contents-end' and `:post-blank' keywords." (save-excursion (let* ((f-def (org-footnote-at-definition-p)) - (label (car f-def)) - (keywords (progn (goto-char (nth 1 f-def)) - (org-element-collect-affiliated-keywords))) - (begin (car keywords)) - (contents-begin (progn (looking-at (concat "\\[" label "\\]")) - (goto-char (match-end 0)) - (org-skip-whitespace) - (point))) - (end (goto-char (nth 2 f-def))) - (contents-end (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point)))) + (label (car f-def)) + (keywords (progn (goto-char (nth 1 f-def)) + (org-element-collect-affiliated-keywords))) + (begin (car keywords)) + (contents-begin (progn (looking-at (concat "\\[" label "\\]")) + (goto-char (match-end 0)) + (org-skip-whitespace) + (point))) + (end (goto-char (nth 2 f-def))) + (contents-end (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point)))) (list 'footnote-definition - `(:label ,label - :begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines contents-end end) - ,@(cadr keywords)))))) + `(:label ,label + :begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines contents-end end) + ,@(cadr keywords)))))) (defun org-element-footnote-definition-interpreter (footnote-definition contents) "Interpret FOOTNOTE-DEFINITION element as Org syntax. CONTENTS is the contents of the footnote-definition." (concat (format "[%s]" (org-element-get-property :label footnote-definition)) - " " - contents)) + " " + contents)) ;;;; Headline @@ -311,132 +311,132 @@ and colons at the beginning (i.e. `:custom-id'). Assume point is at beginning of the headline." (save-excursion (let* ((components (org-heading-components)) - (level (nth 1 components)) - (todo (nth 2 components)) - (todo-type (and todo - (if (member todo org-done-keywords) 'done 'todo))) - (tags (nth 5 components)) - (raw-value (nth 4 components)) - (quotedp (string-match (format "^%s +" org-quote-string) raw-value)) - (commentedp (string-match - (format "^%s +" org-comment-string) raw-value)) - (archivedp (and tags - (string-match (format ":%s:" org-archive-tag) tags))) - (footnote-section-p (and org-footnote-section - (string= org-footnote-section raw-value))) - (standard-props (let (plist) - (mapc - (lambda (p) - (let ((p-name (downcase (car p)))) - (while (string-match "_" p-name) - (setq p-name - (replace-match "-" nil nil p-name))) - (setq p-name (intern (concat ":" p-name))) - (setq plist - (plist-put plist p-name (cdr p))))) - (org-entry-properties nil 'standard)) - plist)) - (time-props (org-entry-properties nil 'special "CLOCK")) - (scheduled (cdr (assoc "SCHEDULED" time-props))) - (deadline (cdr (assoc "DEADLINE" time-props))) - (clock (cdr (assoc "CLOCK" time-props))) - (timestamp (cdr (assoc "TIMESTAMP" time-props))) - (begin (point)) - (pos-after-head (save-excursion (forward-line) (point))) - (contents-begin (save-excursion (forward-line) - (org-skip-whitespace) - (if (eobp) (point) (point-at-bol)))) - (hidden (save-excursion (forward-line) (org-truely-invisible-p))) - (end (progn (goto-char (org-end-of-subtree t t)))) - (contents-end (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point))) - title) + (level (nth 1 components)) + (todo (nth 2 components)) + (todo-type (and todo + (if (member todo org-done-keywords) 'done 'todo))) + (tags (nth 5 components)) + (raw-value (nth 4 components)) + (quotedp (string-match (format "^%s +" org-quote-string) raw-value)) + (commentedp (string-match + (format "^%s +" org-comment-string) raw-value)) + (archivedp (and tags + (string-match (format ":%s:" org-archive-tag) tags))) + (footnote-section-p (and org-footnote-section + (string= org-footnote-section raw-value))) + (standard-props (let (plist) + (mapc + (lambda (p) + (let ((p-name (downcase (car p)))) + (while (string-match "_" p-name) + (setq p-name + (replace-match "-" nil nil p-name))) + (setq p-name (intern (concat ":" p-name))) + (setq plist + (plist-put plist p-name (cdr p))))) + (org-entry-properties nil 'standard)) + plist)) + (time-props (org-entry-properties nil 'special "CLOCK")) + (scheduled (cdr (assoc "SCHEDULED" time-props))) + (deadline (cdr (assoc "DEADLINE" time-props))) + (clock (cdr (assoc "CLOCK" time-props))) + (timestamp (cdr (assoc "TIMESTAMP" time-props))) + (begin (point)) + (pos-after-head (save-excursion (forward-line) (point))) + (contents-begin (save-excursion (forward-line) + (org-skip-whitespace) + (if (eobp) (point) (point-at-bol)))) + (hidden (save-excursion (forward-line) (org-truely-invisible-p))) + (end (progn (goto-char (org-end-of-subtree t t)))) + (contents-end (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + title) ;; Clean RAW-VALUE from any quote or comment string. (when (or quotedp commentedp) - (setq raw-value - (replace-regexp-in-string - (concat "\\(" org-quote-string "\\|" org-comment-string "\\) +") - "" - raw-value))) + (setq raw-value + (replace-regexp-in-string + (concat "\\(" org-quote-string "\\|" org-comment-string "\\) +") + "" + raw-value))) ;; Clean TAGS from archive tag, if any. (when archivedp - (setq tags - (and (not (string= tags (format ":%s:" org-archive-tag))) - (replace-regexp-in-string - (concat org-archive-tag ":") "" tags))) - (when (string= tags ":") (setq tags nil))) + (setq tags + (and (not (string= tags (format ":%s:" org-archive-tag))) + (replace-regexp-in-string + (concat org-archive-tag ":") "" tags))) + (when (string= tags ":") (setq tags nil))) ;; Then get TITLE. (setq title (org-element-parse-secondary-string - raw-value - (cdr (assq 'headline org-element-string-restrictions)))) + raw-value + (cdr (assq 'headline org-element-string-restrictions)))) (list 'headline - `(:raw-value ,raw-value - :title ,title - :begin ,begin - :end ,end - :pre-blank ,(count-lines pos-after-head contents-begin) - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :level ,level - :priority ,(nth 3 components) - :tags ,tags - :todo-keyword ,todo - :todo-type ,todo-type - :scheduled ,scheduled - :deadline ,deadline - :timestamp ,timestamp - :clock ,clock - :post-blank ,(count-lines contents-end end) - :footnote-section-p ,footnote-section-p - :archivedp ,archivedp - :commentedp ,commentedp - :quotedp ,quotedp - ,@standard-props))))) + `(:raw-value ,raw-value + :title ,title + :begin ,begin + :end ,end + :pre-blank ,(count-lines pos-after-head contents-begin) + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :level ,level + :priority ,(nth 3 components) + :tags ,tags + :todo-keyword ,todo + :todo-type ,todo-type + :scheduled ,scheduled + :deadline ,deadline + :timestamp ,timestamp + :clock ,clock + :post-blank ,(count-lines contents-end end) + :footnote-section-p ,footnote-section-p + :archivedp ,archivedp + :commentedp ,commentedp + :quotedp ,quotedp + ,@standard-props))))) (defun org-element-headline-interpreter (headline contents) "Interpret HEADLINE element as Org syntax. CONTENTS is the contents of the element." (let* ((level (org-element-get-property :level headline)) - (todo (org-element-get-property :todo-keyword headline)) - (priority (org-element-get-property :priority headline)) - (title (org-element-get-property :raw-value headline)) - (tags (let ((tag-string (org-element-get-property :tags headline)) - (archivedp (org-element-get-property :archivedp headline))) - (cond - ((and (not tag-string) archivedp) - (format ":%s:" org-archive-tag)) - (archivedp (concat ":" org-archive-tag tag-string)) - (t tag-string)))) - (commentedp (org-element-get-property :commentedp headline)) - (quotedp (org-element-get-property :quotedp headline)) - (pre-blank (org-element-get-property :pre-blank headline)) - (heading (concat (make-string level ?*) - (and todo (concat " " todo)) - (and quotedp (concat " " org-quote-string)) - (and commentedp (concat " " org-comment-string)) - (and priority (concat " " priority)) - (cond ((and org-footnote-section - (org-element-get-property - :footnote-section-p headline)) - (concat " " org-footnote-section)) - (title (concat " " title))))) - ;; Align tags. - (tags-fmt (when tags - (let ((tags-len (length tags))) - (format "%% %ds" - (cond - ((zerop org-tags-column) (1+ tags-len)) - ((< org-tags-column 0) - (max (- (+ org-tags-column (length heading))) - (1+ tags-len))) - (t (max (+ (- org-tags-column (length heading)) - tags-len) - (1+ tags-len))))))))) + (todo (org-element-get-property :todo-keyword headline)) + (priority (org-element-get-property :priority headline)) + (title (org-element-get-property :raw-value headline)) + (tags (let ((tag-string (org-element-get-property :tags headline)) + (archivedp (org-element-get-property :archivedp headline))) + (cond + ((and (not tag-string) archivedp) + (format ":%s:" org-archive-tag)) + (archivedp (concat ":" org-archive-tag tag-string)) + (t tag-string)))) + (commentedp (org-element-get-property :commentedp headline)) + (quotedp (org-element-get-property :quotedp headline)) + (pre-blank (org-element-get-property :pre-blank headline)) + (heading (concat (make-string level ?*) + (and todo (concat " " todo)) + (and quotedp (concat " " org-quote-string)) + (and commentedp (concat " " org-comment-string)) + (and priority (concat " " priority)) + (cond ((and org-footnote-section + (org-element-get-property + :footnote-section-p headline)) + (concat " " org-footnote-section)) + (title (concat " " title))))) + ;; Align tags. + (tags-fmt (when tags + (let ((tags-len (length tags))) + (format "%% %ds" + (cond + ((zerop org-tags-column) (1+ tags-len)) + ((< org-tags-column 0) + (max (- (+ org-tags-column (length heading))) + (1+ tags-len))) + (t (max (+ (- org-tags-column (length heading)) + tags-len) + (1+ tags-len))))))))) (concat heading (and tags (format tags-fmt tags)) - (make-string (1+ pre-blank) 10) - contents))) + (make-string (1+ pre-blank) 10) + contents))) ;;;; Inlinetask (defun org-element-inlinetask-parser () @@ -450,64 +450,64 @@ containing `:raw-value', `:title', `:begin', `:end', `:hiddenp', Assume point is at beginning of the inline task." (save-excursion (let* ((keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (components (org-heading-components)) - (todo (nth 2 components)) - (todo-type (and todo - (if (member todo org-done-keywords) 'done 'todo))) - (raw-value (nth 4 components)) - (title (org-element-parse-secondary-string - raw-value - (cdr (assq 'inlinetask org-element-string-restrictions)))) - (contents-begin (save-excursion (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (pos-before-blank (org-inlinetask-goto-end)) - ;; In the case of a single line task, CONTENTS-BEGIN and - ;; CONTENTS-END might overlap. - (contents-end (max contents-begin - (save-excursion (forward-line -1) (point)))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (begin (car keywords)) + (components (org-heading-components)) + (todo (nth 2 components)) + (todo-type (and todo + (if (member todo org-done-keywords) 'done 'todo))) + (raw-value (nth 4 components)) + (title (org-element-parse-secondary-string + raw-value + (cdr (assq 'inlinetask org-element-string-restrictions)))) + (contents-begin (save-excursion (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (pos-before-blank (org-inlinetask-goto-end)) + ;; In the case of a single line task, CONTENTS-BEGIN and + ;; CONTENTS-END might overlap. + (contents-end (max contents-begin + (save-excursion (forward-line -1) (point)))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'inlinetask - `(:raw-value ,raw-value - :title ,title - :begin ,begin - :end ,end - :hiddenp ,(and (> contents-end contents-begin) hidden) - :contents-begin ,contents-begin - :contents-end ,contents-end - :level ,(nth 1 components) - :with-priority ,(nth 3 components) - :with-tags ,(nth 5 components) - :todo-keyword ,todo - :todo-type ,todo-type - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:raw-value ,raw-value + :title ,title + :begin ,begin + :end ,end + :hiddenp ,(and (> contents-end contents-begin) hidden) + :contents-begin ,contents-begin + :contents-end ,contents-end + :level ,(nth 1 components) + :with-priority ,(nth 3 components) + :with-tags ,(nth 5 components) + :todo-keyword ,todo + :todo-type ,todo-type + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-inlinetask-interpreter (inlinetask contents) "Interpret INLINETASK element as Org syntax. CONTENTS is the contents of inlinetask." (let* ((level (org-element-get-property :level inlinetask)) - (todo (org-element-get-property :todo-keyword inlinetask)) - (priority (org-element-get-property :priority inlinetask)) - (title (org-element-get-property :raw-value inlinetask)) - (tags (org-element-get-property :tags inlinetask)) - (task (concat (make-string level ?*) - (and todo (concat " " todo)) - (and priority (concat " " priority)) - (and title (concat " " title)))) - ;; Align tags. - (tags-fmt (when tags - (format "%% %ds" - (cond - ((zerop org-tags-column) 1) - ((< 0 org-tags-column) - (max (+ org-tags-column - (length inlinetask) - (length tags)) - 1)) - (t (max (- org-tags-column (length inlinetask)) - 1))))))) + (todo (org-element-get-property :todo-keyword inlinetask)) + (priority (org-element-get-property :priority inlinetask)) + (title (org-element-get-property :raw-value inlinetask)) + (tags (org-element-get-property :tags inlinetask)) + (task (concat (make-string level ?*) + (and todo (concat " " todo)) + (and priority (concat " " priority)) + (and title (concat " " title)))) + ;; Align tags. + (tags-fmt (when tags + (format "%% %ds" + (cond + ((zerop org-tags-column) 1) + ((< 0 org-tags-column) + (max (+ org-tags-column + (length inlinetask) + (length tags)) + 1)) + (t (max (- org-tags-column (length inlinetask)) + 1))))))) (concat inlinetask (and tags (format tags-fmt tags) "\n" contents)))) ;;;; Item @@ -524,69 +524,69 @@ Assume point is at the beginning of the item." (save-excursion (beginning-of-line) (let* ((begin (point)) - (bullet (org-list-get-bullet (point) struct)) - (checkbox (let ((box (org-list-get-checkbox begin struct))) - (cond ((equal "[ ]" box) 'off) - ((equal "[X]" box) 'on) - ((equal "[-]" box) 'trans)))) - (counter (let ((c (org-list-get-counter begin struct))) - (cond - ((not c) nil) - ((string-match "[A-Za-z]" c) - (- (string-to-char (upcase (match-string 0 c))) - 64)) - ((string-match "[0-9]+" c) - (string-to-number (match-string 0 c)))))) - (raw-tag (org-list-get-tag begin struct)) - (tag (and raw-tag - (org-element-parse-secondary-string - raw-tag - (cdr (assq 'item org-element-string-restrictions))))) - (end (org-list-get-item-end begin struct)) - (contents-begin (progn (looking-at org-list-full-item-re) - (goto-char (match-end 0)) - (org-skip-whitespace) - (if (>= (point) end) - (point-at-bol) - (point)))) - (hidden (progn (forward-line) - (and (not (= (point) end)) - (org-truely-invisible-p)))) - (contents-end (progn (goto-char end) - (skip-chars-backward " \r\t\n") - (forward-line) - (point)))) + (bullet (org-list-get-bullet (point) struct)) + (checkbox (let ((box (org-list-get-checkbox begin struct))) + (cond ((equal "[ ]" box) 'off) + ((equal "[X]" box) 'on) + ((equal "[-]" box) 'trans)))) + (counter (let ((c (org-list-get-counter begin struct))) + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c)))))) + (raw-tag (org-list-get-tag begin struct)) + (tag (and raw-tag + (org-element-parse-secondary-string + raw-tag + (cdr (assq 'item org-element-string-restrictions))))) + (end (org-list-get-item-end begin struct)) + (contents-begin (progn (looking-at org-list-full-item-re) + (goto-char (match-end 0)) + (org-skip-whitespace) + (if (>= (point) end) + (point-at-bol) + (point)))) + (hidden (progn (forward-line) + (and (not (= (point) end)) + (org-truely-invisible-p)))) + (contents-end (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (forward-line) + (point)))) ;; Note: CONTENTS-BEGIN and CONTENTS-END can be mixed up in the ;; case of an empty item separated from the next by a blank ;; line. (list 'item - `(:bullet ,bullet - :begin ,begin - :end ,end - :contents-begin ,(min contents-begin contents-end) - :contents-end ,(max contents-begin contents-end) - :checkbox ,checkbox - :counter ,counter - :raw-tag ,raw-tag - :tag ,tag - :hiddenp ,hidden - :structure ,struct - :post-blank ,(count-lines contents-end end)))))) + `(:bullet ,bullet + :begin ,begin + :end ,end + :contents-begin ,(min contents-begin contents-end) + :contents-end ,(max contents-begin contents-end) + :checkbox ,checkbox + :counter ,counter + :raw-tag ,raw-tag + :tag ,tag + :hiddenp ,hidden + :structure ,struct + :post-blank ,(count-lines contents-end end)))))) (defun org-element-item-interpreter (item contents) "Interpret ITEM element as Org syntax. CONTENTS is the contents of the element." (let* ((bullet (org-element-get-property :bullet item)) - (checkbox (org-element-get-property :checkbox item)) - (counter (org-element-get-property :counter item)) - (tag (org-element-get-property :raw-tag item)) - ;; Compute indentation. - (ind (make-string (length bullet) 32))) + (checkbox (org-element-get-property :checkbox item)) + (counter (org-element-get-property :counter item)) + (tag (org-element-get-property :raw-tag item)) + ;; Compute indentation. + (ind (make-string (length bullet) 32))) ;; Indent contents. (concat bullet (when (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp bullet)) + (string-match org-list-two-spaces-after-bullet-regexp bullet)) " ") (and counter (format "[@%d] " counter)) (cond @@ -610,41 +610,41 @@ keywords. Assume point is at one of the list items." (save-excursion (let* ((struct (or structure (org-list-struct))) - (prevs (org-list-prevs-alist struct)) - (parents (org-list-parents-alist struct)) - (type (org-list-get-list-type (point) struct prevs)) - (contents-begin (goto-char - (org-list-get-list-begin (point) struct prevs))) - (keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (contents-end (goto-char - (org-list-get-list-end (point) struct prevs))) - (end (save-excursion (org-skip-whitespace) - (if (eobp) (point) (point-at-bol)))) - (level 0)) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct)) + (type (org-list-get-list-type (point) struct prevs)) + (contents-begin (goto-char + (org-list-get-list-begin (point) struct prevs))) + (keywords (org-element-collect-affiliated-keywords)) + (begin (car keywords)) + (contents-end (goto-char + (org-list-get-list-end (point) struct prevs))) + (end (save-excursion (org-skip-whitespace) + (if (eobp) (point) (point-at-bol)))) + (level 0)) ;; Get list level. (let ((item contents-begin)) - (while (setq item - (org-list-get-parent - (org-list-get-list-begin item struct prevs) - struct parents)) - (incf level))) + (while (setq item + (org-list-get-parent + (org-list-get-list-begin item struct prevs) + struct parents)) + (incf level))) ;; Blank lines below list belong to the top-level list only. (when (> level 0) - (setq end (min (org-list-get-bottom-point struct) - (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol)))))) + (setq end (min (org-list-get-bottom-point struct) + (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol)))))) ;; Return value. (list 'plain-list - `(:type ,type - :begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :level ,level - :structure ,struct - :post-blank ,(count-lines contents-end end) - ,@(cadr keywords)))))) + `(:type ,type + :begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :level ,level + :structure ,struct + :post-blank ,(count-lines contents-end end) + ,@(cadr keywords)))))) (defun org-element-plain-list-interpreter (plain-list contents) "Interpret PLAIN-LIST element as Org syntax. @@ -662,28 +662,28 @@ containing `:begin', `:end', `:hiddenp', `:contents-begin', Assume point is at beginning or end of the block." (save-excursion (let* ((case-fold-search t) - (keywords (progn - (end-of-line) - (re-search-backward - (concat "^[ \t]*#\\+begin_quote") nil t) - (org-element-collect-affiliated-keywords))) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (contents-end (progn (re-search-forward - (concat "^[ \t]*#\\+end_quote") nil t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (keywords (progn + (end-of-line) + (re-search-backward + (concat "^[ \t]*#\\+begin_quote") nil t) + (org-element-collect-affiliated-keywords))) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (contents-end (progn (re-search-forward + (concat "^[ \t]*#\\+end_quote") nil t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'quote-block - `(:begin ,begin - :end ,end - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-quote-block-interpreter (quote-block contents) @@ -702,32 +702,32 @@ containing `:type', `:begin', `:end', `:hiddenp', Assume point is at beginning or end of the block." (save-excursion (let* ((case-fold-search t) - (type (progn (looking-at - "[ \t]*#\\+\\(?:begin\\|end\\)_\\([-A-Za-z0-9]+\\)") - (org-match-string-no-properties 1))) - (keywords (progn - (end-of-line) - (re-search-backward - (concat "^[ \t]*#\\+begin_" type) nil t) - (org-element-collect-affiliated-keywords))) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (contents-end (progn (re-search-forward - (concat "^[ \t]*#\\+end_" type) nil t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (type (progn (looking-at + "[ \t]*#\\+\\(?:begin\\|end\\)_\\([-A-Za-z0-9]+\\)") + (org-match-string-no-properties 1))) + (keywords (progn + (end-of-line) + (re-search-backward + (concat "^[ \t]*#\\+begin_" type) nil t) + (org-element-collect-affiliated-keywords))) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (contents-end (progn (re-search-forward + (concat "^[ \t]*#\\+end_" type) nil t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'special-block - `(:type ,type - :begin ,begin - :end ,end - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:type ,type + :begin ,begin + :end ,end + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-special-block-interpreter (special-block contents) "Interpret SPECIAL-BLOCK element as Org syntax. @@ -761,30 +761,30 @@ containing `:begin', `:end', `:info' and `:post-blank' as keywords." (save-excursion (let ((info (progn (looking-at org-babel-block-lob-one-liner-regexp) - (org-babel-lob-get-info))) - (beg (point-at-bol)) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (org-babel-lob-get-info))) + (beg (point-at-bol)) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'babel-call - `(:beg ,beg - :end ,end - :info ,info - :post-blank ,(count-lines pos-before-blank end)))))) + `(:beg ,beg + :end ,end + :info ,info + :post-blank ,(count-lines pos-before-blank end)))))) (defun org-element-babel-call-interpreter (inline-babel-call contents) "Interpret INLINE-BABEL-CALL object as Org syntax. CONTENTS is nil." (let* ((babel-info (org-element-get-property :info inline-babel-call)) - (main-source (car babel-info)) - (post-options (nth 1 babel-info))) + (main-source (car babel-info)) + (post-options (nth 1 babel-info))) (concat "#+call: " - (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source) - ;; Remove redundant square brackets. - (replace-match - (match-string 1 main-source) nil nil main-source) - main-source) - (and post-options (format "[%s]" post-options))))) + (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source) + ;; Remove redundant square brackets. + (replace-match + (match-string 1 main-source) nil nil main-source) + main-source) + (and post-options (format "[%s]" post-options))))) ;;;; Comment (defun org-element-comment-parser () @@ -794,13 +794,13 @@ Return a list whose car is `comment' and cdr is a plist containing `:begin', `:end', `:value' and `:post-blank' keywords." (let ((comment-re "\\(#\\|[ \t]*#\\+\\( \\|$\\)\\)") - beg-coms begin end value pos-before-blank keywords) + beg-coms begin end value pos-before-blank keywords) (save-excursion ;; Move to the beginning of comments. (unless (bobp) - (while (and (not (bobp)) (looking-at comment-re)) - (forward-line -1)) - (unless (looking-at comment-re) (forward-line 1))) + (while (and (not (bobp)) (looking-at comment-re)) + (forward-line -1)) + (unless (looking-at comment-re) (forward-line 1))) (setq beg-coms (point)) ;; Get affiliated keywords, if any. (setq keywords (org-element-collect-affiliated-keywords)) @@ -809,12 +809,12 @@ keywords." ;; Get ending of comments. If point is in a list, ensure to not ;; get outside of it. (let* ((itemp (org-in-item-p)) - (max-pos (if itemp - (org-list-get-bottom-point - (save-excursion (goto-char itemp) (org-list-struct))) - (point-max)))) - (while (and (looking-at comment-re) (< (point) max-pos)) - (forward-line))) + (max-pos (if itemp + (org-list-get-bottom-point + (save-excursion (goto-char itemp) (org-list-struct))) + (point-max)))) + (while (and (looking-at comment-re) (< (point) max-pos)) + (forward-line))) (setq pos-before-blank (point)) ;; Find position after blank. (org-skip-whitespace) @@ -822,11 +822,11 @@ keywords." ;; Extract value. (setq value (buffer-substring-no-properties beg-coms pos-before-blank))) (list 'comment - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords))))) + `(:begin ,begin + :end ,end + :value ,value + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords))))) (defun org-element-comment-interpreter (comment contents) "Interpret COMMENT element as Org syntax. @@ -843,34 +843,34 @@ containing `:begin', `:end', `:hiddenp', `:value' and (save-excursion (end-of-line) (let* ((case-fold-search t) - (keywords (progn - (re-search-backward "^[ \t]*#\\+begin_comment" nil t) - (org-element-collect-affiliated-keywords))) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (contents-end (progn (re-search-forward - "^[ \t]*#\\+end_comment" nil t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol)))) - (value (buffer-substring-no-properties contents-begin contents-end))) + (keywords (progn + (re-search-backward "^[ \t]*#\\+begin_comment" nil t) + (org-element-collect-affiliated-keywords))) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (contents-end (progn (re-search-forward + "^[ \t]*#\\+end_comment" nil t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol)))) + (value (buffer-substring-no-properties contents-begin contents-end))) (list 'comment-block - `(:begin ,begin - :end ,end - :value ,value - :hiddenp ,hidden - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :value ,value + :hiddenp ,hidden + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-comment-block-interpreter (comment-block contents) "Interpret COMMENT-BLOCK element as Org syntax. CONTENTS is nil." (concat "#+begin_comment\n" - (org-remove-indentation - (org-element-get-property :value comment-block)) - "#+begin_comment")) + (org-remove-indentation + (org-element-get-property :value comment-block)) + "#+begin_comment")) ;;;; Example Block (defun org-element-example-block-parser () @@ -882,38 +882,38 @@ containing `:begin', `:end', `:options', `:hiddenp', `:value' and (save-excursion (end-of-line) (let* ((case-fold-search t) - (options (progn - (re-search-backward - "^[ \t]*#\\+begin_example\\(?: +\\(.*\\)\\)?" nil t) - (org-match-string-no-properties 1))) - (keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (contents-end (progn - (re-search-forward "^[ \t]*#\\+end_example" nil t) - (point-at-bol))) - (value (buffer-substring-no-properties contents-begin contents-end)) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (options (progn + (re-search-backward + "^[ \t]*#\\+begin_example\\(?: +\\(.*\\)\\)?" nil t) + (org-match-string-no-properties 1))) + (keywords (org-element-collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (contents-end (progn + (re-search-forward "^[ \t]*#\\+end_example" nil t) + (point-at-bol))) + (value (buffer-substring-no-properties contents-begin contents-end)) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'example-block - `(:begin ,begin - :end ,end - :value ,value - :options ,options - :hiddenp ,hidden - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :value ,value + :options ,options + :hiddenp ,hidden + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-example-block-interpreter (example-block contents) "Interpret EXAMPLE-BLOCK element as Org syntax. CONTENTS is nil." (let ((options (org-element-get-property :options example-block))) (concat "#+begin_example" (and options (concat " " options)) "\n" - (org-remove-indentation - (org-element-get-property :value example-block)) - "#+end_example"))) + (org-remove-indentation + (org-element-get-property :value example-block)) + "#+end_example"))) ;;;; Export Block (defun org-element-export-block-parser () @@ -925,38 +925,38 @@ containing `:begin', `:end', `:type', `:hiddenp', `:value' and (save-excursion (end-of-line) (let* ((case-fold-search t) - (contents) - (type (progn (re-search-backward - (concat "[ \t]*#\\+begin_" - (org-re "\\([[:alnum:]]+\\)"))) - (downcase (org-match-string-no-properties 1)))) - (keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (contents-end (progn (re-search-forward - (concat "^[ \t]*#\\+end_" type) nil t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol)))) - (value (buffer-substring-no-properties contents-begin contents-end))) + (contents) + (type (progn (re-search-backward + (concat "[ \t]*#\\+begin_" + (org-re "\\([[:alnum:]]+\\)"))) + (downcase (org-match-string-no-properties 1)))) + (keywords (org-element-collect-affiliated-keywords)) + (begin (car keywords)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (contents-end (progn (re-search-forward + (concat "^[ \t]*#\\+end_" type) nil t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol)))) + (value (buffer-substring-no-properties contents-begin contents-end))) (list 'export-block - `(:begin ,begin - :end ,end - :type ,type - :value ,value - :hiddenp ,hidden - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :type ,type + :value ,value + :hiddenp ,hidden + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-export-block-interpreter (export-block contents) "Interpret EXPORT-BLOCK element as Org syntax. CONTENTS is nil." (let ((type (org-element-get-property :type export-block))) (concat (format "#+begin_%s\n" type) - (org-element-get-property :value export-block) - (format "#+end_%s" type)))) + (org-element-get-property :value export-block) + (format "#+end_%s" type)))) ;;;; Fixed-width (defun org-element-fixed-width-parser () @@ -966,13 +966,13 @@ Return a list whose car is `fixed-width' and cdr is a plist containing `:begin', `:end', `:value' and `:post-blank' keywords." (let ((fixed-re "[ \t]*:\\( \\|$\\)") - beg-area begin end value pos-before-blank keywords) + beg-area begin end value pos-before-blank keywords) (save-excursion ;; Move to the beginning of the fixed-width area. (unless (bobp) - (while (and (not (bobp)) (looking-at fixed-re)) - (forward-line -1)) - (unless (looking-at fixed-re) (forward-line 1))) + (while (and (not (bobp)) (looking-at fixed-re)) + (forward-line -1)) + (unless (looking-at fixed-re) (forward-line 1))) (setq beg-area (point)) ;; Get affiliated keywords, if any. (setq keywords (org-element-collect-affiliated-keywords)) @@ -981,12 +981,12 @@ keywords." ;; Get ending of fixed-width area. If point is in a list, ;; ensure to not get outside of it. (let* ((itemp (org-in-item-p)) - (max-pos (if itemp - (org-list-get-bottom-point - (save-excursion (goto-char itemp) (org-list-struct))) - (point-max)))) - (while (and (looking-at fixed-re) (< (point) max-pos)) - (forward-line))) + (max-pos (if itemp + (org-list-get-bottom-point + (save-excursion (goto-char itemp) (org-list-struct))) + (point-max)))) + (while (and (looking-at fixed-re) (< (point) max-pos)) + (forward-line))) (setq pos-before-blank (point)) ;; Find position after blank (org-skip-whitespace) @@ -994,11 +994,11 @@ keywords." ;; Extract value. (setq value (buffer-substring-no-properties beg-area pos-before-blank))) (list 'fixed-width - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords))))) + `(:begin ,begin + :end ,end + :value ,value + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords))))) (defun org-element-fixed-width-interpreter (fixed-width contents) "Interpret FIXED-WIDTH element as Org syntax. @@ -1014,15 +1014,15 @@ CONTENTS is nil." keywords." (save-excursion (let* ((keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (post-hr (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (begin (car keywords)) + (post-hr (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'horizontal-rule - `(:begin ,begin - :end ,end - :post-blank ,(count-lines post-hr end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :post-blank ,(count-lines post-hr end) + ,@(cadr keywords)))))) (defun org-element-horizontal-rule-interpreter (horizontal-rule contents) "Interpret HORIZONTAL-RULE element as Org syntax. @@ -1038,27 +1038,27 @@ containing `:key', `:value', `:begin', `:end' and `:post-blank' keywords." (save-excursion (let* ((begin (point)) - (key (progn (looking-at - "[ \t]*#\\+\\(\\(?:[a-z]+\\)\\(?:_[a-z]+\\)*\\):") - (org-match-string-no-properties 1))) - (value (org-trim (buffer-substring-no-properties - (match-end 0) (point-at-eol)))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (key (progn (looking-at + "[ \t]*#\\+\\(\\(?:[a-z]+\\)\\(?:_[a-z]+\\)*\\):") + (org-match-string-no-properties 1))) + (value (org-trim (buffer-substring-no-properties + (match-end 0) (point-at-eol)))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'keyword - `(:key ,key - :value ,value - :begin ,begin - :end ,end - :post-blank ,(count-lines pos-before-blank end)))))) + `(:key ,key + :value ,value + :begin ,begin + :end ,end + :post-blank ,(count-lines pos-before-blank end)))))) (defun org-element-keyword-interpreter (keyword contents) "Interpret KEYWORD element as Org syntax. CONTENTS is nil." (format "#+%s: %s" - (org-element-get-property :key keyword) - (org-element-get-property :value keyword))) + (org-element-get-property :key keyword) + (org-element-get-property :value keyword))) ;;;; Latex Environment (defun org-element-latex-environment-parser () @@ -1069,21 +1069,21 @@ containing `:begin', `:end', `:value' and `:post-blank' keywords." (save-excursion (end-of-line) (let* ((case-fold-search t) - (contents-begin (re-search-backward "^[ \t]*\\\\begin" nil t)) - (keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (contents-end (progn (re-search-forward "^[ \t]*\\\\end") - (forward-line) - (point))) - (value (buffer-substring-no-properties contents-begin contents-end)) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (contents-begin (re-search-backward "^[ \t]*\\\\begin" nil t)) + (keywords (org-element-collect-affiliated-keywords)) + (begin (car keywords)) + (contents-end (progn (re-search-forward "^[ \t]*\\\\end") + (forward-line) + (point))) + (value (buffer-substring-no-properties contents-begin contents-end)) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'latex-environment - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,(count-lines contents-end end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :value ,value + :post-blank ,(count-lines contents-end end) + ,@(cadr keywords)))))) (defun org-element-latex-environment-interpreter (latex-environment contents) "Interpret LATEX-ENVIRONMENT element as Org syntax. @@ -1101,24 +1101,24 @@ containing `:begin', `:end', `:contents-begin' and Assume point is at the beginning of the paragraph." (save-excursion (let* ((contents-begin (point)) - (keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (contents-end (progn - (end-of-line) - (if (re-search-forward - org-element-paragraph-separate nil 'm) - (progn (forward-line -1) (end-of-line) (point)) - (point)))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (keywords (org-element-collect-affiliated-keywords)) + (begin (car keywords)) + (contents-end (progn + (end-of-line) + (if (re-search-forward + org-element-paragraph-separate nil 'm) + (progn (forward-line -1) (end-of-line) (point)) + (point)))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'paragraph - `(:begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-paragraph-interpreter (paragraph contents) "Interpret PARAGRAPH element as Org syntax. @@ -1134,34 +1134,34 @@ containing `:begin', `:end', `:hiddenp', `:contents-begin', `:contents-end', `:properties' and `:post-blank' keywords." (save-excursion (let ((case-fold-search t) - (begin (progn (end-of-line) - (re-search-backward org-property-start-re) - (match-beginning 0))) - (contents-begin (progn (forward-line) (point))) - (hidden (org-truely-invisible-p)) - (properties (let (val) - (while (not (looking-at "^[ \t]*:END:")) - (when (looking-at - (org-re - "[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):")) - (push (cons (match-string 1) - (org-trim - (buffer-substring - (match-end 0) (point-at-eol)))) - val)) - (forward-line)) - val)) - (contents-end (progn (re-search-forward "^[ \t]*:END:" nil t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol))))) + (begin (progn (end-of-line) + (re-search-backward org-property-start-re) + (match-beginning 0))) + (contents-begin (progn (forward-line) (point))) + (hidden (org-truely-invisible-p)) + (properties (let (val) + (while (not (looking-at "^[ \t]*:END:")) + (when (looking-at + (org-re + "[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):")) + (push (cons (match-string 1) + (org-trim + (buffer-substring + (match-end 0) (point-at-eol)))) + val)) + (forward-line)) + val)) + (contents-end (progn (re-search-forward "^[ \t]*:END:" nil t) + (point-at-bol))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol))))) (list 'property-drawer - `(:begin ,begin - :end ,end - :hiddenp ,hidden - :properties ,properties - :post-blank ,(count-lines pos-before-blank end)))))) + `(:begin ,begin + :end ,end + :hiddenp ,hidden + :properties ,properties + :post-blank ,(count-lines pos-before-blank end)))))) (defun org-element-property-drawer-interpreter (property-drawer contents) "Interpret PROPERTY-DRAWER element as Org syntax. @@ -1170,8 +1170,8 @@ CONTENTS is nil." (concat ":PROPERTIES:\n" (mapconcat (lambda (p) - (format org-property-format (format ":%s:" (car p)) (cdr p))) - (nreverse props) "\n") + (format org-property-format (format ":%s:" (car p)) (cdr p))) + (nreverse props) "\n") "\n:END:"))) ;;;; Quote Section @@ -1183,23 +1183,23 @@ containing `:begin', `:end', `:value' and `:post-blank' keywords." (save-excursion (let* ((begin (progn (org-back-to-heading t) - (forward-line) - (org-skip-whitespace) - (point-at-bol))) - (end (progn (org-with-limited-levels (outline-next-heading)) - (point))) - (pos-before-blank (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point))) - (value (unless (= begin end) - (buffer-substring-no-properties begin pos-before-blank)))) + (forward-line) + (org-skip-whitespace) + (point-at-bol))) + (end (progn (org-with-limited-levels (outline-next-heading)) + (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + (value (unless (= begin end) + (buffer-substring-no-properties begin pos-before-blank)))) (list 'quote-section - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,(if value - (count-lines pos-before-blank end) - 0)))))) + `(:begin ,begin + :end ,end + :value ,value + :post-blank ,(if value + (count-lines pos-before-blank end) + 0)))))) (defun org-element-quote-section-interpreter (quote-section contents) "Interpret QUOTE-SECTION element as Org syntax. @@ -1217,75 +1217,75 @@ and `:post-blank' keywords." (save-excursion (end-of-line) (let* ((case-fold-search t) - ;; Get position at beginning of block. - (contents-begin - (re-search-backward - (concat "^[ \t]*#\\+begin_src" - "\\(?: +\\(\\S-+\\)\\)?" ; language - "\\(\\(?: +[-+][A-Za-z]\\)*\\)" ; switches - "\\(.*\\)[ \t]*$") ; arguments - nil t)) - ;; Get language as a string. - (language (org-match-string-no-properties 1)) - ;; Get switches. - (switches (org-match-string-no-properties 2)) - ;; Get parameters. - (parameters (org-trim (org-match-string-no-properties 3))) - ;; Get affiliated keywords. - (keywords (org-element-collect-affiliated-keywords)) - ;; Get beginning position. - (begin (car keywords)) - ;; Get position at end of block. - (contents-end (progn (re-search-forward "^[ \t]*#\\+end_src" nil t) - (forward-line) - (point))) - ;; Retrieve code. - (value (buffer-substring-no-properties - (save-excursion (goto-char contents-begin) - (forward-line) - (point)) - (match-beginning 0))) - ;; Get position after ending blank lines. - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol)))) - ;; Get visibility status. - (hidden (progn (goto-char contents-begin) - (forward-line) - (org-truely-invisible-p)))) + ;; Get position at beginning of block. + (contents-begin + (re-search-backward + (concat "^[ \t]*#\\+begin_src" + "\\(?: +\\(\\S-+\\)\\)?" ; language + "\\(\\(?: +[-+][A-Za-z]\\)*\\)" ; switches + "\\(.*\\)[ \t]*$") ; arguments + nil t)) + ;; Get language as a string. + (language (org-match-string-no-properties 1)) + ;; Get switches. + (switches (org-match-string-no-properties 2)) + ;; Get parameters. + (parameters (org-trim (org-match-string-no-properties 3))) + ;; Get affiliated keywords. + (keywords (org-element-collect-affiliated-keywords)) + ;; Get beginning position. + (begin (car keywords)) + ;; Get position at end of block. + (contents-end (progn (re-search-forward "^[ \t]*#\\+end_src" nil t) + (forward-line) + (point))) + ;; Retrieve code. + (value (buffer-substring-no-properties + (save-excursion (goto-char contents-begin) + (forward-line) + (point)) + (match-beginning 0))) + ;; Get position after ending blank lines. + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol)))) + ;; Get visibility status. + (hidden (progn (goto-char contents-begin) + (forward-line) + (org-truely-invisible-p)))) (list 'src-block - `(:language ,language - :switches ,switches - :parameters ,parameters - :begin ,begin - :end ,end - :hiddenp ,hidden - :value ,value - :post-blank ,(count-lines contents-end end) - ,@(cadr keywords)))))) + `(:language ,language + :switches ,switches + :parameters ,parameters + :begin ,begin + :end ,end + :hiddenp ,hidden + :value ,value + :post-blank ,(count-lines contents-end end) + ,@(cadr keywords)))))) (defun org-element-src-block-interpreter (src-block contents) "Interpret SRC-BLOCK element as Org syntax. CONTENTS is nil." (let ((lang (org-element-get-property :language src-block)) - (switches (org-element-get-property :switches src-block)) - (params (org-element-get-property :parameters src-block)) - (value (let ((val (org-element-get-property :value src-block))) - (cond - (org-src-preserve-indentation val) - ((zerop org-edit-src-content-indentation) - (org-remove-indentation val)) - (t - (let ((ind (make-string - org-edit-src-content-indentation 32))) - (replace-regexp-in-string - "\\(^\\)[ \t]*\\S-" ind - (org-remove-indentation val) nil nil 1))))))) + (switches (org-element-get-property :switches src-block)) + (params (org-element-get-property :parameters src-block)) + (value (let ((val (org-element-get-property :value src-block))) + (cond + (org-src-preserve-indentation val) + ((zerop org-edit-src-content-indentation) + (org-remove-indentation val)) + (t + (let ((ind (make-string + org-edit-src-content-indentation 32))) + (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind + (org-remove-indentation val) nil nil 1))))))) (concat (format "#+begin_src%s\n" - (concat (and lang (concat " " lang)) - (and switches (concat " " switches)) - (and params (concat " " params)))) - value - "#+end_src"))) + (concat (and lang (concat " " lang)) + (and switches (concat " " switches)) + (and params (concat " " params)))) + value + "#+end_src"))) ;;;; Table (defun org-element-table-parser () @@ -1296,26 +1296,26 @@ Return a list whose car is `table' and cdr is a plist containing `:type', `:raw-table' and `:post-blank' keywords." (save-excursion (let* ((table-begin (goto-char (org-table-begin t))) - (type (if (org-at-table.el-p) 'table.el 'org)) - (keywords (org-element-collect-affiliated-keywords)) - (begin (car keywords)) - (table-end (goto-char (marker-position (org-table-end t)))) - (tblfm (when (looking-at "[ \t]*#\\+tblfm: +\\(.*\\)[ \t]*") - (prog1 (org-match-string-no-properties 1) - (forward-line)))) - (pos-before-blank (point)) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol)))) - (raw-table (org-remove-indentation - (buffer-substring-no-properties table-begin table-end)))) + (type (if (org-at-table.el-p) 'table.el 'org)) + (keywords (org-element-collect-affiliated-keywords)) + (begin (car keywords)) + (table-end (goto-char (marker-position (org-table-end t)))) + (tblfm (when (looking-at "[ \t]*#\\+tblfm: +\\(.*\\)[ \t]*") + (prog1 (org-match-string-no-properties 1) + (forward-line)))) + (pos-before-blank (point)) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol)))) + (raw-table (org-remove-indentation + (buffer-substring-no-properties table-begin table-end)))) (list 'table - `(:begin ,begin - :end ,end - :type ,type - :raw-table ,raw-table - :tblfm ,tblfm - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :type ,type + :raw-table ,raw-table + :tblfm ,tblfm + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-table-interpreter (table contents) "Interpret TABLE element as Org syntax. @@ -1333,32 +1333,32 @@ and `:post-blank' keywords. Assume point is at beginning or end of the block." (save-excursion (let* ((case-fold-search t) - (keywords (progn - (end-of-line) - (re-search-backward - (concat "^[ \t]*#\\+begin_verse") nil t) - (org-element-collect-affiliated-keywords))) - (begin (car keywords)) - (hidden (progn (forward-line) (org-truely-invisible-p))) - (raw-val (buffer-substring-no-properties - (point) - (progn - (re-search-forward (concat "^[ \t]*#\\+end_verse") nil t) - (point-at-bol)))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (org-skip-whitespace) - (if (eobp) (point) (point-at-bol)))) - (value (org-element-parse-secondary-string - (org-remove-indentation raw-val) - (cdr (assq 'verse org-element-string-restrictions))))) + (keywords (progn + (end-of-line) + (re-search-backward + (concat "^[ \t]*#\\+begin_verse") nil t) + (org-element-collect-affiliated-keywords))) + (begin (car keywords)) + (hidden (progn (forward-line) (org-truely-invisible-p))) + (raw-val (buffer-substring-no-properties + (point) + (progn + (re-search-forward (concat "^[ \t]*#\\+end_verse") nil t) + (point-at-bol)))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (org-skip-whitespace) + (if (eobp) (point) (point-at-bol)))) + (value (org-element-parse-secondary-string + (org-remove-indentation raw-val) + (cdr (assq 'verse org-element-string-restrictions))))) (list 'verse-block - `(:begin ,begin - :end ,end - :hiddenp ,hidden - :raw-value ,raw-val - :value ,value - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(:begin ,begin + :end ,end + :hiddenp ,hidden + :raw-value ,raw-val + :value ,value + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-verse-block-interpreter (verse-block contents) @@ -1407,19 +1407,19 @@ Assume point is at the first emphasis marker." (unless (bolp) (backward-char 1)) (looking-at org-emph-re) (let ((begin (match-beginning 2)) - (marker (org-match-string-no-properties 3)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) + (marker (org-match-string-no-properties 3)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) (list 'emphasis - `(:marker ,marker - :begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,post-blank))))) + `(:marker ,marker + :begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,post-blank))))) (defun org-element-emphasis-interpreter (emphasis contents) "Interpret EMPHASIS object as Org syntax. @@ -1438,9 +1438,9 @@ Return value is a cons cell whose car is `emphasis' or (unless (bolp) (backward-char)) (when (re-search-forward org-emph-re limit t) (cons (if (nth 4 (assoc (match-string 3) org-emphasis-alist)) - 'verbatim - 'emphasis) - (match-beginning 2))))) + 'verbatim + 'emphasis) + (match-beginning 2))))) ;;;; Entity (defun org-element-entity-parser () @@ -1455,31 +1455,31 @@ Assume point is at the beginning of the entity." (save-excursion (looking-at "\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)") (let* ((value (org-entity-get (match-string 1))) - (begin (match-beginning 0)) - (bracketsp (string= (match-string 2) "{}")) - (post-blank (progn (goto-char (match-end 1)) - (when bracketsp (forward-char 2)) - (skip-chars-forward " \t"))) - (end (point))) + (begin (match-beginning 0)) + (bracketsp (string= (match-string 2) "{}")) + (post-blank (progn (goto-char (match-end 1)) + (when bracketsp (forward-char 2)) + (skip-chars-forward " \t"))) + (end (point))) (list 'entity - `(:name ,(car value) - :latex ,(nth 1 value) - :latex-math-p ,(nth 2 value) - :html ,(nth 3 value) - :ascii ,(nth 4 value) - :latin1 ,(nth 5 value) - :utf-8 ,(nth 6 value) - :begin ,begin - :end ,end - :use-brackets-p ,bracketsp - :post-blank ,post-blank))))) + `(:name ,(car value) + :latex ,(nth 1 value) + :latex-math-p ,(nth 2 value) + :html ,(nth 3 value) + :ascii ,(nth 4 value) + :latin1 ,(nth 5 value) + :utf-8 ,(nth 6 value) + :begin ,begin + :end ,end + :use-brackets-p ,bracketsp + :post-blank ,post-blank))))) (defun org-element-entity-interpreter (entity contents) "Interpret ENTITY object as Org syntax. CONTENTS is nil." (concat "\\" - (org-element-get-property :name entity) - (when (org-element-get-property :use-brackets-p entity) "{}"))) + (org-element-get-property :name entity) + (when (org-element-get-property :use-brackets-p entity) "{}"))) (defun org-element-latex-or-entity-successor (limit) "Search for the next latex-fragment or entity object. @@ -1490,30 +1490,30 @@ Return value is a cons cell whose car is `entity' or `latex-fragment' and cdr is beginning position." (save-excursion (let ((matchers (plist-get org-format-latex-options :matchers)) - ;; ENTITY-RE matches both LaTeX commands and Org entities. - (entity-re - "\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|[^[:alpha:]\n]\\)")) + ;; ENTITY-RE matches both LaTeX commands and Org entities. + (entity-re + "\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|[^[:alpha:]\n]\\)")) (when (re-search-forward - (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps))) - matchers "\\|") - "\\|" entity-re) - limit t) - (goto-char (match-beginning 0)) - (if (looking-at entity-re) - ;; Determine if it's a real entity or a LaTeX command. - (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment) - (match-beginning 0)) - ;; No entity nor command: point is at a LaTeX fragment. - ;; Determine its type to get the correct beginning position. - (cons 'latex-fragment - (catch 'return - (mapc (lambda (e) - (when (looking-at (nth 1 (assoc e org-latex-regexps))) - (throw 'return - (match-beginning - (nth 2 (assoc e org-latex-regexps)))))) - matchers) - (point)))))))) + (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps))) + matchers "\\|") + "\\|" entity-re) + limit t) + (goto-char (match-beginning 0)) + (if (looking-at entity-re) + ;; Determine if it's a real entity or a LaTeX command. + (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment) + (match-beginning 0)) + ;; No entity nor command: point is at a LaTeX fragment. + ;; Determine its type to get the correct beginning position. + (cons 'latex-fragment + (catch 'return + (mapc (lambda (e) + (when (looking-at (nth 1 (assoc e org-latex-regexps))) + (throw 'return + (match-beginning + (nth 2 (assoc e org-latex-regexps)))))) + matchers) + (point)))))))) ;;;; Export Snippet (defun org-element-export-snippet-parser () @@ -1527,25 +1527,25 @@ Assume point is at the beginning of the snippet." (save-excursion (looking-at "@\\([-A-Za-z0-9]+\\){") (let* ((begin (point)) - (back-end (org-match-string-no-properties 1)) - (before-blank (progn (goto-char (scan-sexps (1- (match-end 0)) 1)))) - (value (buffer-substring-no-properties - (match-end 0) (1- before-blank))) - (post-blank (skip-chars-forward " \t")) - (end (point))) + (back-end (org-match-string-no-properties 1)) + (before-blank (progn (goto-char (scan-sexps (1- (match-end 0)) 1)))) + (value (buffer-substring-no-properties + (match-end 0) (1- before-blank))) + (post-blank (skip-chars-forward " \t")) + (end (point))) (list 'export-snippet - `(:back-end ,back-end - :value ,value - :begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(:back-end ,back-end + :value ,value + :begin ,begin + :end ,end + :post-blank ,post-blank))))) (defun org-element-export-snippet-interpreter (export-snippet contents) "Interpret EXPORT-SNIPPET object as Org syntax. CONTENTS is nil." (format "@%s{%s}" - (org-element-get-property :back-end export-snippet) - (org-element-get-property :value export-snippet))) + (org-element-get-property :back-end export-snippet) + (org-element-get-property :value export-snippet))) (defun org-element-export-snippet-successor (limit) "Search for the next export-snippet object. @@ -1557,9 +1557,9 @@ its beginning position." (save-excursion (catch 'exit (while (re-search-forward "@[-A-Za-z0-9]+{" limit t) - (when (let ((end (ignore-errors (scan-sexps (1- (point)) 1)))) - (and end (eq (char-before end) ?}))) - (throw 'exit (cons 'export-snippet (match-beginning 0)))))))) + (when (let ((end (ignore-errors (scan-sexps (1- (point)) 1)))) + (and end (eq (char-before end) ?}))) + (throw 'exit (cons 'export-snippet (match-beginning 0)))))))) ;;;; Footnote Reference @@ -1571,32 +1571,32 @@ with `:label', `:type', `:definition', `:begin', `:end' and `:post-blank' as keywords." (save-excursion (let* ((ref (org-footnote-at-reference-p)) - (label (car ref)) - (raw-def (nth 3 ref)) - (inline-def (and raw-def - (org-element-parse-secondary-string raw-def nil))) - (type (if (nth 3 ref) 'inline 'standard)) - (begin (nth 1 ref)) - (post-blank (progn (goto-char (nth 2 ref)) - (skip-chars-forward " \t"))) - (end (point))) + (label (car ref)) + (raw-def (nth 3 ref)) + (inline-def (and raw-def + (org-element-parse-secondary-string raw-def nil))) + (type (if (nth 3 ref) 'inline 'standard)) + (begin (nth 1 ref)) + (post-blank (progn (goto-char (nth 2 ref)) + (skip-chars-forward " \t"))) + (end (point))) (list 'footnote-reference - `(:label ,label - :type ,type - :inline-definition ,inline-def - :begin ,begin - :end ,end - :post-blank ,post-blank - :raw-definition ,raw-def))))) + `(:label ,label + :type ,type + :inline-definition ,inline-def + :begin ,begin + :end ,end + :post-blank ,post-blank + :raw-definition ,raw-def))))) (defun org-element-footnote-reference-interpreter (footnote-reference contents) "Interpret FOOTNOTE-REFERENCE object as Org syntax. CONTENTS is nil." (let ((label (or (org-element-get-property :label footnote-reference) - "fn:")) - (def (let ((raw (org-element-get-property - :raw-definition footnote-reference))) - (if raw (concat ":" raw) "")))) + "fn:")) + (def (let ((raw (org-element-get-property + :raw-definition footnote-reference))) + (if raw (concat ":" raw) "")))) (format "[%s]" (concat label def)))) (defun org-element-footnote-reference-successor (limit) @@ -1624,29 +1624,29 @@ Assume point is at the beginning of the babel call." (unless (bolp) (backward-char)) (looking-at org-babel-inline-lob-one-liner-regexp) (let ((info (save-match-data (org-babel-lob-get-info))) - (begin (match-end 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) + (begin (match-end 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) (list 'inline-babel-call - `(:begin ,begin - :end ,end - :info ,info - :post-blank ,post-blank))))) + `(:begin ,begin + :end ,end + :info ,info + :post-blank ,post-blank))))) (defun org-element-inline-babel-call-interpreter (inline-babel-call contents) "Interpret INLINE-BABEL-CALL object as Org syntax. CONTENTS is nil." (let* ((babel-info (org-element-get-property :info inline-babel-call)) - (main-source (car babel-info)) - (post-options (nth 1 babel-info))) + (main-source (car babel-info)) + (post-options (nth 1 babel-info))) (concat "call_" - (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source) - ;; Remove redundant square brackets. - (replace-match - (match-string 1 main-source) nil nil main-source) - main-source) - (and post-options (format "[%s]" post-options))))) + (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source) + ;; Remove redundant square brackets. + (replace-match + (match-string 1 main-source) nil nil main-source) + main-source) + (and post-options (format "[%s]" post-options))))) (defun org-element-inline-babel-call-successor (limit) "Search for the next inline-babel-call and return beginning @@ -1660,8 +1660,8 @@ cdr is beginning position." ;; Use a simplified version of ;; org-babel-inline-lob-one-liner-regexp as regexp for more speed. (when (re-search-forward - "\\(?:babel\\|call\\)_\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\([^\n]*\\))\\(\\[\\(.*?\\)\\]\\)?" - limit t) + "\\(?:babel\\|call\\)_\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\([^\n]*\\))\\(\\[\\(.*?\\)\\]\\)?" + limit t) (cons 'inline-babel-call (match-beginning 0))))) ;;;; Inline Src Block @@ -1677,19 +1677,19 @@ Assume point is at the beginning of the inline src block." (unless (bolp) (backward-char)) (looking-at org-babel-inline-src-block-regexp) (let ((begin (match-beginning 1)) - (language (org-match-string-no-properties 2)) - (parameters (org-match-string-no-properties 4)) - (value (org-match-string-no-properties 5)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) + (language (org-match-string-no-properties 2)) + (parameters (org-match-string-no-properties 4)) + (value (org-match-string-no-properties 5)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) (list 'inline-src-block - `(:language ,language - :value ,value - :parameters ,parameters - :begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(:language ,language + :value ,value + :parameters ,parameters + :begin ,begin + :end ,end + :post-blank ,post-blank))))) @@ -1714,29 +1714,29 @@ Return a list whose car is `latex-fragment' and cdr a plist with Assume point is at the beginning of the latex fragment." (save-excursion (let* ((begin (point)) - (substring-match - (catch 'exit - (mapc (lambda (e) - (let ((latex-regexp (nth 1 (assoc e org-latex-regexps)))) - (when (or (looking-at latex-regexp) - (and (not (bobp)) - (save-excursion - (backward-char) - (looking-at latex-regexp)))) - (throw 'exit (nth 2 (assoc e org-latex-regexps)))))) - (plist-get org-format-latex-options :matchers)) - ;; None found: it's a macro. - (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*") - 0)) - (value (match-string-no-properties substring-match)) - (post-blank (progn (goto-char (match-end substring-match)) - (skip-chars-forward " \t"))) - (end (point))) + (substring-match + (catch 'exit + (mapc (lambda (e) + (let ((latex-regexp (nth 1 (assoc e org-latex-regexps)))) + (when (or (looking-at latex-regexp) + (and (not (bobp)) + (save-excursion + (backward-char) + (looking-at latex-regexp)))) + (throw 'exit (nth 2 (assoc e org-latex-regexps)))))) + (plist-get org-format-latex-options :matchers)) + ;; None found: it's a macro. + (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*") + 0)) + (value (match-string-no-properties substring-match)) + (post-blank (progn (goto-char (match-end substring-match)) + (skip-chars-forward " \t"))) + (end (point))) (list 'latex-fragment - `(:value ,value - :begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(:value ,value + :begin ,begin + :end ,end + :post-blank ,post-blank))))) (defun org-element-latex-fragment-interpreter (latex-fragment contents) "Interpret LATEX-FRAGMENT object as Org syntax. @@ -1753,13 +1753,13 @@ Return a list whose car is `line-break', and cdr a plist with Assume point is at the beginning of the line break." (save-excursion (let* ((begin (point)) - (end (progn (end-of-line) (point))) - (post-blank (- (skip-chars-backward " \t"))) - (end (point))) + (end (progn (end-of-line) (point))) + (post-blank (- (skip-chars-backward " \t"))) + (end (point))) (list 'line-break - `(:begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(:begin ,begin + :end ,end + :post-blank ,post-blank))))) (defun org-element-line-break-interpreter (line-break contents) "Interpret LINE-BREAK object as Org syntax. @@ -1775,10 +1775,10 @@ Return value is a cons cell whose car is `line-break' and cdr is beginning position." (save-excursion (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t) - (goto-char (match-beginning 1))))) + (goto-char (match-beginning 1))))) ;; A line break can only happen on a non-empty line. (when (and beg (re-search-backward "\\S-" (point-at-bol) t)) - (cons 'line-break beg))))) + (cons 'line-break beg))))) ;;;; Link (defun org-element-link-parser () @@ -1791,84 +1791,84 @@ Return a list whose car is `link' and cdr a plist with `:type', Assume point is at the beginning of the link." (save-excursion (let ((begin (point)) - end contents-begin contents-end link-end post-blank path type - raw-link link) + end contents-begin contents-end link-end post-blank path type + raw-link link) (cond ;; Type 1: text targeted from a radio target. ((and org-target-link-regexp (looking-at org-target-link-regexp)) - (setq type "radio" - path (org-match-string-no-properties 0) - contents-begin (match-beginning 0) - contents-end (match-end 0) - link-end (match-end 0))) + (setq type "radio" + path (org-match-string-no-properties 0) + contents-begin (match-beginning 0) + contents-end (match-end 0) + link-end (match-end 0))) ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]] ((looking-at org-bracket-link-regexp) - (setq contents-begin (match-beginning 3) - contents-end (match-end 3) - link-end (match-end 0) - ;; RAW-LINK is the original link. - raw-link (org-match-string-no-properties 1) - link (org-link-expand-abbrev - (replace-regexp-in-string - " *\n *" " " (org-link-unescape raw-link) t t))) - ;; Determine TYPE of link and set PATH accordingly. - (cond - ;; File type. - ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link)) - (setq type "file" path link)) - ;; Explicit type (http, irc, bbdb...). See `org-link-types'. - ((string-match org-link-re-with-space3 link) - (setq type (match-string 1 link) path (match-string 2 link))) - ;; Id type: PATH is the id. - ((string-match "^id:\\([-a-f0-9]+\\)" link) - (setq type "id" path (match-string 1 link))) - ;; Code-ref type: PATH is the name of the reference. - ((string-match "^(\\(.*\\))$" link) - (setq type "coderef" path (match-string 1 link))) - ;; Custom-id type: PATH is the name of the custom id. - ((= (aref link 0) ?#) - (setq type "custom-id" path (substring link 1))) - ;; Fuzzy type: Internal link either matches a target, an - ;; headline name or nothing. PATH is the target or headline's - ;; name. - (t (setq type "fuzzy" path link)))) + (setq contents-begin (match-beginning 3) + contents-end (match-end 3) + link-end (match-end 0) + ;; RAW-LINK is the original link. + raw-link (org-match-string-no-properties 1) + link (org-link-expand-abbrev + (replace-regexp-in-string + " *\n *" " " (org-link-unescape raw-link) t t))) + ;; Determine TYPE of link and set PATH accordingly. + (cond + ;; File type. + ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link)) + (setq type "file" path link)) + ;; Explicit type (http, irc, bbdb...). See `org-link-types'. + ((string-match org-link-re-with-space3 link) + (setq type (match-string 1 link) path (match-string 2 link))) + ;; Id type: PATH is the id. + ((string-match "^id:\\([-a-f0-9]+\\)" link) + (setq type "id" path (match-string 1 link))) + ;; Code-ref type: PATH is the name of the reference. + ((string-match "^(\\(.*\\))$" link) + (setq type "coderef" path (match-string 1 link))) + ;; Custom-id type: PATH is the name of the custom id. + ((= (aref link 0) ?#) + (setq type "custom-id" path (substring link 1))) + ;; Fuzzy type: Internal link either matches a target, an + ;; headline name or nothing. PATH is the target or headline's + ;; name. + (t (setq type "fuzzy" path link)))) ;; Type 3: Plain link, i.e. http://orgmode.org ((looking-at org-plain-link-re) - (setq raw-link (org-match-string-no-properties 0) - type (org-match-string-no-properties 1) - path (org-match-string-no-properties 2) - link-end (match-end 0))) + (setq raw-link (org-match-string-no-properties 0) + type (org-match-string-no-properties 1) + path (org-match-string-no-properties 2) + link-end (match-end 0))) ;; Type 4: Angular link, i.e. ((looking-at org-angle-link-re) - (setq raw-link (buffer-substring-no-properties - (match-beginning 1) (match-end 2)) - type (org-match-string-no-properties 1) - path (org-match-string-no-properties 2) - link-end (match-end 0)))) + (setq raw-link (buffer-substring-no-properties + (match-beginning 1) (match-end 2)) + type (org-match-string-no-properties 1) + path (org-match-string-no-properties 2) + link-end (match-end 0)))) ;; In any case, deduce end point after trailing white space from ;; LINK-END variable. (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) - end (point)) + end (point)) (list 'link - `(:type ,type - :path ,path - :raw-link ,(or raw-link path) - :begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,post-blank))))) + `(:type ,type + :path ,path + :raw-link ,(or raw-link path) + :begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,post-blank))))) (defun org-element-link-interpreter (link contents) "Interpret LINK object as Org syntax. CONTENTS is the contents of the object." (let ((type (org-element-get-property :type link)) - (raw-link (org-element-get-property :raw-link link))) + (raw-link (org-element-get-property :raw-link link))) (cond ((string= type "radio") raw-link) (t (format "[[%s]%s]" - raw-link - (if (string= contents "") "" (format "[%s]" contents))))))) + raw-link + (if (string= contents "") "" (format "[%s]" contents))))))) (defun org-element-link-successor (limit) "Search for the next link and return position. @@ -1879,11 +1879,11 @@ Return value is a cons cell whose car is `link' and cdr is beginning position." (save-excursion (let ((link-regexp - (if org-target-link-regexp - (concat org-any-link-re "\\|" org-target-link-regexp) - org-any-link-re))) + (if org-target-link-regexp + (concat org-any-link-re "\\|" org-target-link-regexp) + org-any-link-re))) (when (re-search-forward link-regexp limit t) - (cons 'link (match-beginning 0)))))) + (cons 'link (match-beginning 0)))))) ;;;; Macro (defun org-element-macro-parser () @@ -1897,29 +1897,29 @@ Assume point is at the macro." (save-excursion (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}") (let ((begin (point)) - (key (downcase (org-match-string-no-properties 1))) - (value (org-match-string-no-properties 0)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point)) - (args (let ((args (org-match-string-no-properties 3)) args2) - (when args - (setq args (org-split-string args ",")) - (while args - (while (string-match "\\\\\\'" (car args)) - ;; Repair bad splits. - (setcar (cdr args) (concat (substring (car args) 0 -1) - "," (nth 1 args))) - (pop args)) - (push (pop args) args2)) - (mapcar 'org-trim (nreverse args2)))))) + (key (downcase (org-match-string-no-properties 1))) + (value (org-match-string-no-properties 0)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point)) + (args (let ((args (org-match-string-no-properties 3)) args2) + (when args + (setq args (org-split-string args ",")) + (while args + (while (string-match "\\\\\\'" (car args)) + ;; Repair bad splits. + (setcar (cdr args) (concat (substring (car args) 0 -1) + "," (nth 1 args))) + (pop args)) + (push (pop args) args2)) + (mapcar 'org-trim (nreverse args2)))))) (list 'macro - `(:key ,key - :value ,value - :args ,args - :begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(:key ,key + :value ,value + :args ,args + :begin ,begin + :end ,end + :post-blank ,post-blank))))) (defun org-element-macro-interpreter (macro contents) "Interpret MACRO object as Org syntax. @@ -1935,8 +1935,8 @@ Return value is cons cell whose car is `macro' and cdr is beginning position." (save-excursion (when (re-search-forward - "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" - limit t) + "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" + limit t) (cons 'macro (match-beginning 0))))) ;;;; Radio-target @@ -1951,19 +1951,19 @@ Assume point is at the radio target." (save-excursion (looking-at org-radio-target-regexp) (let ((begin (point)) - (contents-begin (match-beginning 1)) - (contents-end (match-end 1)) - (raw-value (org-match-string-no-properties 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1)) + (raw-value (org-match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) (list 'radio-target - `(:begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :raw-value ,raw-value - :post-blank ,post-blank))))) + `(:begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :raw-value ,raw-value + :post-blank ,post-blank))))) (defun org-element-radio-target-interpreter (target contents) "Interpret TARGET object as Org syntax. @@ -1992,16 +1992,16 @@ Assume point is at the beginning of the statistics-cookie." (save-excursion (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") (let* ((begin (point)) - (value (buffer-substring-no-properties - (match-beginning 0) (match-end 0))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) + (value (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) (list 'statistics-cookie - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,post-blank))))) + `(:begin ,begin + :end ,end + :value ,value + :post-blank ,post-blank))))) (defun org-element-statistics-cookie-interpreter (statistics-cookie contents) "Interpret STATISTICS-COOKIE object as Org syntax. @@ -2031,22 +2031,22 @@ Assume point is at the underscore." (save-excursion (unless (bolp) (backward-char)) (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) - t - (not (looking-at org-match-substring-regexp)))) - (begin (match-beginning 2)) - (contents-begin (or (match-beginning 5) - (match-beginning 3))) - (contents-end (or (match-end 5) (match-end 3))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) + t + (not (looking-at org-match-substring-regexp)))) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 5) + (match-beginning 3))) + (contents-end (or (match-end 5) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) (list 'subscript - `(:begin ,begin - :end ,end - :use-brackets-p ,bracketsp - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,post-blank))))) + `(:begin ,begin + :end ,end + :use-brackets-p ,bracketsp + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,post-blank))))) (defun org-element-subscript-interpreter (subscript contents) "Interpret SUBSCRIPT object as Org syntax. @@ -2066,7 +2066,7 @@ Return value is a cons cell whose car is either `subscript' or (save-excursion (when (re-search-forward org-match-substring-regexp limit t) (cons (if (string= (match-string 2) "_") 'subscript 'superscript) - (match-beginning 2))))) + (match-beginning 2))))) ;;;; Superscript (defun org-element-superscript-parser () @@ -2080,22 +2080,22 @@ Assume point is at the caret." (save-excursion (unless (bolp) (backward-char)) (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) - t - (not (looking-at org-match-substring-regexp)))) - (begin (match-beginning 2)) - (contents-begin (or (match-beginning 5) - (match-beginning 3))) - (contents-end (or (match-end 5) (match-end 3))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) + t + (not (looking-at org-match-substring-regexp)))) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 5) + (match-beginning 3))) + (contents-end (or (match-end 5) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) (list 'superscript - `(:begin ,begin - :end ,end - :use-brackets-p ,bracketsp - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,post-blank))))) + `(:begin ,begin + :end ,end + :use-brackets-p ,bracketsp + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,post-blank))))) (defun org-element-superscript-interpreter (superscript contents) "Interpret SUPERSCRIPT object as Org syntax. @@ -2116,19 +2116,19 @@ Assume point is at the target." (save-excursion (looking-at org-target-regexp) (let ((begin (point)) - (contents-begin (match-beginning 1)) - (contents-end (match-end 1)) - (raw-value (org-match-string-no-properties 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1)) + (raw-value (org-match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) (list 'target - `(:begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :raw-value ,raw-value - :post-blank ,post-blank))))) + `(:begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :raw-value ,raw-value + :post-blank ,post-blank))))) (defun org-element-target-interpreter (target contents) "Interpret TARGET object as Org syntax. @@ -2157,39 +2157,39 @@ Return a list whose car is `time-stamp', and cdr a plist with Assume point is at the beginning of the time-stamp." (save-excursion (let* ((appt-type (cond - ((looking-at (concat org-deadline-string " +")) - (goto-char (match-end 0)) - 'deadline) - ((looking-at (concat org-scheduled-string " +")) - (goto-char (match-end 0)) - 'scheduled) - ((looking-at (concat org-closed-string " +")) - (goto-char (match-end 0)) - 'closed))) - (begin (and appt-type (match-beginning 0))) - (type (cond - ((looking-at org-tsr-regexp) - (if (match-string 2) 'active-range 'active)) - ((looking-at org-tsr-regexp-both) - (if (match-string 2) 'inactive-range 'inactive)) - ((looking-at (concat - "\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" - "\\|" - "\\(<%%\\(([^>\n]+)\\)>\\)")) - 'diary))) - (begin (or begin (match-beginning 0))) - (value (buffer-substring-no-properties - (match-beginning 0) (match-end 0))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) + ((looking-at (concat org-deadline-string " +")) + (goto-char (match-end 0)) + 'deadline) + ((looking-at (concat org-scheduled-string " +")) + (goto-char (match-end 0)) + 'scheduled) + ((looking-at (concat org-closed-string " +")) + (goto-char (match-end 0)) + 'closed))) + (begin (and appt-type (match-beginning 0))) + (type (cond + ((looking-at org-tsr-regexp) + (if (match-string 2) 'active-range 'active)) + ((looking-at org-tsr-regexp-both) + (if (match-string 2) 'inactive-range 'inactive)) + ((looking-at (concat + "\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" + "\\|" + "\\(<%%\\(([^>\n]+)\\)>\\)")) + 'diary))) + (begin (or begin (match-beginning 0))) + (value (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) (list 'time-stamp - `(:appt-type ,appt-type - :type ,type - :value ,value - :begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(:appt-type ,appt-type + :type ,type + :value ,value + :begin ,begin + :end ,end + :post-blank ,post-blank))))) (defun org-element-time-stamp-interpreter (time-stamp contents) "Interpret TIME-STAMP object as Org syntax. @@ -2210,14 +2210,14 @@ Return value is a cons cell whose car is `time-stamp' and cdr is beginning position." (save-excursion (when (re-search-forward - (concat "\\(?:" org-scheduled-string " +\\|" - org-deadline-string " +\\|" org-closed-string " +\\)?" - org-ts-regexp-both - "\\|" - "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" - "\\|" - "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") - limit t) + (concat "\\(?:" org-scheduled-string " +\\|" + org-deadline-string " +\\|" org-closed-string " +\\)?" + org-ts-regexp-both + "\\|" + "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" + "\\|" + "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") + limit t) (cons 'time-stamp (match-beginning 0))))) ;;;; Verbatim @@ -2232,23 +2232,23 @@ Assume point is at the first verbatim marker." (unless (bolp) (backward-char 1)) (looking-at org-emph-re) (let ((begin (match-beginning 2)) - (marker (org-match-string-no-properties 3)) - (value (org-match-string-no-properties 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) + (marker (org-match-string-no-properties 3)) + (value (org-match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) (list 'verbatim - `(:marker ,marker - :begin ,begin - :end ,end - :value ,value - :post-blank ,post-blank))))) + `(:marker ,marker + :begin ,begin + :end ,end + :value ,value + :post-blank ,post-blank))))) (defun org-element-verbatim-interpreter (verbatim contents) "Interpret VERBATIM object as Org syntax. CONTENTS is nil." (let ((marker (org-element-get-property :marker verbatim)) - (value (org-element-get-property :value verbatim))) + (value (org-element-get-property :value verbatim))) (concat marker value marker))) @@ -2263,40 +2263,40 @@ CONTENTS is nil." ;; process. (defconst org-element-paragraph-separate (concat "\f" "\\|" "^[ \t]*$" "\\|" - ;; Headlines and inlinetasks. - org-outline-regexp-bol "\\|" - ;; Comments, blocks (any type), keywords and babel calls. - "^[ \t]*#\\+" "\\|" "^#\\( \\|$\\)" "\\|" - ;; Lists. - (org-item-beginning-re) "\\|" - ;; Fixed-width, drawers (any type) and tables. - "^[ \t]*[:|]" "\\|" - ;; Footnote definitions. - org-footnote-definition-re "\\|" - ;; Horizontal rules. - "^[ \t]*-\\{5,\\}[ \t]*$" "\\|" - ;; LaTeX environments. - "^[ \t]*\\\\\\(begin\\|end\\)") + ;; Headlines and inlinetasks. + org-outline-regexp-bol "\\|" + ;; Comments, blocks (any type), keywords and babel calls. + "^[ \t]*#\\+" "\\|" "^#\\( \\|$\\)" "\\|" + ;; Lists. + (org-item-beginning-re) "\\|" + ;; Fixed-width, drawers (any type) and tables. + "^[ \t]*[:|]" "\\|" + ;; Footnote definitions. + org-footnote-definition-re "\\|" + ;; Horizontal rules. + "^[ \t]*-\\{5,\\}[ \t]*$" "\\|" + ;; LaTeX environments. + "^[ \t]*\\\\\\(begin\\|end\\)") "Regexp to separate paragraphs in an Org buffer.") (defconst org-element-all-elements '(center-block comment comment-block drawer dynamic-block example-block - export-block fixed-width footnote-definition headline - horizontal-rule inlinetask item keyword latex-environment - babel-call paragraph plain-list property-drawer quote-block - quote-section special-block src-block table verse-block) + export-block fixed-width footnote-definition headline + horizontal-rule inlinetask item keyword latex-environment + babel-call paragraph plain-list property-drawer quote-block + quote-section special-block src-block table verse-block) "Complete list of elements.") (defconst org-element-greater-elements '(center-block drawer dynamic-block footnote-definition headline inlinetask - item plain-list quote-block special-block) + item plain-list quote-block special-block) "List of recursive element types aka Greater Elements.") (defconst org-element-all-successors '(export-snippet footnote-reference inline-babel-call inline-src-block - latex-or-entity line-break link macro radio-target - statistics-cookie sub/superscript target text-markup - time-stamp) + latex-or-entity line-break link macro radio-target + statistics-cookie sub/superscript target text-markup + time-stamp) "Complete list of successors.") (defconst org-element-object-successor-alist @@ -2371,14 +2371,14 @@ This list is checked after translations have been applied. See (defconst org-element-object-restrictions '((emphasis entity export-snippet inline-babel-call inline-src-block - radio-target sub/superscript target text-markup time-stamp) + radio-target sub/superscript target text-markup time-stamp) (link entity export-snippet inline-babel-call inline-src-block - latex-fragment sub/superscript text-markup) + latex-fragment sub/superscript text-markup) (radio-target entity export-snippet latex-fragment sub/superscript) (subscript entity export-snippet inline-babel-call inline-src-block - latex-fragment sub/superscript text-markup) + latex-fragment sub/superscript text-markup) (superscript entity export-snippet inline-babel-call inline-src-block - latex-fragment sub/superscript text-markup) + latex-fragment sub/superscript text-markup) (target entity export-snippet latex-fragment sub/superscript text-markup)) "Alist of recursive objects restrictions. @@ -2391,16 +2391,16 @@ superscript.") (defconst org-element-string-restrictions '((headline entity inline-babel-call latex-fragment link macro radio-target - statistics-cookie sub/superscript text-markup time-stamp) + statistics-cookie sub/superscript text-markup time-stamp) (inlinetask entity inline-babel-call latex-fragment link macro radio-target - sub/superscript text-markup time-stamp) + sub/superscript text-markup time-stamp) (item entity inline-babel-call latex-fragment macro radio-target - sub/superscript target verbatim) + sub/superscript target verbatim) (keyword entity latex-fragment macro sub/superscript text-markup) (table entity latex-fragment macro text-markup) (verse entity footnote-reference inline-babel-call inline-src-block - latex-fragment line-break link macro radio-target sub/superscript - target text-markup time-stamp)) + latex-fragment line-break link macro radio-target sub/superscript + target text-markup time-stamp)) "Alist of secondary strings restrictions. When parsed, some elements have a secondary string which could @@ -2441,13 +2441,13 @@ matching `org-element-parsed-keywords'.") ;; argument, one can make it switch to the `item' level. (defconst org-element--affiliated-re (format "[ \t]*#\\+\\(%s\\):" - (mapconcat - (lambda (keyword) - (if (member keyword org-element-dual-keywords) - (format "\\(%s\\)\\(?:\\[\\(.*?\\)\\]\\)?" - (regexp-quote keyword)) - (regexp-quote keyword))) - org-element-affiliated-keywords "\\|")) + (mapconcat + (lambda (keyword) + (if (member keyword org-element-dual-keywords) + (format "\\(%s\\)\\(?:\\[\\(.*?\\)\\]\\)?" + (regexp-quote keyword)) + (regexp-quote keyword))) + org-element-affiliated-keywords "\\|")) "Regexp matching any affiliated keyword. Keyword name is put in match group 1. Moreover, if keyword @@ -2482,60 +2482,60 @@ be computed." ;; try moving to the beginning of the associated element. If ;; the keyword is orphaned, treat it as plain text. (when (looking-at org-element--affiliated-re) - (let ((opoint (point))) - (while (looking-at org-element--affiliated-re) (forward-line)) - (when (looking-at "[ \t]*$") (goto-char opoint)))) + (let ((opoint (point))) + (while (looking-at org-element--affiliated-re) (forward-line)) + (when (looking-at "[ \t]*$") (goto-char opoint)))) (let ((type (org-element-guess-type))) - (cond - ;; Guessing element type on the current line is impossible: - ;; try to find the beginning of the current element to get - ;; more information. - ((not type) - (let ((search-origin (point)) - (opoint-in-item-p (org-in-item-p)) - (par-found-p - (progn - (end-of-line) - (re-search-backward org-element-paragraph-separate nil 'm)))) - (cond - ;; Unable to find a paragraph delimiter above: we're at - ;; bob and looking at a paragraph. - ((not par-found-p) (org-element-paragraph-parser)) - ;; Trying to find element's beginning set point back to - ;; its original position. There's something peculiar on - ;; this line that prevents parsing, probably an - ;; ill-formed keyword or an undefined drawer name. Parse - ;; it as plain text anyway. - ((< search-origin (point-at-eol)) (org-element-paragraph-parser)) - ;; Original point wasn't in a list but previous paragraph - ;; is. It means that either point was inside some block, - ;; or current list was ended without using a blank line. - ;; In the last case, paragraph really starts at list end. - ((let (item) - (and (not opoint-in-item-p) - (not (looking-at "[ \t]*#\\+begin")) - (setq item (org-in-item-p)) - (let ((struct (save-excursion (goto-char item) - (org-list-struct)))) - (goto-char (org-list-get-bottom-point struct)) - (org-skip-whitespace) - (beginning-of-line) - (org-element-paragraph-parser))))) - ((org-footnote-at-definition-p) - (org-element-footnote-definition-parser)) - ((and opoint-in-item-p (org-at-item-p) (= opoint-in-item-p (point))) - (if toggle-item - (org-element-item-parser (or structure (org-list-struct))) - (org-element-plain-list-parser (or structure (org-list-struct))))) - ;; In any other case, the paragraph started the line - ;; below. - (t (forward-line) (org-element-paragraph-parser))))) - ((eq type 'plain-list) - (if toggle-item - (org-element-item-parser (or structure (org-list-struct))) - (org-element-plain-list-parser (or structure (org-list-struct))))) - ;; Straightforward case: call the appropriate parser. - (t (funcall (intern (format "org-element-%s-parser" type))))))))) + (cond + ;; Guessing element type on the current line is impossible: + ;; try to find the beginning of the current element to get + ;; more information. + ((not type) + (let ((search-origin (point)) + (opoint-in-item-p (org-in-item-p)) + (par-found-p + (progn + (end-of-line) + (re-search-backward org-element-paragraph-separate nil 'm)))) + (cond + ;; Unable to find a paragraph delimiter above: we're at + ;; bob and looking at a paragraph. + ((not par-found-p) (org-element-paragraph-parser)) + ;; Trying to find element's beginning set point back to + ;; its original position. There's something peculiar on + ;; this line that prevents parsing, probably an + ;; ill-formed keyword or an undefined drawer name. Parse + ;; it as plain text anyway. + ((< search-origin (point-at-eol)) (org-element-paragraph-parser)) + ;; Original point wasn't in a list but previous paragraph + ;; is. It means that either point was inside some block, + ;; or current list was ended without using a blank line. + ;; In the last case, paragraph really starts at list end. + ((let (item) + (and (not opoint-in-item-p) + (not (looking-at "[ \t]*#\\+begin")) + (setq item (org-in-item-p)) + (let ((struct (save-excursion (goto-char item) + (org-list-struct)))) + (goto-char (org-list-get-bottom-point struct)) + (org-skip-whitespace) + (beginning-of-line) + (org-element-paragraph-parser))))) + ((org-footnote-at-definition-p) + (org-element-footnote-definition-parser)) + ((and opoint-in-item-p (org-at-item-p) (= opoint-in-item-p (point))) + (if toggle-item + (org-element-item-parser (or structure (org-list-struct))) + (org-element-plain-list-parser (or structure (org-list-struct))))) + ;; In any other case, the paragraph started the line + ;; below. + (t (forward-line) (org-element-paragraph-parser))))) + ((eq type 'plain-list) + (if toggle-item + (org-element-item-parser (or structure (org-list-struct))) + (org-element-plain-list-parser (or structure (org-list-struct))))) + ;; Straightforward case: call the appropriate parser. + (t (funcall (intern (format "org-element-%s-parser" type))))))))) ;; It is obvious to tell if point is in most elements, either by @@ -2558,14 +2558,14 @@ parsing. Used internally by `org-element-at-point'." (cond ((org-with-limited-levels (org-at-heading-p)) 'headline) ((let ((headline (ignore-errors (nth 4 (org-heading-components))))) - (and headline - (let (case-fold-search) - (string-match (format "^%s\\(?: \\|$\\)" org-quote-string) - headline)))) + (and headline + (let (case-fold-search) + (string-match (format "^%s\\(?: \\|$\\)" org-quote-string) + headline)))) 'quote-section) ;; Non-recursive block. ((let ((type (org-in-block-p org-element--element-block-types))) - (and type (cdr (assoc type org-element-non-recursive-block-alist))))) + (and type (cdr (assoc type org-element-non-recursive-block-alist))))) ((org-at-heading-p) 'inlinetask) ((org-between-regexps-p "^[ \t]*\\\\begin{" "^[ \t]*\\\\end{[^}]*}[ \t]*") 'latex-environment) @@ -2573,28 +2573,28 @@ parsing. Used internally by `org-element-at-point'." ;; boundaries. ((org-with-wide-buffer (and (not (org-before-first-heading-p)) - (let ((pblock (org-get-property-block))) - (and pblock - (<= (point) (cdr pblock)) - (>= (point-at-eol) (1- (car pblock))))))) + (let ((pblock (org-get-property-block))) + (and pblock + (<= (point) (cdr pblock)) + (>= (point-at-eol) (1- (car pblock))))))) 'property-drawer) ;; Recursive block. If the block isn't complete, parse the ;; current part as a paragraph. ((looking-at "[ \t]*#\\+\\(begin\\|end\\)_\\([-A-Za-z0-9]+\\)\\(?:$\\|\\s-\\)") (let ((type (downcase (match-string 2)))) - (cond - ((not (org-in-block-p (list type))) 'paragraph) - ((string= type "center") 'center-block) - ((string= type "quote") 'quote-block) - (t 'special-block)))) + (cond + ((not (org-in-block-p (list type))) 'paragraph) + ((string= type "center") 'center-block) + ((string= type "quote") 'quote-block) + (t 'special-block)))) ;; Regular drawers must be tested after property drawer as both ;; elements share the same ending regexp. ((or (looking-at org-drawer-regexp) (looking-at "[ \t]*:END:[ \t]*$")) (let ((completep (org-between-regexps-p - org-drawer-regexp "^[ \t]*:END:[ \t]*$"))) - (if (not completep) - 'paragraph - (goto-char (car completep)) 'drawer))) + org-drawer-regexp "^[ \t]*:END:[ \t]*$"))) + (if (not completep) + 'paragraph + (goto-char (car completep)) 'drawer))) ((looking-at "[ \t]*:\\( \\|$\\)") 'fixed-width) ;; Babel calls must be tested before general keywords as they are ;; a subset of them. @@ -2602,17 +2602,17 @@ parsing. Used internally by `org-element-at-point'." ((looking-at org-footnote-definition-re) 'footnote-definition) ((looking-at "[ \t]*#\\+\\([a-z]+\\(:?_[a-z]+\\)*\\):") (if (member (downcase (match-string 1)) org-element-affiliated-keywords) - 'paragraph - 'keyword)) + 'paragraph + 'keyword)) ;; Dynamic block: simplify regexp used for match. If it isn't ;; complete, parse the current part as a paragraph. ((looking-at "[ \t]*#\\+\\(begin\\end\\):\\(?:\\s-\\|$\\)") (let ((completep (org-between-regexps-p - "^[ \t]*#\\+begin:\\(?:\\s-\\|$\\)" - "^[ \t]*#\\+end:\\(?:\\s-\\|$\\)"))) - (if (not completep) - 'paragraph - (goto-char (car completep)) 'dynamic-block))) + "^[ \t]*#\\+begin:\\(?:\\s-\\|$\\)" + "^[ \t]*#\\+end:\\(?:\\s-\\|$\\)"))) + (if (not completep) + 'paragraph + (goto-char (car completep)) 'dynamic-block))) ((looking-at "\\(#\\|[ \t]*#\\+\\( \\|$\\)\\)") 'comment) ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") 'horizontal-rule) ((org-at-table-p t) 'table) @@ -2620,8 +2620,8 @@ parsing. Used internally by `org-element-at-point'." (forward-line -1) ;; A TBLFM line separated from any table is just plain text. (if (org-at-table-p) - 'table - (forward-line) 'paragraph)) + 'table + (forward-line) 'paragraph)) ((looking-at (org-item-re)) 'plain-list)))) ;; Most elements can have affiliated keywords. When looking for an @@ -2652,7 +2652,7 @@ parsing. Used internally by `org-element-at-point'." ;; A keyword may belong to more than one category. (defun org-element-collect-affiliated-keywords (&optional key-re trans-list - consed parsed duals) + consed parsed duals) "Collect affiliated keywords before point. Optional argument KEY-RE is a regexp matching keywords, which @@ -2683,39 +2683,39 @@ Return a list whose car is the position at the first of them and cdr a plist of keywords and values." (save-excursion (let ((case-fold-search t) - (key-re (or key-re org-element--affiliated-re)) - (trans-list (or trans-list org-element-keyword-translation-alist)) - (consed (or consed org-element-multiple-keywords)) - (parsed (or parsed org-element-parsed-keywords)) - (duals (or duals org-element-dual-keywords)) - output) + (key-re (or key-re org-element--affiliated-re)) + (trans-list (or trans-list org-element-keyword-translation-alist)) + (consed (or consed org-element-multiple-keywords)) + (parsed (or parsed org-element-parsed-keywords)) + (duals (or duals org-element-dual-keywords)) + output) (unless (bobp) - (while (and (not (bobp)) - (progn (forward-line -1) (looking-at key-re))) - (let* ((raw-kwd (downcase (or (match-string 2) (match-string 1)))) - ;; Apply translation to RAW-KWD. From there, KWD is - ;; the official keyword. - (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd)) - ;; If KWD is a dual keyword, find it secondary value. - (dual-value (and (member kwd duals) - (org-match-string-no-properties 3))) - ;; Find main value for any keyword. - (value (org-trim (buffer-substring-no-properties - (match-end 0) (point-at-eol)))) - ;; Attribute a property name to KWD. - (kwd-sym (and kwd (intern (concat ":" kwd))))) - ;; Now set final shape for VALUE. - (when (member kwd parsed) - (setq value - (org-element-parse-secondary-string - value - (cdr (assq 'keyword org-element-string-restrictions))))) - (when (member kwd duals) (setq value (cons value dual-value))) - (when (member kwd consed) - (setq value (cons value (plist-get output kwd-sym)))) - ;; Eventually store the new value in OUTPUT. - (setq output (plist-put output kwd-sym value)))) - (unless (looking-at key-re) (forward-line 1))) + (while (and (not (bobp)) + (progn (forward-line -1) (looking-at key-re))) + (let* ((raw-kwd (downcase (or (match-string 2) (match-string 1)))) + ;; Apply translation to RAW-KWD. From there, KWD is + ;; the official keyword. + (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd)) + ;; If KWD is a dual keyword, find it secondary value. + (dual-value (and (member kwd duals) + (org-match-string-no-properties 3))) + ;; Find main value for any keyword. + (value (org-trim (buffer-substring-no-properties + (match-end 0) (point-at-eol)))) + ;; Attribute a property name to KWD. + (kwd-sym (and kwd (intern (concat ":" kwd))))) + ;; Now set final shape for VALUE. + (when (member kwd parsed) + (setq value + (org-element-parse-secondary-string + value + (cdr (assq 'keyword org-element-string-restrictions))))) + (when (member kwd duals) (setq value (cons value dual-value))) + (when (member kwd consed) + (setq value (cons value (plist-get output kwd-sym)))) + ;; Eventually store the new value in OUTPUT. + (setq output (plist-put output kwd-sym value)))) + (unless (looking-at key-re) (forward-line 1))) (list (point) output)))) @@ -2744,7 +2744,7 @@ recursion. It can be set to the following symbols: `headline' Only parse headlines. `greater-element' Don't recurse into greater elements. Thus, - elements parsed are the top-level ones. + elements parsed are the top-level ones. `element' Parse everything but objects and plain text. `object' Parse the complete buffer (default). @@ -2756,9 +2756,9 @@ Assume buffer is in Org mode." (goto-char (point-min)) (org-skip-whitespace) (nconc (list 'org-data nil) - (org-element-parse-elements - (point-at-bol) (point-max) - nil nil granularity visible-only nil)))) + (org-element-parse-elements + (point-at-bol) (point-max) + nil nil granularity visible-only nil)))) (defun org-element-parse-secondary-string (string restriction &optional buffer) "Recursively parse objects in STRING and return structure. @@ -2799,101 +2799,101 @@ Nil values returned from FUN are ignored in the result." ;; Recursion depth is determined by TYPE-CATEGORY, to avoid ;; unnecessary steps. (let* ((type-category - (cond - ((loop for type in types - always (memq type org-element-greater-elements)) - 'greater-elements) - ((loop for type in types - always (memq type org-element-all-elements)) - 'elements) - (t 'objects))) - walk-tree ; For byte-compiler - acc ; Accumulate results into ACC. - (accumulate-maybe - (function - ;; Check if TYPE is matching among TYPES. If so, apply FUN - ;; to BLOB and accumulate return value into ACC. INFO is - ;; the communication channel. - (lambda (type types fun blob info) - (when (memq type types) - (let ((result (funcall fun blob info))) - (cond - ((not result)) - (first-match (throw 'first-match result)) - (t (push result acc)))))))) - (walk-tree - (function - ;; Recursively walk DATA. INFO, if non-nil, is a plist - ;; holding contextual information. - (lambda (data info) - (mapc - (lambda (blob) - (let ((type (if (stringp blob) 'plain-text (car blob)))) - ;; Determine if a recursion into BLOB is possible - ;; and allowed. - (cond - ;; Element or object not exportable. - ((and info (org-export-skip-p blob info))) - ;; Archived headline: skip it. - ((and info - (eq type 'headline) - (and (eq (plist-get info :with-archived-trees) - 'headline) - (org-element-get-property :archivedp blob))) + (cond + ((loop for type in types + always (memq type org-element-greater-elements)) + 'greater-elements) + ((loop for type in types + always (memq type org-element-all-elements)) + 'elements) + (t 'objects))) + walk-tree ; For byte-compiler + acc ; Accumulate results into ACC. + (accumulate-maybe + (function + ;; Check if TYPE is matching among TYPES. If so, apply FUN + ;; to BLOB and accumulate return value into ACC. INFO is + ;; the communication channel. + (lambda (type types fun blob info) + (when (memq type types) + (let ((result (funcall fun blob info))) + (cond + ((not result)) + (first-match (throw 'first-match result)) + (t (push result acc)))))))) + (walk-tree + (function + ;; Recursively walk DATA. INFO, if non-nil, is a plist + ;; holding contextual information. + (lambda (data info) + (mapc + (lambda (blob) + (let ((type (if (stringp blob) 'plain-text (car blob)))) + ;; Determine if a recursion into BLOB is possible + ;; and allowed. + (cond + ;; Element or object not exportable. + ((and info (org-export-skip-p blob info))) + ;; Archived headline: skip it. + ((and info + (eq type 'headline) + (and (eq (plist-get info :with-archived-trees) + 'headline) + (org-element-get-property :archivedp blob))) (funcall accumulate-maybe type types fun blob info)) - ;; At an include keyword: apply mapping to its - ;; contents. - ((and info - (eq type 'keyword) - (string= - (downcase (org-element-get-property :key blob)) - "include")) + ;; At an include keyword: apply mapping to its + ;; contents. + ((and info + (eq type 'keyword) + (string= + (downcase (org-element-get-property :key blob)) + "include")) (funcall accumulate-maybe type types fun blob info) - (let* ((data (org-export-parse-included-file blob info)) - (value (org-element-get-property :value blob)) - (file (and (string-match "^\"\\(\\S-+\\)\"" value) - (match-string 1 value)))) - (funcall - walk-tree - data - (org-combine-plists - info - ;; Store full path of already included files - ;; to avoid recursive file inclusion. - `(:included-files - ,(cons (expand-file-name file) - (plist-get info :included-files)) - ;; Ensure that a top-level headline in the - ;; included file becomes a direct child of - ;; the current headline in the buffer. - :headline-offset - ,(- (+ (plist-get - (plist-get info :inherited-properties) :level) - (or (plist-get info :headline-offset) 0)) - (1- (org-export-get-min-level data info)))))))) - ;; Limiting recursion to greater elements, and BLOB - ;; isn't one. - ((and (eq type-category 'greater-elements) - (not (memq type org-element-greater-elements))) - (funcall accumulate-maybe type types fun blob info)) - ;; Limiting recursion to elements, and BLOB only - ;; contains objects. - ((and (eq type-category 'elements) (eq type 'paragraph))) - ;; No limitation on recursion, but BLOB hasn't got - ;; a recursive type. - ((and (eq type-category 'objects) - (not (or (eq type 'paragraph) - (memq type org-element-greater-elements) - (memq type org-element-recursive-objects)))) - (funcall accumulate-maybe type types fun blob info)) - ;; Recursion is possible and allowed: Update local - ;; informations and move into BLOB. - (t (funcall accumulate-maybe type types fun blob info) + (let* ((data (org-export-parse-included-file blob info)) + (value (org-element-get-property :value blob)) + (file (and (string-match "^\"\\(\\S-+\\)\"" value) + (match-string 1 value)))) (funcall - walk-tree - blob - (and options (org-export-update-info blob info t))))))) - (org-element-get-contents data)))))) + walk-tree + data + (org-combine-plists + info + ;; Store full path of already included files + ;; to avoid recursive file inclusion. + `(:included-files + ,(cons (expand-file-name file) + (plist-get info :included-files)) + ;; Ensure that a top-level headline in the + ;; included file becomes a direct child of + ;; the current headline in the buffer. + :headline-offset + ,(- (+ (plist-get + (plist-get info :inherited-properties) :level) + (or (plist-get info :headline-offset) 0)) + (1- (org-export-get-min-level data info)))))))) + ;; Limiting recursion to greater elements, and BLOB + ;; isn't one. + ((and (eq type-category 'greater-elements) + (not (memq type org-element-greater-elements))) + (funcall accumulate-maybe type types fun blob info)) + ;; Limiting recursion to elements, and BLOB only + ;; contains objects. + ((and (eq type-category 'elements) (eq type 'paragraph))) + ;; No limitation on recursion, but BLOB hasn't got + ;; a recursive type. + ((and (eq type-category 'objects) + (not (or (eq type 'paragraph) + (memq type org-element-greater-elements) + (memq type org-element-recursive-objects)))) + (funcall accumulate-maybe type types fun blob info)) + ;; Recursion is possible and allowed: Update local + ;; informations and move into BLOB. + (t (funcall accumulate-maybe type types fun blob info) + (funcall + walk-tree + blob + (and options (org-export-update-info blob info t))))))) + (org-element-get-contents data)))))) (catch 'first-match (funcall walk-tree data options) ;; Return value in a proper order. @@ -2923,7 +2923,7 @@ to the following symbols: `headline' Only parse headlines. `greater-element' Don't recurse into greater elements. Thus, - elements parsed are the top-level ones. + elements parsed are the top-level ones. `element' Parse everything but objects and plain text. `object' or nil Parse the complete buffer. @@ -2942,69 +2942,69 @@ Elements are accumulated into ACC." ;; 1. If ITEM is toggled, point is at an item. Knowing that, ;; there's no need to go through `org-element-at-point'. (if item - (let* ((element (org-element-item-parser structure)) - (cbeg (org-element-get-property :contents-begin element)) - (cend (org-element-get-property :contents-end element))) - (goto-char (org-element-get-property :end element)) - ;; Narrow region to contents, so that item bullet don't - ;; interfere with paragraph parsing. - (save-restriction - (narrow-to-region cbeg cend) - (org-element-parse-elements - cbeg cend nil structure granularity visible-only - (reverse element)))) - ;; 2. When ITEM is nil, find current element's type and parse - ;; it accordingly to its category. - (let ((element (org-element-at-point nil structure))) - (goto-char (org-element-get-property :end element)) - (cond - ;; Case 1: ELEMENT is a footnote-definition. If - ;; GRANURALITY allows parsing, use narrowing so that - ;; footnote label don't interfere with paragraph - ;; recognition. - ((and (eq (car element) 'footnote-definition) - (not (memq granularity '(headline greater-element)))) - (let ((cbeg (org-element-get-property :contents-begin element)) - (cend (org-element-get-property :contents-end element))) - (save-restriction - (narrow-to-region cbeg cend) - (org-element-parse-elements - cbeg cend nil structure granularity visible-only - (reverse element))))) - ;; Case 1: ELEMENT is a paragraph. Parse objects inside, - ;; if GRANULARITY allows it. - ((and (eq (car element) 'paragraph) - (or (not granularity) (eq granularity 'object))) - (org-element-parse-objects - (org-element-get-property :contents-begin element) - (org-element-get-property :contents-end element) - (reverse element) - nil)) - ;; Case 2: ELEMENT is recursive: parse it between - ;; `contents-begin' and `contents-end'. If it's - ;; a plain list, also switch to item mode. Make - ;; sure GRANULARITY allows the recursion, or - ;; ELEMENT is an headline, in which case going - ;; inside is mandatory, in order to get sub-level - ;; headings. If VISIBLE-ONLY is true and element - ;; is hidden, do not recurse into it. - ((and (memq (car element) org-element-greater-elements) - (or (not granularity) - (memq granularity '(element object)) - (eq (car element) 'headline)) - (not (and visible-only - (org-element-get-property :hiddenp element)))) - (org-element-parse-elements - (org-element-get-property :contents-begin element) - (org-element-get-property :contents-end element) - (eq (car element) 'plain-list) - (org-element-get-property :structure element) - granularity - visible-only - (reverse element))) - ;; Case 3: Else, just accumulate ELEMENT, unless - ;; GRANULARITY is set to `headline'. - ((not (eq granularity 'headline)) element)))) + (let* ((element (org-element-item-parser structure)) + (cbeg (org-element-get-property :contents-begin element)) + (cend (org-element-get-property :contents-end element))) + (goto-char (org-element-get-property :end element)) + ;; Narrow region to contents, so that item bullet don't + ;; interfere with paragraph parsing. + (save-restriction + (narrow-to-region cbeg cend) + (org-element-parse-elements + cbeg cend nil structure granularity visible-only + (reverse element)))) + ;; 2. When ITEM is nil, find current element's type and parse + ;; it accordingly to its category. + (let ((element (org-element-at-point nil structure))) + (goto-char (org-element-get-property :end element)) + (cond + ;; Case 1: ELEMENT is a footnote-definition. If + ;; GRANURALITY allows parsing, use narrowing so that + ;; footnote label don't interfere with paragraph + ;; recognition. + ((and (eq (car element) 'footnote-definition) + (not (memq granularity '(headline greater-element)))) + (let ((cbeg (org-element-get-property :contents-begin element)) + (cend (org-element-get-property :contents-end element))) + (save-restriction + (narrow-to-region cbeg cend) + (org-element-parse-elements + cbeg cend nil structure granularity visible-only + (reverse element))))) + ;; Case 1: ELEMENT is a paragraph. Parse objects inside, + ;; if GRANULARITY allows it. + ((and (eq (car element) 'paragraph) + (or (not granularity) (eq granularity 'object))) + (org-element-parse-objects + (org-element-get-property :contents-begin element) + (org-element-get-property :contents-end element) + (reverse element) + nil)) + ;; Case 2: ELEMENT is recursive: parse it between + ;; `contents-begin' and `contents-end'. If it's + ;; a plain list, also switch to item mode. Make + ;; sure GRANULARITY allows the recursion, or + ;; ELEMENT is an headline, in which case going + ;; inside is mandatory, in order to get sub-level + ;; headings. If VISIBLE-ONLY is true and element + ;; is hidden, do not recurse into it. + ((and (memq (car element) org-element-greater-elements) + (or (not granularity) + (memq granularity '(element object)) + (eq (car element) 'headline)) + (not (and visible-only + (org-element-get-property :hiddenp element)))) + (org-element-parse-elements + (org-element-get-property :contents-begin element) + (org-element-get-property :contents-end element) + (eq (car element) 'plain-list) + (org-element-get-property :structure element) + granularity + visible-only + (reverse element))) + ;; Case 3: Else, just accumulate ELEMENT, unless + ;; GRANULARITY is set to `headline'. + ((not (eq granularity 'headline)) element)))) acc) (org-skip-whitespace)) ;; Return result. @@ -3018,59 +3018,59 @@ Objects are accumulated in ACC. RESTRICTION, when non-nil, is a list of object types which are allowed in the current object." (let ((get-next-object - (function - (lambda (cand) - ;; Return the parsing function associated to the nearest - ;; object among list of candidates CAND. - (let ((pos (apply #'min (mapcar #'cdr cand)))) - (save-excursion - (goto-char pos) - (funcall - (intern - (format "org-element-%s-parser" (car (rassq pos cand)))))))))) - next-object candidates) + (function + (lambda (cand) + ;; Return the parsing function associated to the nearest + ;; object among list of candidates CAND. + (let ((pos (apply #'min (mapcar #'cdr cand)))) + (save-excursion + (goto-char pos) + (funcall + (intern + (format "org-element-%s-parser" (car (rassq pos cand)))))))))) + next-object candidates) (save-excursion (goto-char beg) (while (setq candidates (org-element-get-next-object-candidates - end restriction candidates)) - (setq next-object (funcall get-next-object candidates)) - ;; 1. Text before any object. - (let ((obj-beg (org-element-get-property :begin next-object))) - (unless (= beg obj-beg) - (push (buffer-substring-no-properties (point) obj-beg) acc))) - ;; 2. Object... - (let ((obj-end (org-element-get-property :end next-object)) - (cont-beg (org-element-get-property :contents-begin next-object))) - (push (if (and (memq (car next-object) org-element-recursive-objects) - cont-beg) - ;; ... recursive. The CONT-BEG check is for - ;; links, as some of them might not be recursive - ;; (i.e. plain links). - (save-restriction - (narrow-to-region - cont-beg - (org-element-get-property :contents-end next-object)) - (org-element-parse-objects - (point-min) (point-max) (reverse next-object) - ;; Restrict allowed objects. This is the - ;; intersection of current restriction and next - ;; object's restriction. - (let ((new-restr - (cdr (assq (car next-object) - org-element-object-restrictions)))) - (if (not restriction) - new-restr - (delq nil - (mapcar (lambda (e) - (and (memq e restriction) e)) - new-restr)))))) - ;; ... not recursive. - next-object) - acc) - (goto-char obj-end))) + end restriction candidates)) + (setq next-object (funcall get-next-object candidates)) + ;; 1. Text before any object. + (let ((obj-beg (org-element-get-property :begin next-object))) + (unless (= beg obj-beg) + (push (buffer-substring-no-properties (point) obj-beg) acc))) + ;; 2. Object... + (let ((obj-end (org-element-get-property :end next-object)) + (cont-beg (org-element-get-property :contents-begin next-object))) + (push (if (and (memq (car next-object) org-element-recursive-objects) + cont-beg) + ;; ... recursive. The CONT-BEG check is for + ;; links, as some of them might not be recursive + ;; (i.e. plain links). + (save-restriction + (narrow-to-region + cont-beg + (org-element-get-property :contents-end next-object)) + (org-element-parse-objects + (point-min) (point-max) (reverse next-object) + ;; Restrict allowed objects. This is the + ;; intersection of current restriction and next + ;; object's restriction. + (let ((new-restr + (cdr (assq (car next-object) + org-element-object-restrictions)))) + (if (not restriction) + new-restr + (delq nil + (mapcar (lambda (e) + (and (memq e restriction) e)) + new-restr)))))) + ;; ... not recursive. + next-object) + acc) + (goto-char obj-end))) ;; 3. Text after last object. (unless (= (point) end) - (push (buffer-substring-no-properties (point) end) acc)) + (push (buffer-substring-no-properties (point) end) acc)) ;; Result. (nreverse acc)))) @@ -3087,28 +3087,28 @@ type otherwise. OBJECTS is the previous candidates alist." (let ((restriction (or restriction org-element-all-successors)) - next-candidates types-to-search) + next-candidates types-to-search) ;; If no previous result, search every object type in RESTRICTION. ;; Otherwise, keep potential candidates (old objects located after ;; point) and ask to search again those which had matched before. (if objects - (mapc (lambda (obj) - (if (< (cdr obj) (point)) - (push (car obj) types-to-search) - (push obj next-candidates))) - objects) + (mapc (lambda (obj) + (if (< (cdr obj) (point)) + (push (car obj) types-to-search) + (push obj next-candidates))) + objects) (setq types-to-search restriction)) ;; Call the appropriate "get-next" function for each type to ;; search and accumulate matches. (mapc (lambda (type) (let* ((successor-fun - (intern - (format "org-element-%s-successor" - (or (cdr (assq type org-element-object-successor-alist)) - type)))) - (obj (funcall successor-fun limit))) - (and obj (push obj next-candidates)))) + (intern + (format "org-element-%s-successor" + (or (cdr (assq type org-element-object-successor-alist)) + type)))) + (obj (funcall successor-fun limit))) + (and obj (push obj next-candidates)))) types-to-search) ;; Return alist. next-candidates)) @@ -3149,51 +3149,51 @@ Return Org syntax as a string." ((stringp blob) blob) (t (let* ((type (car blob)) - (interpreter - (if (eq type 'org-data) - 'identity - (intern (format "org-element-%s-interpreter" type)))) - (contents - (cond - ;; Full Org document. - ((eq type 'org-data) - (org-element-interpret-data blob genealogy previous)) - ;; Recursive objects. - ((memq type org-element-recursive-objects) - (org-element-interpret-data - blob (cons type genealogy) nil)) - ;; Recursive elements. - ((memq type org-element-greater-elements) - (org-element-normalize-string - (org-element-interpret-data - blob (cons type genealogy) nil))) - ;; Paragraphs. - ((eq type 'paragraph) - (let ((paragraph - (org-element-normalize-contents - blob - ;; When normalizing contents of an item, - ;; ignore first line's indentation. - (and (not previous) - (memq (car genealogy) - '(footnote-definiton item)))))) - (org-element-interpret-data - paragraph (cons type genealogy) nil))))) - (results (funcall interpreter blob contents))) - ;; Update PREVIOUS. - (setq previous type) - ;; Build white spaces. - (cond - ((eq type 'org-data) results) - ((memq type org-element-all-elements) - (concat - (org-element-interpret--affiliated-keywords blob) - (org-element-normalize-string results) - (make-string (org-element-get-property :post-blank blob) 10))) - (t (concat - results - (make-string - (org-element-get-property :post-blank blob) 32)))))))) + (interpreter + (if (eq type 'org-data) + 'identity + (intern (format "org-element-%s-interpreter" type)))) + (contents + (cond + ;; Full Org document. + ((eq type 'org-data) + (org-element-interpret-data blob genealogy previous)) + ;; Recursive objects. + ((memq type org-element-recursive-objects) + (org-element-interpret-data + blob (cons type genealogy) nil)) + ;; Recursive elements. + ((memq type org-element-greater-elements) + (org-element-normalize-string + (org-element-interpret-data + blob (cons type genealogy) nil))) + ;; Paragraphs. + ((eq type 'paragraph) + (let ((paragraph + (org-element-normalize-contents + blob + ;; When normalizing contents of an item, + ;; ignore first line's indentation. + (and (not previous) + (memq (car genealogy) + '(footnote-definiton item)))))) + (org-element-interpret-data + paragraph (cons type genealogy) nil))))) + (results (funcall interpreter blob contents))) + ;; Update PREVIOUS. + (setq previous type) + ;; Build white spaces. + (cond + ((eq type 'org-data) results) + ((memq type org-element-all-elements) + (concat + (org-element-interpret--affiliated-keywords blob) + (org-element-normalize-string results) + (make-string (org-element-get-property :post-blank blob) 10))) + (t (concat + results + (make-string + (org-element-get-property :post-blank blob) 32)))))))) (org-element-get-contents data) "")) (defun org-element-interpret-secondary (secondary) @@ -3213,31 +3213,31 @@ Return interpreted string." "Return ELEMENT's affiliated keywords as Org syntax. If there is no affiliated keyword, return the empty string." (let ((keyword-to-org - (function - (lambda (key value) - (let (dual) - (when (member key org-element-dual-keywords) - (setq dual (cdr value) value (car value))) - (concat "#+" key (and dual (format "[%s]" dual)) ": " - (if (member key org-element-parsed-keywords) - (org-element-interpret-secondary value) - value) - "\n")))))) + (function + (lambda (key value) + (let (dual) + (when (member key org-element-dual-keywords) + (setq dual (cdr value) value (car value))) + (concat "#+" key (and dual (format "[%s]" dual)) ": " + (if (member key org-element-parsed-keywords) + (org-element-interpret-secondary value) + value) + "\n")))))) (mapconcat (lambda (key) (let ((value (org-element-get-property (intern (concat ":" key)) element))) - (when value - (if (member key org-element-multiple-keywords) - (mapconcat (lambda (line) - (funcall keyword-to-org key line)) - value "") - (funcall keyword-to-org key value))))) + (when value + (if (member key org-element-multiple-keywords) + (mapconcat (lambda (line) + (funcall keyword-to-org key line)) + value "") + (funcall keyword-to-org key value))))) ;; Remove translated keywords. (delq nil - (mapcar - (lambda (key) - (and (not (assoc key org-element-keyword-translation-alist)) key)) - org-element-affiliated-keywords)) + (mapcar + (lambda (key) + (and (not (assoc key org-element-keyword-translation-alist)) key)) + org-element-affiliated-keywords)) ""))) ;; Because interpretation of the parse tree must return the same @@ -3261,7 +3261,7 @@ newline character at its end." ((not (stringp s)) s) ((string= "" s) "") (t (and (string-match "\\(\n[ \t]*\\)*\\'" s) - (replace-match "\n" nil nil s))))) + (replace-match "\n" nil nil s))))) (defun org-element-normalize-contents (element &optional ignore-first) "Normalize plain text in ELEMENT's contents. @@ -3283,41 +3283,41 @@ Return the normalized element." ((and (not ignore-first) (not (stringp (car contents)))) contents) (t (catch 'exit - ;; 1. Remove tabs from each string in CONTENTS. Get maximal - ;; common indentation (MCI) along the way. - (let* ((ind-list (unless ignore-first - (list (org-get-string-indentation (car contents))))) - (contents - (mapcar (lambda (object) - (if (not (stringp object)) - object - (let ((start 0) - (object (org-remove-tabs object))) - (while (string-match "\n\\( *\\)" object start) - (setq start (match-end 0)) - (push (length (match-string 1 object)) - ind-list)) - object))) - contents)) - (mci (if ind-list - (apply 'min ind-list) - (throw 'exit contents)))) - ;; 2. Remove that indentation from CONTENTS. First string - ;; must be treated differently because it's the only one - ;; whose indentation doesn't happen after a newline - ;; character. - (let ((first-obj (car contents))) - (unless (or (not (stringp first-obj)) ignore-first) - (setq contents - (cons (replace-regexp-in-string - (format "\\` \\{%d\\}" mci) "" first-obj) - (cdr contents))))) - (mapcar (lambda (object) - (if (not (stringp object)) - object - (replace-regexp-in-string - (format "\n \\{%d\\}" mci) "\n" object))) - contents)))))))) + ;; 1. Remove tabs from each string in CONTENTS. Get maximal + ;; common indentation (MCI) along the way. + (let* ((ind-list (unless ignore-first + (list (org-get-string-indentation (car contents))))) + (contents + (mapcar (lambda (object) + (if (not (stringp object)) + object + (let ((start 0) + (object (org-remove-tabs object))) + (while (string-match "\n\\( *\\)" object start) + (setq start (match-end 0)) + (push (length (match-string 1 object)) + ind-list)) + object))) + contents)) + (mci (if ind-list + (apply 'min ind-list) + (throw 'exit contents)))) + ;; 2. Remove that indentation from CONTENTS. First string + ;; must be treated differently because it's the only one + ;; whose indentation doesn't happen after a newline + ;; character. + (let ((first-obj (car contents))) + (unless (or (not (stringp first-obj)) ignore-first) + (setq contents + (cons (replace-regexp-in-string + (format "\\` \\{%d\\}" mci) "" first-obj) + (cdr contents))))) + (mapcar (lambda (object) + (if (not (stringp object)) + object + (replace-regexp-in-string + (format "\n \\{%d\\}" mci) "\n" object))) + contents)))))))) @@ -3343,11 +3343,11 @@ Return the normalized element." (defsubst org-element-nested-p (elem-A elem-B) "Non-nil when elements ELEM-A and ELEM-B are nested." (let ((beg-A (org-element-get-property :begin elem-A)) - (beg-B (org-element-get-property :begin elem-B)) - (end-A (org-element-get-property :end elem-A)) - (end-B (org-element-get-property :end elem-B))) + (beg-B (org-element-get-property :begin elem-B)) + (end-A (org-element-get-property :end elem-A)) + (end-B (org-element-get-property :end elem-B))) (or (and (>= beg-A beg-B) (<= end-A end-B)) - (and (>= beg-B beg-A) (<= end-B end-A))))) + (and (>= beg-B beg-A) (<= end-B end-A))))) (defun org-element-swap-A-B (elem-A elem-B) "Swap elements ELEM-A and ELEM-B. @@ -3357,20 +3357,20 @@ Leave point at the end of ELEM-A. Assume ELEM-A is before ELEM-B and that they are not nested." (goto-char (org-element-get-property :begin elem-A)) (let* ((beg-B (org-element-get-property :begin elem-B)) - (end-B-no-blank (save-excursion - (goto-char (org-element-get-property :end elem-B)) - (skip-chars-backward " \r\t\n") - (forward-line) - (point))) - (beg-A (org-element-get-property :begin elem-A)) - (end-A-no-blank (save-excursion - (goto-char (org-element-get-property :end elem-A)) - (skip-chars-backward " \r\t\n") - (forward-line) - (point))) - (body-A (buffer-substring beg-A end-A-no-blank)) - (body-B (buffer-substring beg-B end-B-no-blank)) - (between-A-B (buffer-substring end-A-no-blank beg-B))) + (end-B-no-blank (save-excursion + (goto-char (org-element-get-property :end elem-B)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + (beg-A (org-element-get-property :begin elem-A)) + (end-A-no-blank (save-excursion + (goto-char (org-element-get-property :end elem-A)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + (body-A (buffer-substring beg-A end-A-no-blank)) + (body-B (buffer-substring beg-B end-B-no-blank)) + (between-A-B (buffer-substring end-A-no-blank beg-B))) (delete-region beg-A end-B-no-blank) (insert body-B between-A-B body-A) (goto-char (org-element-get-property :end elem-B)))) @@ -3379,8 +3379,8 @@ Assume ELEM-A is before ELEM-B and that they are not nested." "Move backward by one element." (interactive) (let* ((opoint (point)) - (element (org-element-at-point)) - (start-el-beg (org-element-get-property :begin element))) + (element (org-element-at-point)) + (start-el-beg (org-element-get-property :begin element))) ;; At an headline. The previous element is the previous sibling, ;; or the parent if any. (cond @@ -3390,123 +3390,123 @@ Assume ELEM-A is before ELEM-B and that they are not nested." (forward-line -1) (skip-chars-backward " \r\t\n") (let* ((prev-element (org-element-at-point)) - (itemp (org-in-item-p)) - (struct (and itemp - (save-excursion (goto-char itemp) - (org-list-struct))))) - ;; When moving into a new list, go directly at the - ;; beginning of the top list structure. - (if (and itemp (<= (org-list-get-bottom-point struct) opoint)) - (progn - (goto-char (org-list-get-top-point struct)) - (goto-char (org-element-get-property - :begin (org-element-at-point)))) - (goto-char (org-element-get-property :begin prev-element)))) + (itemp (org-in-item-p)) + (struct (and itemp + (save-excursion (goto-char itemp) + (org-list-struct))))) + ;; When moving into a new list, go directly at the + ;; beginning of the top list structure. + (if (and itemp (<= (org-list-get-bottom-point struct) opoint)) + (progn + (goto-char (org-list-get-top-point struct)) + (goto-char (org-element-get-property + :begin (org-element-at-point)))) + (goto-char (org-element-get-property :begin prev-element)))) (while (org-truely-invisible-p) (org-element-up))) ;; Else, move at the element beginning. One exception: if point ;; was in the blank lines after the end of a list, move directly ;; to the top item. (t (let (struct itemp) - (if (and (setq itemp (org-in-item-p)) - (<= (org-list-get-bottom-point - (save-excursion (goto-char itemp) - (setq struct (org-list-struct)))) - opoint)) - (progn (goto-char (org-list-get-top-point struct)) - (goto-char (org-element-get-property - :begin (org-element-at-point)))) - (goto-char start-el-beg))))))) + (if (and (setq itemp (org-in-item-p)) + (<= (org-list-get-bottom-point + (save-excursion (goto-char itemp) + (setq struct (org-list-struct)))) + opoint)) + (progn (goto-char (org-list-get-top-point struct)) + (goto-char (org-element-get-property + :begin (org-element-at-point)))) + (goto-char start-el-beg))))))) (defun org-element-drag-backward () "Drag backward element at point." (interactive) (let* ((pos (point)) - (elem (org-element-at-point))) + (elem (org-element-at-point))) (when (= (progn (goto-char (point-min)) - (org-skip-whitespace) - (point-at-bol)) - (org-element-get-property :end elem)) + (org-skip-whitespace) + (point-at-bol)) + (org-element-get-property :end elem)) (error "Cannot drag element backward")) (goto-char (org-element-get-property :begin elem)) (org-element-backward) (let ((prev-elem (org-element-at-point))) (when (or (org-element-nested-p elem prev-elem) - (and (eq (car elem) 'headline) - (not (eq (car prev-elem) 'headline)))) - (goto-char pos) - (error "Cannot drag element backward")) + (and (eq (car elem) 'headline) + (not (eq (car prev-elem) 'headline)))) + (goto-char pos) + (error "Cannot drag element backward")) ;; Compute new position of point: it's shifted by PREV-ELEM ;; body's length. (let ((size-prev (- (org-element-get-property :end prev-elem) - (org-element-get-property :begin prev-elem)))) - (org-element-swap-A-B prev-elem elem) - (goto-char (- pos size-prev)))))) + (org-element-get-property :begin prev-elem)))) + (org-element-swap-A-B prev-elem elem) + (goto-char (- pos size-prev)))))) (defun org-element-drag-forward () "Move forward element at point." (interactive) (let* ((pos (point)) - (elem (org-element-at-point))) + (elem (org-element-at-point))) (when (= (point-max) (org-element-get-property :end elem)) (error "Cannot drag element forward")) (goto-char (org-element-get-property :end elem)) (let ((next-elem (org-element-at-point))) (when (or (org-element-nested-p elem next-elem) - (and (eq (car next-elem) 'headline) - (not (eq (car elem) 'headline)))) - (goto-char pos) - (error "Cannot drag element forward")) + (and (eq (car next-elem) 'headline) + (not (eq (car elem) 'headline)))) + (goto-char pos) + (error "Cannot drag element forward")) ;; Compute new position of point: it's shifted by NEXT-ELEM ;; body's length (without final blanks) and by the length of ;; blanks between ELEM and NEXT-ELEM. (let ((size-next (- (save-excursion - (goto-char (org-element-get-property :end next-elem)) - (skip-chars-backward " \r\t\n") - (forward-line) - (point)) - (org-element-get-property :begin next-elem))) - (size-blank (- (org-element-get-property :end elem) - (save-excursion - (goto-char (org-element-get-property :end elem)) - (skip-chars-backward " \r\t\n") - (forward-line) - (point))))) - (org-element-swap-A-B elem next-elem) - (goto-char (+ pos size-next size-blank)))))) + (goto-char (org-element-get-property :end next-elem)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point)) + (org-element-get-property :begin next-elem))) + (size-blank (- (org-element-get-property :end elem) + (save-excursion + (goto-char (org-element-get-property :end elem)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))))) + (org-element-swap-A-B elem next-elem) + (goto-char (+ pos size-next size-blank)))))) (defun org-element-forward () "Move forward by one element." (interactive) (beginning-of-line) (cond ((eobp) (error "Cannot move further down")) - ((looking-at "[ \t]*$") - (org-skip-whitespace) - (goto-char (if (eobp) (point) (point-at-bol)))) - (t - (let ((element (org-element-at-point t)) - (origin (point))) - (cond - ;; At an item: Either move to the next element inside, or - ;; to its end if it's hidden. - ((eq (car element) 'item) - (if (org-element-get-property :hiddenp element) - (goto-char (org-element-get-property :end element)) - (end-of-line) - (re-search-forward org-element-paragraph-separate nil t) - (org-skip-whitespace) - (beginning-of-line))) - ;; At a recursive element: Either move inside, or if it's - ;; hidden, move to its end. - ((memq (car element) org-element-greater-elements) - (let ((cbeg (org-element-get-property :contents-begin element))) - (goto-char - (if (or (org-element-get-property :hiddenp element) - (> origin cbeg)) - (org-element-get-property :end element) - cbeg)))) - ;; Else: move to the current element's end. - (t (goto-char (org-element-get-property :end element)))))))) + ((looking-at "[ \t]*$") + (org-skip-whitespace) + (goto-char (if (eobp) (point) (point-at-bol)))) + (t + (let ((element (org-element-at-point t)) + (origin (point))) + (cond + ;; At an item: Either move to the next element inside, or + ;; to its end if it's hidden. + ((eq (car element) 'item) + (if (org-element-get-property :hiddenp element) + (goto-char (org-element-get-property :end element)) + (end-of-line) + (re-search-forward org-element-paragraph-separate nil t) + (org-skip-whitespace) + (beginning-of-line))) + ;; At a recursive element: Either move inside, or if it's + ;; hidden, move to its end. + ((memq (car element) org-element-greater-elements) + (let ((cbeg (org-element-get-property :contents-begin element))) + (goto-char + (if (or (org-element-get-property :hiddenp element) + (> origin cbeg)) + (org-element-get-property :end element) + cbeg)))) + ;; Else: move to the current element's end. + (t (goto-char (org-element-get-property :end element)))))))) (defun org-element-mark-element () "Put point at beginning of this element, mark at end. @@ -3517,15 +3517,15 @@ ones already marked." (interactive) (let (deactivate-mark) (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (goto-char (org-element-get-property :end (org-element-at-point))))) + (and transient-mark-mode mark-active)) + (set-mark + (save-excursion + (goto-char (mark)) + (goto-char (org-element-get-property :end (org-element-at-point))))) (let ((element (org-element-at-point))) - (end-of-line) - (push-mark (org-element-get-property :end element) t t) - (goto-char (org-element-get-property :begin element)))))) + (end-of-line) + (push-mark (org-element-get-property :end element) t t) + (goto-char (org-element-get-property :begin element)))))) (defun org-narrow-to-element () "Narrow buffer to current element." @@ -3551,18 +3551,18 @@ Point is moved after both elements." (interactive) (org-skip-whitespace) (let ((pos (point)) - (cur (org-element-at-point))) + (cur (org-element-at-point))) (when (= (save-excursion (goto-char (point-min)) - (org-skip-whitespace) - (point-at-bol)) - (org-element-get-property :begin cur)) + (org-skip-whitespace) + (point-at-bol)) + (org-element-get-property :begin cur)) (error "No previous element")) (goto-char (org-element-get-property :begin cur)) (forward-line -1) (let ((prev (org-element-at-point))) (when (org-element-nested-p cur prev) - (goto-char pos) - (error "Cannot transpose nested elements")) + (goto-char pos) + (error "Cannot transpose nested elements")) (org-element-swap-A-B prev cur)))) (defun org-element-unindent-buffer () @@ -3573,21 +3573,21 @@ modified." (unless (eq major-mode 'org-mode) (error "Cannot un-indent a buffer not in Org mode")) (let* ((parse-tree (org-element-parse-buffer 'greater-element)) - unindent-tree ; For byte-compiler. - (unindent-tree - (function - (lambda (contents) - (mapc (lambda (element) - (if (eq (car element) 'headline) - (funcall unindent-tree - (org-element-get-contents element)) - (save-excursion - (save-restriction - (narrow-to-region - (org-element-get-property :begin element) - (org-element-get-property :end element)) - (org-do-remove-indentation))))) - (reverse contents)))))) + unindent-tree ; For byte-compiler. + (unindent-tree + (function + (lambda (contents) + (mapc (lambda (element) + (if (eq (car element) 'headline) + (funcall unindent-tree + (org-element-get-contents element)) + (save-excursion + (save-restriction + (narrow-to-region + (org-element-get-property :begin element) + (org-element-get-property :end element)) + (org-do-remove-indentation))))) + (reverse contents)))))) (funcall unindent-tree (org-element-get-contents parse-tree)))) (defun org-element-up () @@ -3600,35 +3600,35 @@ Return position at the beginning of the upper element." ((org-with-limited-levels (org-at-heading-p)) (or (org-up-heading-safe) (error "No surronding element"))) ((and (org-at-item-p) - (setq elem (org-element-at-point)) - (let* ((top-list-p (zerop (org-element-get-property :level elem)))) - (unless top-list-p - ;; If parent is bound to be in the same list as the - ;; original point, move to that parent. - (let ((struct (org-element-get-property :structure elem))) - (goto-char - (org-list-get-parent - (point-at-bol) struct (org-list-parents-alist struct)))))))) + (setq elem (org-element-at-point)) + (let* ((top-list-p (zerop (org-element-get-property :level elem)))) + (unless top-list-p + ;; If parent is bound to be in the same list as the + ;; original point, move to that parent. + (let ((struct (org-element-get-property :structure elem))) + (goto-char + (org-list-get-parent + (point-at-bol) struct (org-list-parents-alist struct)))))))) (t (let* ((elem (or elem (org-element-at-point))) - (end (save-excursion - (goto-char (org-element-get-property :end elem)) - (skip-chars-backward " \r\t\n") - (forward-line) - (point))) - prev-elem) - (goto-char (org-element-get-property :begin elem)) - (forward-line -1) - (while (and (< (org-element-get-property - :end (setq prev-elem (org-element-at-point))) - end) - (not (bobp))) - (goto-char (org-element-get-property :begin prev-elem)) - (forward-line -1)) - (if (and (bobp) (< (org-element-get-property :end prev-elem) end)) - (progn (goto-char opoint) - (error "No surrounding element")) - (goto-char (org-element-get-property :begin prev-elem)))))))) + (end (save-excursion + (goto-char (org-element-get-property :end elem)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + prev-elem) + (goto-char (org-element-get-property :begin elem)) + (forward-line -1) + (while (and (< (org-element-get-property + :end (setq prev-elem (org-element-at-point))) + end) + (not (bobp))) + (goto-char (org-element-get-property :begin prev-elem)) + (forward-line -1)) + (if (and (bobp) (< (org-element-get-property :end prev-elem) end)) + (progn (goto-char opoint) + (error "No surrounding element")) + (goto-char (org-element-get-property :begin prev-elem)))))))) (provide 'org-element) diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el index 3ad5f77b5..7b7649883 100644 --- a/contrib/lisp/org-export.el +++ b/contrib/lisp/org-export.el @@ -149,9 +149,9 @@ the same property. It is a symbol among: t Replace old value with the new one. `space' Concatenate the values, separating them with a space. `newline' Concatenate the values, separating them with - a newline. + a newline. `split' Split values at white spaces, and cons them to the - previous list. + previous list. KEYWORD and OPTION have precedence over DEFAULT. @@ -199,9 +199,9 @@ This option can also be set with the #+OPTIONS line, e.g. \"arch:nil\"." :group 'org-export-general :type '(choice - (const :tag "Not at all" nil) - (const :tag "Headline only" 'headline) - (const :tag "Entirely" t))) + (const :tag "Not at all" nil) + (const :tag "Headline only" 'headline) + (const :tag "Entirely" t))) (defcustom org-export-with-author t "Non-nil means insert author name into the exported file. @@ -219,9 +219,9 @@ defaults to \"Generated by Org mode XX in Emacs XXX.\". If the value is `comment' insert it as a comment." :group 'org-export-general :type '(choice - (const :tag "No creator sentence" nil) - (const :tag "Sentence as a comment" 'comment) - (const :tag "Insert the sentence" t))) + (const :tag "No creator sentence" nil) + (const :tag "Sentence as a comment" 'comment) + (const :tag "Insert the sentence" t))) (defcustom org-export-creator-string (format "Generated by Org mode %s in Emacs %s." org-version emacs-version) @@ -235,10 +235,10 @@ When t, all drawers are exported. This may also be a list of drawer names to export." :group 'org-export-general :type '(choice - (const :tag "All drawers" t) - (const :tag "None" nil) - (repeat :tag "Selected drawers" - (string :tag "Drawer name")))) + (const :tag "All drawers" t) + (const :tag "None" nil) + (repeat :tag "Selected drawers" + (string :tag "Drawer name")))) (defcustom org-export-with-email nil "Non-nil means insert author email into the exported file. @@ -382,7 +382,7 @@ parsed as single sub- or superscripts. 10^24 or 10^tau several digits will be considered 1 item. 10^-12 or 10^-tau a leading sign with digits or a word x^2-y^3 will be read as x^2 - y^3, because items are - terminated by almost any nonword/nondigit char. + terminated by almost any nonword/nondigit char. x_{i^2} or x^(2-i) braces or parenthesis do grouping. Still, ambiguity is possible - so when in doubt use {} to enclose @@ -395,9 +395,9 @@ This option can also be set with the #+OPTIONS line, e.g. \"^:nil\"." :group 'org-export-general :type '(choice - (const :tag "Interpret them" t) - (const :tag "Curly brackets only" {}) - (const :tag "Do not interpret them" nil))) + (const :tag "Interpret them" t) + (const :tag "Curly brackets only" {}) + (const :tag "Do not interpret them" nil))) (defcustom org-export-with-toc t "Non-nil means create a table of contents in exported files. @@ -413,9 +413,9 @@ This option can also be set with the #+OPTIONS line, e.g. \"toc:nil\" or \"toc:3\"." :group 'org-export-general :type '(choice - (const :tag "No Table of Contents" nil) - (const :tag "Full Table of Contents" t) - (integer :tag "TOC to level"))) + (const :tag "No Table of Contents" nil) + (const :tag "Full Table of Contents" t) + (integer :tag "TOC to level"))) (defcustom org-export-with-tables t "If non-nil, lines starting with \"|\" define a table. @@ -440,9 +440,9 @@ This option can also be set with the #+OPTIONS line, e.g. \"tags:nil\"." :group 'org-export-general :type '(choice - (const :tag "Off" nil) - (const :tag "Not in TOC" not-in-toc) - (const :tag "On" t))) + (const :tag "Off" nil) + (const :tag "Not in TOC" not-in-toc) + (const :tag "On" t))) (defcustom org-export-with-tasks t "Non-nil means include TODO items for export. @@ -454,12 +454,12 @@ nil remove all tasks before export list of keywords keep only tasks with these keywords" :group 'org-export-general :type '(choice - (const :tag "All tasks" t) - (const :tag "No tasks" nil) - (const :tag "Not-done tasks" todo) - (const :tag "Only done tasks" done) - (repeat :tag "Specific TODO keywords" - (string :tag "Keyword")))) + (const :tag "All tasks" t) + (const :tag "No tasks" nil) + (const :tag "Not-done tasks" todo) + (const :tag "Only done tasks" done) + (repeat :tag "Specific TODO keywords" + (string :tag "Keyword")))) (defcustom org-export-time-stamp-file t "Non-nil means insert a time stamp into the exported file. @@ -485,9 +485,9 @@ This is a potential security risk, which is why the user must confirm the use of these lines." :group 'org-export-general :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Ask a confirmation for each file" confirm))) + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Ask a confirmation for each file" confirm))) (defcustom org-export-snippet-translation-alist nil "Alist between export snippets back-ends and exporter back-ends. @@ -499,9 +499,9 @@ back-end will recognize the contents of \"@h{}\" as HTML code while every other back-end will ignore it." :group 'org-export-general :type '(repeat - (cons - (string :tag "Shortcut") - (string :tag "Back-end")))) + (cons + (string :tag "Shortcut") + (string :tag "Back-end")))) @@ -859,29 +859,29 @@ settings." (org-export-install-letbind-maybe) ;; Get and prioritize export options... (let ((options (org-combine-plists - ;; ... from global variables... - (org-export-get-global-options backend) - ;; ... from an external property list... - ext-plist - ;; ... from in-buffer settings... - (org-export-get-inbuffer-options - (org-with-wide-buffer (buffer-string)) backend - (and buffer-file-name - (org-remove-double-quotes buffer-file-name))) - ;; ... and from subtree, when appropriate. - (and subtreep - (org-export-get-subtree-options))))) + ;; ... from global variables... + (org-export-get-global-options backend) + ;; ... from an external property list... + ext-plist + ;; ... from in-buffer settings... + (org-export-get-inbuffer-options + (org-with-wide-buffer (buffer-string)) backend + (and buffer-file-name + (org-remove-double-quotes buffer-file-name))) + ;; ... and from subtree, when appropriate. + (and subtreep + (org-export-get-subtree-options))))) ;; Add initial options. (setq options (append (org-export-initial-options options) - options)) + options)) ;; Set a default title if none has been specified so far. (unless (plist-get options :title) (setq options (plist-put options :title - (or (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory - buffer-file-name))) - (buffer-name))))) + (or (and buffer-file-name + (file-name-sans-extension + (file-name-nondirectory + buffer-file-name))) + (buffer-name))))) ;; Return plist. options)) @@ -889,26 +889,26 @@ settings." "Parse an OPTIONS line and return values as a plist. BACKEND is a symbol specifying the back-end to use." (let* ((all (append org-export-option-alist - (let ((var (intern - (format "org-%s-option-alist" backend)))) - (and (boundp var) (eval var))))) - ;; Build an alist between #+OPTION: item and property-name. - (alist (delq nil - (mapcar (lambda (e) - (when (nth 2 e) (cons (regexp-quote (nth 2 e)) - (car e)))) - all))) - plist) + (let ((var (intern + (format "org-%s-option-alist" backend)))) + (and (boundp var) (eval var))))) + ;; Build an alist between #+OPTION: item and property-name. + (alist (delq nil + (mapcar (lambda (e) + (when (nth 2 e) (cons (regexp-quote (nth 2 e)) + (car e)))) + all))) + plist) (mapc (lambda (e) - (when (string-match (concat "\\(\\`\\|[ \t]\\)" - (car e) - ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") - options) - (setq plist (plist-put plist - (cdr e) - (car (read-from-string - (match-string 2 options))))))) - alist) + (when (string-match (concat "\\(\\`\\|[ \t]\\)" + (car e) + ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") + options) + (setq plist (plist-put plist + (cdr e) + (car (read-from-string + (match-string 2 options))))))) + alist) plist)) (defun org-export-get-subtree-options () @@ -918,17 +918,17 @@ Return the options as a plist." (when (ignore-errors (org-back-to-heading t)) (let (prop plist) (when (setq prop (progn (looking-at org-todo-line-regexp) - (or (org-entry-get (point) "EXPORT_TITLE") - (org-match-string-no-properties 3)))) - (setq plist (plist-put plist :title prop))) + (or (org-entry-get (point) "EXPORT_TITLE") + (org-match-string-no-properties 3)))) + (setq plist (plist-put plist :title prop))) (when (setq prop (org-entry-get (point) "EXPORT_TEXT")) - (setq plist (plist-put plist :text prop))) + (setq plist (plist-put plist :text prop))) (when (setq prop (org-entry-get (point) "EXPORT_AUTHOR")) - (setq plist (plist-put plist :author prop))) + (setq plist (plist-put plist :author prop))) (when (setq prop (org-entry-get (point) "EXPORT_DATE")) - (setq plist (plist-put plist :date prop))) + (setq plist (plist-put plist :date prop))) (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS")) - (setq plist (org-export-add-options-to-plist plist prop))) + (setq plist (org-export-add-options-to-plist plist prop))) plist)))) (defun org-export-get-inbuffer-options (buffer-string backend files) @@ -938,81 +938,81 @@ specifying which back-end should be used." (let ((case-fold-search t) plist) ;; 1. Special keywords, as in `org-export-special-keywords'. (let ((start 0) - (special-re (org-make-options-regexp org-export-special-keywords))) + (special-re (org-make-options-regexp org-export-special-keywords))) (while (string-match special-re buffer-string start) - (setq start (match-end 0)) - (let ((key (upcase (org-match-string-no-properties 1 buffer-string))) - ;; Special keywords do not have their value expanded. - (val (org-match-string-no-properties 2 buffer-string))) - (setq plist - (org-combine-plists - (cond - ((string= key "SETUP_FILE") - (let ((file (expand-file-name - (org-remove-double-quotes (org-trim val))))) - ;; Avoid circular dependencies. - (unless (member file files) - (org-export-get-inbuffer-options - (org-file-contents file 'noerror) - backend - (cons file files))))) - ((string= key "OPTIONS") - (org-export-parse-option-keyword val backend)) - ((string= key "MACRO") - (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" - val) - (plist-put nil - (intern (concat ":macro-" - (downcase (match-string 1 val)))) - (match-string 2 val)))) - plist))))) + (setq start (match-end 0)) + (let ((key (upcase (org-match-string-no-properties 1 buffer-string))) + ;; Special keywords do not have their value expanded. + (val (org-match-string-no-properties 2 buffer-string))) + (setq plist + (org-combine-plists + (cond + ((string= key "SETUP_FILE") + (let ((file (expand-file-name + (org-remove-double-quotes (org-trim val))))) + ;; Avoid circular dependencies. + (unless (member file files) + (org-export-get-inbuffer-options + (org-file-contents file 'noerror) + backend + (cons file files))))) + ((string= key "OPTIONS") + (org-export-parse-option-keyword val backend)) + ((string= key "MACRO") + (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" + val) + (plist-put nil + (intern (concat ":macro-" + (downcase (match-string 1 val)))) + (match-string 2 val)))) + plist))))) ;; 2. Standard options, as in `org-export-option-alist'. (let* ((all (append org-export-option-alist - (let ((var (intern - (format "org-%s-option-alist" backend)))) - (and (boundp var) (eval var))))) - ;; Build alist between keyword name and property name. - (alist (delq nil (mapcar (lambda (e) - (when (nth 1 e) (cons (nth 1 e) (car e)))) - all))) - ;; Build regexp matching all keywords associated to export - ;; options. Note: the search is case insensitive. - (opt-re (org-make-options-regexp - (delq nil (mapcar (lambda (e) (nth 1 e)) all)))) - (start 0)) + (let ((var (intern + (format "org-%s-option-alist" backend)))) + (and (boundp var) (eval var))))) + ;; Build alist between keyword name and property name. + (alist (delq nil (mapcar (lambda (e) + (when (nth 1 e) (cons (nth 1 e) (car e)))) + all))) + ;; Build regexp matching all keywords associated to export + ;; options. Note: the search is case insensitive. + (opt-re (org-make-options-regexp + (delq nil (mapcar (lambda (e) (nth 1 e)) all)))) + (start 0)) (while (string-match opt-re buffer-string start) - (setq start (match-end 0)) - (let* ((key (upcase (org-match-string-no-properties 1 buffer-string))) - ;; Expand value, applying restrictions for keywords. - (val (org-match-string-no-properties 2 buffer-string)) - (prop (cdr (assoc key alist))) - (behaviour (nth 4 (assq prop all)))) - (setq plist - (plist-put - plist prop - ;; Handle value depending on specified BEHAVIOUR. - (case behaviour - (space (if (plist-get plist prop) - (concat (plist-get plist prop) " " (org-trim val)) - (org-trim val))) - (newline (org-trim - (concat - (plist-get plist prop) "\n" (org-trim val)))) - (split `(,@(plist-get plist prop) ,@(org-split-string val))) - ('t val) - (otherwise (plist-get plist prop))))))) + (setq start (match-end 0)) + (let* ((key (upcase (org-match-string-no-properties 1 buffer-string))) + ;; Expand value, applying restrictions for keywords. + (val (org-match-string-no-properties 2 buffer-string)) + (prop (cdr (assoc key alist))) + (behaviour (nth 4 (assq prop all)))) + (setq plist + (plist-put + plist prop + ;; Handle value depending on specified BEHAVIOUR. + (case behaviour + (space (if (plist-get plist prop) + (concat (plist-get plist prop) " " (org-trim val)) + (org-trim val))) + (newline (org-trim + (concat + (plist-get plist prop) "\n" (org-trim val)))) + (split `(,@(plist-get plist prop) ,@(org-split-string val))) + ('t val) + (otherwise (plist-get plist prop))))))) ;; Parse keywords specified in `org-element-parsed-keywords'. (mapc (lambda (key) - (let* ((prop (cdr (assoc (upcase key) alist))) - (value (and prop (plist-get plist prop)))) - (when (stringp value) - (setq plist - (plist-put - plist prop - (org-element-parse-secondary-string - value - (cdr (assq 'keyword org-element-string-restrictions)))))))) + (let* ((prop (cdr (assoc (upcase key) alist))) + (value (and prop (plist-get plist prop)))) + (when (stringp value) + (setq plist + (plist-put + plist prop + (org-element-parse-secondary-string + value + (cdr (assq 'keyword org-element-string-restrictions)))))))) org-element-parsed-keywords)) ;; Return final value. plist)) @@ -1021,15 +1021,15 @@ specifying which back-end should be used." "Return global export options as a plist. BACKEND is a symbol specifying which back-end should be used." (let ((all (append org-export-option-alist - (let ((var (intern - (format "org-%s-option-alist" backend)))) - (and (boundp var) (eval var))))) - ;; Output value. - plist) + (let ((var (intern + (format "org-%s-option-alist" backend)))) + (and (boundp var) (eval var))))) + ;; Output value. + plist) (mapc (lambda (cell) - (setq plist - (plist-put plist (car cell) (eval (nth 3 cell))))) - all) + (setq plist + (plist-put plist (car cell) (eval (nth 3 cell))))) + all) ;; Return value. plist)) @@ -1042,24 +1042,24 @@ OPTIONS is the export options plist computed so far." :macro-property "(eval (org-entry-get nil \"$1\" 'selective))" :macro-modification-time (and (buffer-file-name) - (file-exists-p (buffer-file-name)) - (concat "(eval (format-time-string \"$1\" '" - (prin1-to-string (nth 5 (file-attributes (buffer-file-name)))) - "))")) + (file-exists-p (buffer-file-name)) + (concat "(eval (format-time-string \"$1\" '" + (prin1-to-string (nth 5 (file-attributes (buffer-file-name)))) + "))")) :macro-input-file (and (buffer-file-name) - (file-name-nondirectory (buffer-file-name))) + (file-name-nondirectory (buffer-file-name))) :footnotes-labels-alist (let (alist) (org-with-wide-buffer (goto-char (point-min)) (while (re-search-forward org-footnote-definition-re nil t) - (let ((def (org-footnote-at-definition-p))) - (org-skip-whitespace) - (push (cons (car def) - (save-restriction - (narrow-to-region (point) (nth 2 def)) - (org-element-parse-buffer))) - alist))) + (let ((def (org-footnote-at-definition-p))) + (org-skip-whitespace) + (push (cons (car def) + (save-restriction + (narrow-to-region (point) (nth 2 def)) + (org-element-parse-buffer))) + alist))) alist)))) (defvar org-export-allow-BIND-local nil) @@ -1072,7 +1072,7 @@ possible security risks." ((eq org-export-allow-BIND t) t) ((local-variable-p 'org-export-allow-BIND-local) org-export-allow-BIND-local) (t (org-set-local 'org-export-allow-BIND-local - (yes-or-no-p "Allow BIND values in this buffer? "))))) + (yes-or-no-p "Allow BIND values in this buffer? "))))) (defun org-export-install-letbind-maybe () "Install the values from #+BIND lines as local variables. @@ -1083,8 +1083,8 @@ retrieved." (goto-char (point-min)) (while (re-search-forward (org-make-options-regexp '("BIND")) nil t) (when (org-export-confirm-letbind) - (push (read (concat "(" (org-match-string-no-properties 2) ")")) - letbind)))) + (push (read (concat "(" (org-match-string-no-properties 2) ")")) + letbind)))) (while (setq pair (pop letbind)) (org-set-local (car pair) (nth 1 pair))))) @@ -1109,7 +1109,7 @@ retrieved." (defconst org-export-persistent-properties-list '(:code-refs :headline-alist :headline-offset :headline-offset :parse-tree - :point-max :seen-footnote-labels :total-loc :use-select-tags) + :point-max :seen-footnote-labels :total-loc :use-select-tags) "List of persistent properties.") (defconst org-export-persistent-properties nil @@ -1130,16 +1130,16 @@ Following initial persistent properties are set: `:back-end' Back-end used for transcoding. `:headline-alist' Alist of all headlines' name as key and a list - holding beginning and ending positions as - value. + holding beginning and ending positions as + value. `:headline-offset' Offset between true level of headlines and - local level. An offset of -1 means an headline - of level 2 should be considered as a level - 1 headline in the context. + local level. An offset of -1 means an headline + of level 2 should be considered as a level + 1 headline in the context. `:headline-numbering' Alist of all headlines' beginning position - as key an the associated numbering as value. + as key an the associated numbering as value. `:parse-tree' Whole parse tree. @@ -1148,49 +1148,49 @@ Following initial persistent properties are set: `:target-list' List of all targets' raw name in the parse tree. `:use-select-tags' Non-nil when parsed tree use a special tag to - enforce transcoding of the headline." + enforce transcoding of the headline." ;; First delete any residual persistent property. (setq org-export-persistent-properties nil) ;; Immediately after, set `:use-select-tags' property, as it will be ;; required for further computations. (setq options - (org-export-set-property - options - :use-select-tags - (org-export-use-select-tags-p data options))) + (org-export-set-property + options + :use-select-tags + (org-export-use-select-tags-p data options))) ;; Get the rest of the initial persistent properties, now ;; `:use-select-tags' is set... ;; 1. `:parse-tree' ... (setq options (org-export-set-property options :parse-tree data)) ;; 2. `:headline-offset' ... (setq options - (org-export-set-property - options :headline-offset - (- 1 (org-export-get-min-level data options)))) + (org-export-set-property + options :headline-offset + (- 1 (org-export-get-min-level data options)))) ;; 3. `:point-max' ... (setq options (org-export-set-property - options :point-max - (org-export-get-point-max data options))) + options :point-max + (org-export-get-point-max data options))) ;; 4. `:target-list'... (setq options (org-export-set-property - options :target-list - (org-element-map - data 'target - (lambda (target info) - (org-element-get-property :raw-value target))))) + options :target-list + (org-element-map + data 'target + (lambda (target info) + (org-element-get-property :raw-value target))))) ;; 5. `:headline-alist' (setq options (org-export-set-property - options :headline-alist - (org-element-map - data 'headline - (lambda (headline info) - (list (org-element-get-property :raw-value headline) - (org-element-get-property :begin headline) - (org-element-get-property :end headline)))))) + options :headline-alist + (org-element-map + data 'headline + (lambda (headline info) + (list (org-element-get-property :raw-value headline) + (org-element-get-property :begin headline) + (org-element-get-property :end headline)))))) ;; 6. `:headline-numbering' (setq options (org-export-set-property - options :headline-numbering - (org-export-collect-headline-numbering data options))) + options :headline-numbering + (org-export-collect-headline-numbering data options))) ;; 7. `:back-end' (setq options (org-export-set-property options :back-end backend))) @@ -1204,7 +1204,7 @@ OPTIONS is a plist holding export options." (lambda (headline info) (let ((tags (org-element-get-property :with-tags headline))) (and tags (string-match - (format ":%s:" (plist-get info :select-tags)) tags)))) + (format ":%s:" (plist-get info :select-tags)) tags)))) options 'stop-at-first-match)) @@ -1215,12 +1215,12 @@ OPTIONS is a plist holding export options." (catch 'exit (let ((min-level 10000)) (mapc (lambda (blob) - (when (and (eq (car blob) 'headline) - (not (org-export-skip-p blob options))) - (setq min-level - (min (org-element-get-property :level blob) min-level))) - (when (= min-level 1) (throw 'exit 1))) - (org-element-get-contents data)) + (when (and (eq (car blob) 'headline) + (not (org-export-skip-p blob options))) + (setq min-level + (min (org-element-get-property :level blob) min-level))) + (when (= min-level 1) (throw 'exit 1))) + (org-element-get-contents data)) ;; If no headline was found, for the sake of consistency, set ;; minimum level to 1 nonetheless. (if (= min-level 10000) 1 min-level)))) @@ -1231,10 +1231,10 @@ DATA is parsed tree as returned by `org-element-parse-buffer'. OPTIONS is a plist holding export options." (let ((pos-max 1)) (mapc (lambda (blob) - (unless (and (eq (car blob) 'headline) - (org-export-skip-p blob options)) - (setq pos-max (org-element-get-property :end blob)))) - (org-element-get-contents data)) + (unless (and (eq (car blob) 'headline) + (org-export-skip-p blob options)) + (setq pos-max (org-element-get-property :end blob)))) + (org-element-get-contents data)) pos-max)) (defun org-export-collect-headline-numbering (data options) @@ -1252,13 +1252,13 @@ numbers)." 'headline (lambda (headline info) (let ((relative-level (1- (org-export-get-relative-level blob info)))) - (cons - (org-element-get-property :begin headline) - (loop for n across numbering - for idx from 0 to org-export-max-depth - when (< idx relative-level) collect n - when (= idx relative-level) collect (aset numbering idx (1+ n)) - when (> idx relative-level) do (aset numbering idx 0))))) + (cons + (org-element-get-property :begin headline) + (loop for n across numbering + for idx from 0 to org-export-max-depth + when (< idx relative-level) collect n + when (= idx relative-level) collect (aset numbering idx (1+ n)) + when (> idx relative-level) do (aset numbering idx 0))))) options))) @@ -1285,15 +1285,15 @@ will be inside the current one. The following properties are updated: `genealogy' List of current element's parents - (symbol list). + (symbol list). `inherited-properties' List of inherited properties from - parent headlines (plist). + parent headlines (plist). `parent-properties' List of last element's properties - (plist). + (plist). `previous-element' Previous element's type (symbol). `previous-object' Previous object's type (symbol). `seen-footnote-labels' List of already parsed footnote - labels (string list) + labels (string list) Return the property list." (let* ((type (and (not (stringp blob)) (car blob)))) @@ -1303,17 +1303,17 @@ Return the property list." (org-combine-plists info `(:genealogy ,(cons type (plist-get info :genealogy)) - :previous-element nil - :previous-object nil - :parent-properties - ,(if (memq type org-element-all-elements) - (nth 1 blob) - (plist-get info :parent-properties)) - :inherited-properties - ,(if (eq type 'headline) - (org-combine-plists - (plist-get info :inherited-properties) (nth 1 blob)) - (plist-get info :inherited-properties))) + :previous-element nil + :previous-object nil + :parent-properties + ,(if (memq type org-element-all-elements) + (nth 1 blob) + (plist-get info :parent-properties)) + :inherited-properties + ,(if (eq type 'headline) + (org-combine-plists + (plist-get info :inherited-properties) (nth 1 blob)) + (plist-get info :inherited-properties))) ;; Add persistent properties. org-export-persistent-properties)) ;; Case 2: No recursion. @@ -1321,22 +1321,22 @@ Return the property list." ;; At a footnote reference: mark its label as seen, if not ;; already the case. (when (eq type 'footnote-reference) - (let ((label (org-element-get-property :label blob)) - (seen-labels (plist-get org-export-persistent-properties - :seen-footnote-labels))) - ;; Store anonymous footnotes (nil label) without checking if - ;; another anonymous footnote was seen before. - (unless (and label (member label seen-labels)) - (setq info (org-export-set-property - info :seen-footnote-labels (push label seen-labels)))))) + (let ((label (org-element-get-property :label blob)) + (seen-labels (plist-get org-export-persistent-properties + :seen-footnote-labels))) + ;; Store anonymous footnotes (nil label) without checking if + ;; another anonymous footnote was seen before. + (unless (and label (member label seen-labels)) + (setq info (org-export-set-property + info :seen-footnote-labels (push label seen-labels)))))) ;; Set `:previous-element' or `:previous-object' according to ;; BLOB. (setq info (cond ((not type) - (org-export-set-property - info :previous-object 'plain-text)) - ((memq type org-element-all-elements) - (org-export-set-property info :previous-element type)) - (t (org-export-set-property info :previous-object type)))) + (org-export-set-property + info :previous-object 'plain-text)) + ((memq type org-element-all-elements) + (org-export-set-property info :previous-element type)) + (t (org-export-set-property info :previous-object type)))) ;; Return updated value. info)))) @@ -1345,7 +1345,7 @@ Return the property list." Return the new plist." (when (memq prop org-export-persistent-properties-list) (setq org-export-persistent-properties - (plist-put org-export-persistent-properties prop value))) + (plist-put org-export-persistent-properties prop value))) (plist-put info prop value)) @@ -1394,94 +1394,94 @@ Return transcoded string." ((stringp blob) (setq info (org-export-update-info blob info nil)) (let ((transcoder (intern (format "org-%s-plain-text" backend)))) - (org-export-filter-apply-functions - org-export-filter-plain-text-functions - (if (fboundp transcoder) (funcall transcoder blob info) blob) - backend))) + (org-export-filter-apply-functions + org-export-filter-plain-text-functions + (if (fboundp transcoder) (funcall transcoder blob info) blob) + backend))) ;; BLOB is an element or an object. (t (let* ((type (if (stringp blob) 'plain-text (car blob))) - ;; 1. Determine the appropriate TRANSCODER. - (transcoder - (cond - ;; 1.0 A full Org document is inserted. - ((eq type 'org-data) 'identity) - ;; 1.1. BLOB should be ignored. - ((org-export-skip-p blob info) nil) - ;; 1.2. BLOB shouldn't be transcoded. Interpret it - ;; back into Org syntax. - ((not (org-export-interpret-p blob info)) - 'org-export-expand) - ;; 1.3. Else apply naming convention. - (t (let ((trans (intern - (format "org-%s-%s" backend type)))) - (and (fboundp trans) trans))))) - ;; 2. Compute CONTENTS of BLOB. - (contents - (cond - ;; Case 0. No transcoder defined: ignore BLOB. - ((not transcoder) nil) - ;; Case 1. Transparently export an Org document. - ((eq type 'org-data) - (org-export-data blob backend info)) - ;; Case 2. For a recursive object. - ((memq type org-element-recursive-objects) - (org-export-data - blob backend (org-export-update-info blob info t))) - ;; Case 3. For a recursive element. - ((memq type org-element-greater-elements) - ;; Ignore contents of an archived tree - ;; when `:with-archived-trees' is `headline'. - (unless (and - (eq type 'headline) - (eq (plist-get info :with-archived-trees) 'headline) - (org-element-get-property :archivedp blob)) - (org-element-normalize-string - (org-export-data - blob backend (org-export-update-info blob info t))))) - ;; Case 4. For a paragraph. - ((eq type 'paragraph) - (let ((paragraph - (org-element-normalize-contents - blob - ;; When normalizing contents of an item or - ;; a footnote definition, ignore first line's - ;; indentation: there is none and it might be - ;; misleading. - (and (not (plist-get info :previous-element)) - (let ((parent (car (plist-get info :genealogy)))) - (memq parent '(footnote-definition item))))))) - (org-export-data - paragraph - backend - (org-export-update-info blob info t)))))) - ;; 3. Transcode BLOB into RESULTS string. - (results (cond - ((not transcoder) nil) - ((eq transcoder 'org-export-expand) - (org-export-data - `(org-data nil ,(funcall transcoder blob contents)) - backend info)) - (t (funcall transcoder blob contents info))))) - ;; 4. Discard nil results. Otherwise, update INFO, append - ;; the same white space between elements or objects as in - ;; the original buffer, and call appropriate filters. - (when results - (setq info (org-export-update-info blob info nil)) - ;; No filter for a full document. - (if (eq type 'org-data) - results - (org-export-filter-apply-functions - (eval (intern (format "org-export-filter-%s-functions" type))) - (if (memq type org-element-all-elements) - (concat - (org-element-normalize-string results) - (make-string (org-element-get-property :post-blank blob) 10)) - (concat - results - (make-string - (org-element-get-property :post-blank blob) 32))) - backend))))))) + ;; 1. Determine the appropriate TRANSCODER. + (transcoder + (cond + ;; 1.0 A full Org document is inserted. + ((eq type 'org-data) 'identity) + ;; 1.1. BLOB should be ignored. + ((org-export-skip-p blob info) nil) + ;; 1.2. BLOB shouldn't be transcoded. Interpret it + ;; back into Org syntax. + ((not (org-export-interpret-p blob info)) + 'org-export-expand) + ;; 1.3. Else apply naming convention. + (t (let ((trans (intern + (format "org-%s-%s" backend type)))) + (and (fboundp trans) trans))))) + ;; 2. Compute CONTENTS of BLOB. + (contents + (cond + ;; Case 0. No transcoder defined: ignore BLOB. + ((not transcoder) nil) + ;; Case 1. Transparently export an Org document. + ((eq type 'org-data) + (org-export-data blob backend info)) + ;; Case 2. For a recursive object. + ((memq type org-element-recursive-objects) + (org-export-data + blob backend (org-export-update-info blob info t))) + ;; Case 3. For a recursive element. + ((memq type org-element-greater-elements) + ;; Ignore contents of an archived tree + ;; when `:with-archived-trees' is `headline'. + (unless (and + (eq type 'headline) + (eq (plist-get info :with-archived-trees) 'headline) + (org-element-get-property :archivedp blob)) + (org-element-normalize-string + (org-export-data + blob backend (org-export-update-info blob info t))))) + ;; Case 4. For a paragraph. + ((eq type 'paragraph) + (let ((paragraph + (org-element-normalize-contents + blob + ;; When normalizing contents of an item or + ;; a footnote definition, ignore first line's + ;; indentation: there is none and it might be + ;; misleading. + (and (not (plist-get info :previous-element)) + (let ((parent (car (plist-get info :genealogy)))) + (memq parent '(footnote-definition item))))))) + (org-export-data + paragraph + backend + (org-export-update-info blob info t)))))) + ;; 3. Transcode BLOB into RESULTS string. + (results (cond + ((not transcoder) nil) + ((eq transcoder 'org-export-expand) + (org-export-data + `(org-data nil ,(funcall transcoder blob contents)) + backend info)) + (t (funcall transcoder blob contents info))))) + ;; 4. Discard nil results. Otherwise, update INFO, append + ;; the same white space between elements or objects as in + ;; the original buffer, and call appropriate filters. + (when results + (setq info (org-export-update-info blob info nil)) + ;; No filter for a full document. + (if (eq type 'org-data) + results + (org-export-filter-apply-functions + (eval (intern (format "org-export-filter-%s-functions" type))) + (if (memq type org-element-all-elements) + (concat + (org-element-normalize-string results) + (make-string (org-element-get-property :post-blank blob) 10)) + (concat + results + (make-string + (org-element-get-property :post-blank blob) 32))) + backend))))))) (org-element-get-contents data) "")) (defun org-export-secondary-string (secondary backend info) @@ -1510,48 +1510,48 @@ INFO is the plist holding export options." (case (car blob) ('headline (let ((with-tasks (plist-get info :with-tasks)) - (todo (org-element-get-property :todo-keyword blob)) - (todo-type (org-element-get-property :todo-type blob)) - (archived (plist-get info :with-archived-trees)) - (tag-list (let ((tags (org-element-get-property :tags blob))) - (and tags (org-split-string tags ":"))))) - (or - ;; Ignore subtrees with an exclude tag. - (loop for k in (plist-get info :exclude-tags) - thereis (member k tag-list)) - ;; Ignore subtrees without a select tag, when such tag is found - ;; in the buffer. - (and (plist-get info :use-select-tags) - (loop for k in (plist-get info :select-tags) - never (member k tag-list))) - ;; Ignore commented sub-trees. - (org-element-get-property :commentedp blob) - ;; Ignore archived subtrees if `:with-archived-trees' is nil. - (and (not archived) (org-element-get-property :archivedp blob)) - ;; Ignore tasks, if specified by `:with-tasks' property. - (and todo (not with-tasks)) - (and todo - (memq with-tasks '(todo done)) - (not (eq todo-type with-tasks))) - (and todo - (consp with-tasks) - (not (member todo with-tasks)))))) + (todo (org-element-get-property :todo-keyword blob)) + (todo-type (org-element-get-property :todo-type blob)) + (archived (plist-get info :with-archived-trees)) + (tag-list (let ((tags (org-element-get-property :tags blob))) + (and tags (org-split-string tags ":"))))) + (or + ;; Ignore subtrees with an exclude tag. + (loop for k in (plist-get info :exclude-tags) + thereis (member k tag-list)) + ;; Ignore subtrees without a select tag, when such tag is found + ;; in the buffer. + (and (plist-get info :use-select-tags) + (loop for k in (plist-get info :select-tags) + never (member k tag-list))) + ;; Ignore commented sub-trees. + (org-element-get-property :commentedp blob) + ;; Ignore archived subtrees if `:with-archived-trees' is nil. + (and (not archived) (org-element-get-property :archivedp blob)) + ;; Ignore tasks, if specified by `:with-tasks' property. + (and todo (not with-tasks)) + (and todo + (memq with-tasks '(todo done)) + (not (eq todo-type with-tasks))) + (and todo + (consp with-tasks) + (not (member todo with-tasks)))))) ;; Check time-stamp. ('time-stamp (not (plist-get info :with-timestamps))) ;; Check drawer. ('drawer (or (not (plist-get info :with-drawers)) - (and (consp (plist-get info :with-drawers)) - (not (member (org-element-get-property :drawer-name blob) - (plist-get info :with-drawers)))))) + (and (consp (plist-get info :with-drawers)) + (not (member (org-element-get-property :drawer-name blob) + (plist-get info :with-drawers)))))) ;; Check export snippet. ('export-snippet (let* ((raw-back-end (org-element-get-property :back-end blob)) - (true-back-end - (or (cdr (assoc raw-back-end org-export-snippet-translation-alist)) - raw-back-end))) - (not (string= (symbol-name (plist-get info :back-end)) - true-back-end))))))) + (true-back-end + (or (cdr (assoc raw-back-end org-export-snippet-translation-alist)) + raw-back-end))) + (not (string= (symbol-name (plist-get info :back-end)) + true-back-end))))))) (defun org-export-interpret-p (blob info) "Non-nil if element or object BLOB should be interpreted as Org syntax. @@ -1571,8 +1571,8 @@ a plist." ((subscript superscript) (let ((sub/super-p (plist-get info :with-sub-superscript))) (if (eq sub/super-p '{}) - (org-element-get-property :use-brackets-p blob) - sub/super-p))) + (org-element-get-property :use-brackets-p blob) + sub/super-p))) ;; ... tables... (table (plist-get info :with-tables)) (otherwise t))) @@ -1899,8 +1899,8 @@ developer-specified filters, if any, are called first." ;; Ensure FILTERS is a list. (let ((filters (if (listp filters) (reverse filters) (list filters)))) (loop for filter in filters - if (not value) return nil else - do (setq value (funcall filter value backend)))) + if (not value) return nil else + do (setq value (funcall filter value backend)))) value) @@ -1917,7 +1917,7 @@ developer-specified filters, if any, are called first." ;; `org-export-with-current-buffer-copy' macro prepares that copy. (defun org-export-as (backend - &optional subtreep visible-only body-only ext-plist) + &optional subtreep visible-only body-only ext-plist) "Transcode current Org buffer into BACKEND code. If narrowing is active in the current buffer, only transcode its @@ -1944,47 +1944,47 @@ Return code as a string." (save-restriction ;; Narrow buffer to an appropriate region for parsing. (when (org-region-active-p) - (narrow-to-region (region-beginning) (region-end))) + (narrow-to-region (region-beginning) (region-end))) (goto-char (point-min)) (when subtreep - (unless (org-at-heading-p) - (org-with-limited-levels (outline-next-heading))) - (let ((end (save-excursion (org-end-of-subtree t))) - (begin (progn (forward-line) - (org-skip-whitespace) - (point-at-bol)))) - (narrow-to-region begin end))) + (unless (org-at-heading-p) + (org-with-limited-levels (outline-next-heading))) + (let ((end (save-excursion (org-end-of-subtree t))) + (begin (progn (forward-line) + (org-skip-whitespace) + (point-at-bol)))) + (narrow-to-region begin end))) ;; Retrieve export options (INFO) and parsed tree (RAW-DATA). ;; Buffer isn't parsed directly. Instead, a temporary copy is ;; created, where all code blocks are evaluated. RAW-DATA is ;; the parsed tree of the buffer resulting from that process. ;; Eventually call `org-export-filter-parse-tree-functions'.. (let ((info (org-export-collect-options backend subtreep ext-plist)) - (raw-data (org-export-filter-apply-functions - org-export-filter-parse-tree-functions - (org-export-with-current-buffer-copy - (org-export-blocks-preprocess) - (org-element-parse-buffer nil visible-only)) - backend))) - ;; Initialize the communication system and combine it to INFO. - (setq info - (org-combine-plists - info - (org-export-initialize-persistent-properties - raw-data info backend))) - ;; Now transcode RAW-DATA. Also call - ;; `org-export-filter-final-output-functions'. - (let ((body (org-element-normalize-string - (org-export-data raw-data backend info))) - (template (intern (format "org-%s-template" backend)))) - (if (and (not body-only) (fboundp template)) - (org-trim - (org-export-filter-apply-functions - org-export-filter-final-output-functions - (funcall template body info) - backend)) - (org-export-filter-apply-functions - org-export-filter-final-output-functions body backend))))))) + (raw-data (org-export-filter-apply-functions + org-export-filter-parse-tree-functions + (org-export-with-current-buffer-copy + (org-export-blocks-preprocess) + (org-element-parse-buffer nil visible-only)) + backend))) + ;; Initialize the communication system and combine it to INFO. + (setq info + (org-combine-plists + info + (org-export-initialize-persistent-properties + raw-data info backend))) + ;; Now transcode RAW-DATA. Also call + ;; `org-export-filter-final-output-functions'. + (let ((body (org-element-normalize-string + (org-export-data raw-data backend info))) + (template (intern (format "org-%s-template" backend)))) + (if (and (not body-only) (fboundp template)) + (org-trim + (org-export-filter-apply-functions + org-export-filter-final-output-functions + (funcall template body info) + backend)) + (org-export-filter-apply-functions + org-export-filter-final-output-functions body backend))))))) (defun org-export-to-buffer (backend buffer &optional subtreep visible-only body-only ext-plist) "Call `org-export-as' with output to a specified buffer. @@ -2003,7 +2003,7 @@ file-local settings. Return buffer." (let ((out (org-export-as backend subtreep visible-only body-only ext-plist)) - (buffer (get-buffer-create buffer))) + (buffer (get-buffer-create buffer))) (with-current-buffer buffer (erase-buffer) (insert out) @@ -2019,12 +2019,12 @@ buffer. Point is at buffer's beginning when BODY is applied." (org-with-gensyms (original-buffer offset buffer-string overlays) `(let ((,original-buffer ,(current-buffer)) - (,offset ,(1- (point-min))) - (,buffer-string ,(buffer-string)) - (,overlays (mapcar - 'copy-overlay (overlays-in (point-min) (point-max))))) + (,offset ,(1- (point-min))) + (,buffer-string ,(buffer-string)) + (,overlays (mapcar + 'copy-overlay (overlays-in (point-min) (point-max))))) (with-temp-buffer - (let ((buffer-invisibility-spec nil)) + (let ((buffer-invisibility-spec nil)) (org-clone-local-variables ,original-buffer "^\\(org-\\|orgtbl-\\|major-mode$\\)") (insert ,buffer-string) @@ -2075,22 +2075,22 @@ INFO is a plist holding contextual information." "Return HEADLINE numbering as a list of numbers. INFO is a plist holding contextual information." (cdr (assq (org-element-get-property :begin headline) - (plist-get info :headline-numbering)))) + (plist-get info :headline-numbering)))) (defun org-export-number-to-roman (n) "Convert integer N into a roman numeral." (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") - ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL") - ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV") - ( 1 . "I"))) - (res "")) + ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL") + ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV") + ( 1 . "I"))) + (res "")) (if (<= n 0) - (number-to-string n) + (number-to-string n) (while roman - (if (>= n (caar roman)) - (setq n (- n (caar roman)) - res (concat res (cdar roman))) - (pop roman))) + (if (>= n (caar roman)) + (setq n (- n (caar roman)) + res (concat res (cdar roman))) + (pop roman))) res))) (defun org-export-first-sibling-p (headline info) @@ -2103,7 +2103,7 @@ INFO is the plist used as a communication channel." INFO is the plist used as a communication channel." (= (org-element-get-property :end headline) (or (plist-get (plist-get info :parent-properties) :end) - (plist-get info :point-max)))) + (plist-get info :point-max)))) ;;;; For Include Keywords @@ -2129,9 +2129,9 @@ properties. Return the transcoded string." (let ((data (org-export-parse-included-file keyword info)) - (file (let ((value (org-element-get-property :value keyword))) - (and (string-match "^\"\\(\\S-+\\)\"" value) - (match-string 1 value))))) + (file (let ((value (org-element-get-property :value keyword))) + (and (string-match "^\"\\(\\S-+\\)\"" value) + (match-string 1 value))))) (org-element-normalize-string (org-export-data data backend @@ -2140,14 +2140,14 @@ Return the transcoded string." ;; Store full path of already included files to avoid ;; recursive file inclusion. `(:included-files - ,(cons (expand-file-name file) (plist-get info :included-files)) - ;; Ensure that a top-level headline in the included - ;; file becomes a direct child of the current headline - ;; in the buffer. - :headline-offset - ,(- (+ (plist-get (plist-get info :inherited-properties) :level) - (plist-get info :headline-offset)) - (1- (org-export-get-min-level data info))))))))) + ,(cons (expand-file-name file) (plist-get info :included-files)) + ;; Ensure that a top-level headline in the included + ;; file becomes a direct child of the current headline + ;; in the buffer. + :headline-offset + ,(- (+ (plist-get (plist-get info :inherited-properties) :level) + (plist-get info :headline-offset)) + (1- (org-export-get-min-level data info))))))))) (defun org-export-get-file-contents (file &optional lines) "Get the contents of FILE and return them as a string. @@ -2157,17 +2157,17 @@ lines, include only those lines." (insert-file-contents file) (when lines (let* ((lines (split-string lines "-")) - (lbeg (string-to-number (car lines))) - (lend (string-to-number (cadr lines))) - (beg (if (zerop lbeg) (point-min) - (goto-char (point-min)) - (forward-line (1- lbeg)) - (point))) - (end (if (zerop lend) (point-max) - (goto-char (point-min)) - (forward-line (1- lend)) - (point)))) - (narrow-to-region beg end))) + (lbeg (string-to-number (car lines))) + (lend (string-to-number (cadr lines))) + (beg (if (zerop lbeg) (point-min) + (goto-char (point-min)) + (forward-line (1- lbeg)) + (point))) + (end (if (zerop lend) (point-max) + (goto-char (point-min)) + (forward-line (1- lend)) + (point)))) + (narrow-to-region beg end))) (buffer-string))) (defun org-export-parse-included-file (keyword info) @@ -2179,40 +2179,40 @@ a communication channel. Return the parsed tree." (let* ((value (org-element-get-property :value keyword)) - (file (and (string-match "^\"\\(\\S-+\\)\"" value) - (prog1 (match-string 1 value) - (setq value (replace-match "" nil nil value))))) - (lines (and (string-match - ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" value) - (prog1 (match-string 1 value) - (setq value (replace-match "" nil nil value))))) - (env (cond ((string-match "\\" value) "example") - ((string-match "\\" value) "example") + ((string-match "\\ link-begin (nth 1 head)) - (<= link-end (nth 2 head))) - collect (cons (nth 1 head) (nth 2 head))))) - (loop named main for ancestor in (nreverse ancestors) do - (loop for candidate in cands - when (and (>= (car candidate) (car ancestor)) - (<= (cdr candidate) (cdr ancestor))) - do (return-from main (car candidate)))))) - ;; No candidate have a common ancestor with link: First match - ;; will do. Return its beginning position. - (t (caar cands))))))) + (link-begin (org-element-get-property :begin link)) + (link-end (org-element-get-property :end link)) + ;; Store candidates as a list of cons cells holding their + ;; beginning and ending position. + (cands (loop for head in head-alist + when (string= (car head) path) + collect (cons (nth 1 head) (nth 2 head))))) + (cond + ;; No candidate: return nil. + ((not cands) nil) + ;; If one or more candidates share common ancestors with + ;; LINK, return beginning position of the first one matching + ;; the closer ancestor shared. + ((let ((ancestors (loop for head in head-alist + when (and (> link-begin (nth 1 head)) + (<= link-end (nth 2 head))) + collect (cons (nth 1 head) (nth 2 head))))) + (loop named main for ancestor in (nreverse ancestors) do + (loop for candidate in cands + when (and (>= (car candidate) (car ancestor)) + (<= (cdr candidate) (cdr ancestor))) + do (return-from main (car candidate)))))) + ;; No candidate have a common ancestor with link: First match + ;; will do. Return its beginning position. + (t (caar cands))))))) ;;;; For Macros @@ -2322,15 +2322,15 @@ Assume LINK type is \"fuzzy\"." "Expand MACRO and return it as a string. INFO is a plist holding export options." (let* ((key (org-element-get-property :key macro)) - (args (org-element-get-property :args macro)) - (value (plist-get info (intern (format ":macro-%s" key))))) + (args (org-element-get-property :args macro)) + (value (plist-get info (intern (format ":macro-%s" key))))) ;; Replace arguments in VALUE. (let ((s 0) n) (while (string-match "\\$\\([0-9]+\\)" value s) - (setq s (1+ (match-beginning 0)) - n (string-to-number (match-string 1 value))) - (and (>= (length args) n) - (setq value (replace-match (nth (1- n) args) t t value))))) + (setq s (1+ (match-beginning 0)) + n (string-to-number (match-string 1 value))) + (and (>= (length args) n) + (setq value (replace-match (nth (1- n) args) t t value))))) ;; VALUE starts with "(eval": it is a s-exp, `eval' it. (when (string-match "\\`(eval\\>" value) (setq value (eval (read value)))) @@ -2346,7 +2346,7 @@ INFO is a plist holding export options." ;; (`:code-refs' property). (defun org-export-handle-code (code switches info - &optional language num-fmt ref-fmt) + &optional language num-fmt ref-fmt) "Handle line numbers and code references in CODE. CODE is the string to process. SWITCHES is the option string @@ -2367,90 +2367,90 @@ and `:code-refs'. Return new code as a string." (let* ((switches (or switches "")) - (numberp (string-match "[-+]n\\>" switches)) - (continuep (string-match "\\+n\\>" switches)) - (total-LOC (if (and numberp (not continuep)) - 0 - (or (plist-get info :total-loc) 0))) - (preserve-indent-p (or org-src-preserve-indentation - (string-match "-i\\>" switches))) - (replace-labels (when (string-match "-r\\>" switches) - (if (string-match "-k\\>" switches) 'keep t))) - ;; Get code and clean it. Remove blank lines at its - ;; beginning and end. Also remove protective commas. - (code (let ((c (replace-regexp-in-string - "\\`\\([ \t]*\n\\)+" "" - (replace-regexp-in-string - "\\(:?[ \t]*\n\\)*[ \t]*\\'" "\n" code)))) - ;; If appropriate, remove global indentation. - (unless preserve-indent-p (setq c (org-remove-indentation c))) - ;; Free up the protected lines. Note: Org blocks - ;; have commas at the beginning or every line. - (if (string= language "org") - (replace-regexp-in-string "^," "" c) - (replace-regexp-in-string - "^\\(,\\)\\(:?\\*\\|[ \t]*#\\+\\)" "" c nil nil 1)))) - ;; Split code to process it line by line. - (code-lines (org-split-string code "\n")) - ;; Ensure line numbers will be correctly padded before - ;; applying the format string. - (num-fmt (format (if (stringp num-fmt) num-fmt "%s: ") - (format "%%%ds" - (length (number-to-string - (+ (length code-lines) - total-LOC)))))) - ;; Get format used for references. - (label-fmt (or (and (string-match "-l +\"\\([^\"\n]+\\)\"" switches) - (match-string 1 switches)) - org-coderef-label-format)) - ;; Build a regexp matching a loc with a reference. - (with-ref-re (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$" - (replace-regexp-in-string - "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t))) - coderefs) + (numberp (string-match "[-+]n\\>" switches)) + (continuep (string-match "\\+n\\>" switches)) + (total-LOC (if (and numberp (not continuep)) + 0 + (or (plist-get info :total-loc) 0))) + (preserve-indent-p (or org-src-preserve-indentation + (string-match "-i\\>" switches))) + (replace-labels (when (string-match "-r\\>" switches) + (if (string-match "-k\\>" switches) 'keep t))) + ;; Get code and clean it. Remove blank lines at its + ;; beginning and end. Also remove protective commas. + (code (let ((c (replace-regexp-in-string + "\\`\\([ \t]*\n\\)+" "" + (replace-regexp-in-string + "\\(:?[ \t]*\n\\)*[ \t]*\\'" "\n" code)))) + ;; If appropriate, remove global indentation. + (unless preserve-indent-p (setq c (org-remove-indentation c))) + ;; Free up the protected lines. Note: Org blocks + ;; have commas at the beginning or every line. + (if (string= language "org") + (replace-regexp-in-string "^," "" c) + (replace-regexp-in-string + "^\\(,\\)\\(:?\\*\\|[ \t]*#\\+\\)" "" c nil nil 1)))) + ;; Split code to process it line by line. + (code-lines (org-split-string code "\n")) + ;; Ensure line numbers will be correctly padded before + ;; applying the format string. + (num-fmt (format (if (stringp num-fmt) num-fmt "%s: ") + (format "%%%ds" + (length (number-to-string + (+ (length code-lines) + total-LOC)))))) + ;; Get format used for references. + (label-fmt (or (and (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches)) + org-coderef-label-format)) + ;; Build a regexp matching a loc with a reference. + (with-ref-re (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$" + (replace-regexp-in-string + "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t))) + coderefs) (org-element-normalize-string (mapconcat (lambda (loc) - ;; Maybe add line number to current line of code - ;; (LOC). - (when numberp - (setq loc (concat (format num-fmt (incf total-LOC)) loc))) - ;; Take action if at a ref line. - (when (string-match with-ref-re loc) - (let ((ref (match-string 3 loc))) - (setq loc - (cond - ;; Option "-k": don't remove labels. Use - ;; numbers for references when lines are - ;; numbered, use labels otherwise. - ((eq replace-labels 'keep) - (let ((full-ref (format "(%s)" ref))) - (push (cons ref (if numberp total-LOC full-ref)) - coderefs) - (replace-match full-ref nil nil loc 2)) - (replace-match (format "(%s)" ref) nil nil loc 2)) - ;; Option "-r" without "-k": remove labels. - ;; Use numbers for references when lines are - ;; numbered, use labels otherwise. - (replace-labels - (push (cons ref (if numberp total-LOC ref)) - coderefs) - (replace-match "" nil nil loc 1)) - ;; Else: don't remove labels and don't use - ;; numbers for references. - (t - (let ((full-ref (format "(%s)" ref))) - (push (cons ref full-ref) coderefs) - (replace-match full-ref nil nil loc 2))))))) - ;; If REF-FMT is defined, apply it to current LOC. - (when (stringp ref-fmt) (setq loc (format ref-fmt loc))) - ;; Update by side-effect communication channel. - ;; Return updated LOC. - (setq info (org-export-set-property - (org-export-set-property - info :code-refs coderefs) - :total-loc total-LOC)) - loc) - code-lines "\n")))) + ;; Maybe add line number to current line of code + ;; (LOC). + (when numberp + (setq loc (concat (format num-fmt (incf total-LOC)) loc))) + ;; Take action if at a ref line. + (when (string-match with-ref-re loc) + (let ((ref (match-string 3 loc))) + (setq loc + (cond + ;; Option "-k": don't remove labels. Use + ;; numbers for references when lines are + ;; numbered, use labels otherwise. + ((eq replace-labels 'keep) + (let ((full-ref (format "(%s)" ref))) + (push (cons ref (if numberp total-LOC full-ref)) + coderefs) + (replace-match full-ref nil nil loc 2)) + (replace-match (format "(%s)" ref) nil nil loc 2)) + ;; Option "-r" without "-k": remove labels. + ;; Use numbers for references when lines are + ;; numbered, use labels otherwise. + (replace-labels + (push (cons ref (if numberp total-LOC ref)) + coderefs) + (replace-match "" nil nil loc 1)) + ;; Else: don't remove labels and don't use + ;; numbers for references. + (t + (let ((full-ref (format "(%s)" ref))) + (push (cons ref full-ref) coderefs) + (replace-match full-ref nil nil loc 2))))))) + ;; If REF-FMT is defined, apply it to current LOC. + (when (stringp ref-fmt) (setq loc (format ref-fmt loc))) + ;; Update by side-effect communication channel. + ;; Return updated LOC. + (setq info (org-export-set-property + (org-export-set-property + info :code-refs coderefs) + :total-loc total-LOC)) + loc) + code-lines "\n")))) ;;;; For Tables @@ -2470,20 +2470,20 @@ Return a plist whose properties and values are: `:row-groups' list of integers representing row groups. `:special-column-p' non-nil if table has a special column. `:width' vector of integers representing desired width of - current column, or nil." + current column, or nil." (with-temp-buffer (insert table) (goto-char 1) (org-table-align) (let ((align (vconcat (mapcar (lambda (c) (if c "r" "l")) - org-table-last-alignment))) - (width (make-vector (length org-table-last-alignment) nil)) + org-table-last-alignment))) + (width (make-vector (length org-table-last-alignment) nil)) (colgroups (make-vector (length org-table-last-alignment) nil)) (row-group 0) (rowgroups) - (special-column-p 'empty)) + (special-column-p 'empty)) (mapc (lambda (row) - (if (string-match "^[ \t]*|[-+]+|[ \t]*$" row) + (if (string-match "^[ \t]*|[-+]+|[ \t]*$" row) (incf row-group) (push row-group rowgroups) ;; Determine if a special column is present by looking @@ -2491,40 +2491,40 @@ Return a plist whose properties and values are: ;; accurately, the first column is considered special ;; if it only contains special markers and, maybe, ;; empty cells. - (setq special-column-p - (cond - ((not special-column-p) nil) - ((string-match "^[ \t]*| *\\\\?\\([\#!$*_^]\\) *|" - row) 'special) - ((string-match "^[ \t]*| +|" row) special-column-p)))) - (cond + (setq special-column-p + (cond + ((not special-column-p) nil) + ((string-match "^[ \t]*| *\\\\?\\([\#!$*_^]\\) *|" + row) 'special) + ((string-match "^[ \t]*| +|" row) special-column-p)))) + (cond ;; Read forced alignment and width information, if any, ;; and determine final alignment for the table. - ((org-table-cookie-line-p row) - (let ((col 0)) - (mapc (lambda (field) - (when (string-match "<\\([lrc]\\)\\([0-9]+\\)?>" field) - (aset align col (match-string 1 field)) + ((org-table-cookie-line-p row) + (let ((col 0)) + (mapc (lambda (field) + (when (string-match "<\\([lrc]\\)\\([0-9]+\\)?>" field) + (aset align col (match-string 1 field)) (aset width col (let ((w (match-string 2 field))) (and w (string-to-number w))))) - (incf col)) - (org-split-string row "[ \t]*|[ \t]*")))) - ;; Read column groups information. - ((org-table-colgroup-line-p row) - (let ((col 0)) - (mapc (lambda (field) - (aset colgroups col - (cond ((string= "<" field) 'start) - ((string= ">" field) 'end) - ((string= "<>" field) 'start-end))) - (incf col)) - (org-split-string row "[ \t]*|[ \t]*")))))) - (org-split-string table "\n")) + (incf col)) + (org-split-string row "[ \t]*|[ \t]*")))) + ;; Read column groups information. + ((org-table-colgroup-line-p row) + (let ((col 0)) + (mapc (lambda (field) + (aset colgroups col + (cond ((string= "<" field) 'start) + ((string= ">" field) 'end) + ((string= "<>" field) 'start-end))) + (incf col)) + (org-split-string row "[ \t]*|[ \t]*")))))) + (org-split-string table "\n")) ;; Return plist. (list :alignment align - :column-groups colgroups + :column-groups colgroups :row-groups (reverse rowgroups) - :special-column-p (eq special-column-p 'special) + :special-column-p (eq special-column-p 'special) :width width)))) (defun org-export-clean-table (table specialp) @@ -2535,22 +2535,22 @@ assume the table contains a special formatting column and remove it also." (let ((rows (org-split-string table "\n"))) (mapconcat 'identity - (delq nil - (mapcar - (lambda (row) - (cond - ((org-table-colgroup-line-p row) nil) - ((org-table-cookie-line-p row) nil) - ;; Ignore rows starting with a special marker. - ((string-match "^[ \t]*| *[!_^/] *|" row) nil) - ;; Remove special column. - ((and specialp - (or (string-match "^\\([ \t]*\\)|-+\\+" row) - (string-match "^\\([ \t]*\\)|[^|]*|" row))) - (replace-match "\\1|" t nil row)) - (t row))) - rows)) - "\n"))) + (delq nil + (mapcar + (lambda (row) + (cond + ((org-table-colgroup-line-p row) nil) + ((org-table-cookie-line-p row) nil) + ;; Ignore rows starting with a special marker. + ((string-match "^[ \t]*| *[!_^/] *|" row) nil) + ;; Remove special column. + ((and specialp + (or (string-match "^\\([ \t]*\\)|-+\\+" row) + (string-match "^\\([ \t]*\\)|[^|]*|" row))) + (replace-match "\\1|" t nil row)) + (t row))) + rows)) + "\n"))) ;;;; For Tables Of Contents @@ -2599,13 +2599,13 @@ the function will return: (lambda (headline local-info) ;; Get HEADLINE's relative level. (let ((level (+ (or (plist-get local-info :headline-offset) 0) - (org-element-get-property :level headline)))) + (org-element-get-property :level headline)))) (unless (and (wholenump n) (> level n)) - (list - (org-export-secondary-string - (org-element-get-property :title headline) backend info) - level - (org-element-get-property :begin headline))))) + (list + (org-export-secondary-string + (org-element-get-property :title headline) backend info) + level + (org-element-get-property :begin headline))))) info)) (defun org-export-collect-elements (type backend info) @@ -2623,13 +2623,13 @@ identifier that might be used for internal links." type (lambda (element info) (let ((entry - (cond - ((org-element-get-property :caption element) - (org-export-secondary-string - (org-element-get-property :caption element) backend info)) - ((org-element-get-property :name element) - (org-export-secondary-string - (org-element-get-property :name element) backend info))))) + (cond + ((org-element-get-property :caption element) + (org-export-secondary-string + (org-element-get-property :caption element) backend info)) + ((org-element-get-property :name element) + (org-export-secondary-string + (org-element-get-property :name element) backend info))))) ;; Skip elements with neither a caption nor a name. (when entry (cons entry (org-element-get-property :begin element))))) info))