diff options
Diffstat (limited to 'lisp')
63 files changed, 3783 insertions, 2677 deletions
diff --git a/lisp/ob-C.el b/lisp/ob-C.el index b1e8a06..e9eec93 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -44,24 +44,24 @@ (defvar org-babel-C-compiler "gcc" "Command used to compile a C source code file into an - executable.") +executable.") (defvar org-babel-C++-compiler "g++" "Command used to compile a C++ source code file into an - executable.") +executable.") (defvar org-babel-c-variant nil "Internal variable used to hold which type of C (e.g. C or C++) is currently being evaluated.") (defun org-babel-execute:cpp (body params) - "Execute BODY according to PARAMS. This function calls -`org-babel-execute:C++'." + "Execute BODY according to PARAMS. +This function calls `org-babel-execute:C++'." (org-babel-execute:C++ body params)) (defun org-babel-execute:C++ (body params) - "Execute a block of C++ code with org-babel. This function is -called by `org-babel-execute-src-block'." + "Execute a block of C++ code with org-babel. +This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) (defun org-babel-expand-body:C++ (body params) @@ -70,8 +70,8 @@ header arguments (calls `org-babel-C-expand')." (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params))) (defun org-babel-execute:C (body params) - "Execute a block of C code with org-babel. This function is -called by `org-babel-execute-src-block'." + "Execute a block of C code with org-babel. +This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) (defun org-babel-expand-body:c (body params) @@ -146,10 +146,10 @@ it's header arguments." body) "\n") "\n"))) (defun org-babel-C-ensure-main-wrap (body) - "Wrap body in a \"main\" function call if none exists." + "Wrap BODY in a \"main\" function call if none exists." (if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body) body - (format "int main() {\n%s\nreturn(0);\n}\n" body))) + (format "int main() {\n%s\nreturn 0;\n}\n" body))) (defun org-babel-prep-session:C (session params) "This function does nothing as C is a compiled language with no @@ -163,6 +163,59 @@ support for sessions" ;; helper functions +(defun org-babel-C-format-val (type val) + "Handle the FORMAT part of TYPE with the data from VAL." + (let ((format-data (cadr type))) + (if (stringp format-data) + (cons "" (format format-data val)) + (funcall format-data val)))) + +(defun org-babel-C-val-to-C-type (val) + "Determine the type of VAL. +Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type. +FORMAT can be either a format string or a function which is called with VAL." + (cond + ((integerp val) '("int" "%d")) + ((floatp val) '("double" "%f")) + ((or (listp val) (vectorp val)) + (lexical-let ((type (org-babel-C-val-to-C-list-type val))) + (list (car type) + (lambda (val) + (cons + (format "[%d]%s" + (length val) + (car (org-babel-C-format-val type (elt val 0)))) + (concat "{ " + (mapconcat (lambda (v) + (cdr (org-babel-C-format-val type v))) + val + ", ") + " }")))))) + (t ;; treat unknown types as string + '("char" (lambda (val) + (let ((s (format "%s" val))) ;; convert to string for unknown types + (cons (format "[%d]" (1+ (length s))) + (concat "\"" s "\"")))))))) + +(defun org-babel-C-val-to-C-list-type (val) + "Determine the C array type of a VAL." + (let (type) + (mapc + #'(lambda (i) + (let* ((tmp-type (org-babel-C-val-to-C-type i)) + (type-name (car type)) + (tmp-type-name (car tmp-type))) + (when (and type (not (string= type-name tmp-type-name))) + (if (and (member type-name '("int" "double" "int32_t")) + (member tmp-type-name '("int" "double" "int32_t"))) + (setq tmp-type '("double" "" "%f")) + (error "Only homogeneous lists are supported by C. You can not mix %s and %s" + type-name + tmp-type-name))) + (setq type tmp-type))) + val) + type)) + (defun org-babel-C-var-to-C (pair) "Convert an elisp val into a string of C code specifying a var of the same value." @@ -173,22 +226,17 @@ of the same value." (setq val (symbol-name val)) (when (= (length val) 1) (setq val (string-to-char val)))) - (cond - ((integerp val) - (format "int %S = %S;" var val)) - ((floatp val) - (format "double %S = %S;" var val)) - ((or (integerp val)) - (format "char %S = '%S';" var val)) - ((stringp val) - (format "char %S[%d] = \"%s\";" - var (+ 1 (length val)) val)) - (t - (format "u32 %S = %S;" var val))))) - + (let* ((type-data (org-babel-C-val-to-C-type val)) + (type (car type-data)) + (formated (org-babel-C-format-val type-data val)) + (suffix (car formated)) + (data (cdr formated))) + (format "%s %s%s = %s;" + type + var + suffix + data)))) (provide 'ob-C) - - ;;; ob-C.el ends here diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 67d3c37..74d7513 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -93,8 +93,13 @@ inside (list "dev.off()")) inside)) - (append (org-babel-variable-assignments:R params) - (list body))) "\n"))) + (append + (when (cdr (assoc :prologue params)) + (list (cdr (assoc :prologue params)))) + (org-babel-variable-assignments:R params) + (list body) + (when (cdr (assoc :epilogue params)) + (list (cdr (assoc :epilogue params)))))) "\n"))) (defun org-babel-execute:R (body params) "Execute a block of R code. @@ -234,31 +239,40 @@ current code buffer." (and (member "graphics" (cdr (assq :result-params params))) (cdr (assq :file params)))) +(defvar org-babel-R-graphics-devices + '((:bmp "bmp" "filename") + (:jpg "jpeg" "filename") + (:jpeg "jpeg" "filename") + (:tikz "tikz" "file") + (:tiff "tiff" "filename") + (:png "png" "filename") + (:svg "svg" "file") + (:pdf "pdf" "file") + (:ps "postscript" "file") + (:postscript "postscript" "file")) + "An alist mapping graphics file types to R functions. + +Each member of this list is a list with three members: +1. the file extension of the graphics file, as an elisp :keyword +2. the R graphics device function to call to generate such a file +3. the name of the argument to this function which specifies the + file to write to (typically \"file\" or \"filename\")") + (defun org-babel-R-construct-graphics-device-call (out-file params) "Construct the call to the graphics device." - (let ((devices - '((:bmp . "bmp") - (:jpg . "jpeg") - (:jpeg . "jpeg") - (:tikz . "tikz") - (:tiff . "tiff") - (:png . "png") - (:svg . "svg") - (:pdf . "pdf") - (:ps . "postscript") - (:postscript . "postscript"))) - (allowed-args '(:width :height :bg :units :pointsize - :antialias :quality :compression :res - :type :family :title :fonts :version - :paper :encoding :pagecentre :colormodel - :useDingbats :horizontal)) - (device (and (string-match ".+\\.\\([^.]+\\)" out-file) - (match-string 1 out-file))) - (extra-args (cdr (assq :R-dev-args params))) filearg args) - (setq device (or (and device (cdr (assq (intern (concat ":" device)) - devices))) "png")) - (setq filearg - (if (member device '("pdf" "postscript" "svg" "tikz")) "file" "filename")) + (let* ((allowed-args '(:width :height :bg :units :pointsize + :antialias :quality :compression :res + :type :family :title :fonts :version + :paper :encoding :pagecentre :colormodel + :useDingbats :horizontal)) + (device (and (string-match ".+\\.\\([^.]+\\)" out-file) + (match-string 1 out-file))) + (device-info (or (assq (intern (concat ":" device)) + org-babel-R-graphics-devices) + (assq :png org-babel-R-graphics-devices))) + (extra-args (cdr (assq :R-dev-args params))) filearg args) + (setq device (nth 1 device-info)) + (setq filearg (nth 2 device-info)) (setq args (mapconcat (lambda (pair) (if (member (car pair) allowed-args) diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index f156297..8b03e2d 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -117,7 +117,7 @@ or user `keyboard-quit' during execution of body." string-buffer)) (setq raw (substring string-buffer (match-end 0)))) (split-string string-buffer comint-prompt-regexp))))) -(def-edebug-spec org-babel-comint-with-output (form body)) +(def-edebug-spec org-babel-comint-with-output (sexp body)) (defun org-babel-comint-input-command (buffer cmd) "Pass CMD to BUFFER. diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 721c378..cc6b7a9 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -1,6 +1,6 @@ ;;; ob-core.el --- working with code blocks in org-mode -;; Copyright (C) 2009-2012 Free Software Foundation, Inc. +;; Copyright (C) 2009-2013 Free Software Foundation, Inc. ;; Authors: Eric Schulte ;; Dan Davison @@ -95,6 +95,7 @@ (declare-function org-unescape-code-in-string "org-src" (s)) (declare-function org-table-to-lisp "org-table" (&optional txt)) (declare-function org-reverse-string "org" (string)) +(declare-function org-element-context "org-element" (&optional ELEMENT)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -152,6 +153,12 @@ See also `org-babel-noweb-wrap-start'." :group 'org-babel :type 'string) +(defcustom org-babel-inline-result-wrap "=%s=" + "Format string used to wrap inline results. +This string must include a \"%s\" which will be replaced by the results." + :group 'org-babel + :type 'string) + (defun org-babel-noweb-wrap (&optional regexp) (concat org-babel-noweb-wrap-start (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") @@ -182,7 +189,7 @@ See also `org-babel-noweb-wrap-start'." ;; (4) header arguments "\\([^\n]*\\)\n" ;; (5) body - "\\([^\000]*?\n\\)?[ \t]*#\\+end_src") + "\\([^\000]*?\n\\)??[ \t]*#\\+end_src") "Regexp used to identify code blocks.") (defvar org-babel-inline-src-block-regexp @@ -245,7 +252,7 @@ references; a process which could likely result in the execution of other code blocks. Returns a list - (language body header-arguments-alist switches name indent)." + (language body header-arguments-alist switches name indent block-head)." (let ((case-fold-search t) head info name indent) ;; full code block (if (setq head (org-babel-where-is-src-block-head)) @@ -268,7 +275,7 @@ Returns a list ;; resolve variable references and add summary parameters (when (and info (not light)) (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) - (when info (append info (list name indent))))) + (when info (append info (list name indent head))))) (defvar org-current-export-file) ; dynamically bound (defmacro org-babel-check-confirm-evaluate (info &rest body) @@ -438,6 +445,7 @@ then run `org-babel-switch-to-session'." (dir . :any) (eval . ((never query))) (exports . ((code results both none))) + (epilogue . :any) (file . :any) (file-desc . :any) (hlines . ((no yes))) @@ -449,6 +457,7 @@ then run `org-babel-switch-to-session'." (noweb-sep . :any) (padline . ((yes no))) (post . :any) + (prologue . :any) (results . ((file list vector table scalar verbatim) (raw html latex org code pp drawer) (replace silent none append prepend) @@ -458,6 +467,7 @@ then run `org-babel-switch-to-session'." (session . :any) (shebang . :any) (tangle . ((tangle yes no :any))) + (tangle-mode . ((#o755 #o555 #o444 :any))) (var . :any) (wrap . :any))) @@ -469,8 +479,7 @@ specific header arguments as well.") (defvar org-babel-default-header-args '((:session . "none") (:results . "replace") (:exports . "code") - (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no") - (:padnewline . "yes")) + (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) "Default arguments to use when evaluating a source block.") (defvar org-babel-default-inline-header-args @@ -529,6 +538,12 @@ can not be resolved.") ;;; functions (defvar call-process-region) +(defvar org-babel-current-src-block-location nil + "Marker pointing to the src block currently being executed. +This may also point to a call line or an inline code block. If +multiple blocks are being executed (e.g., in chained execution +through use of the :var header argument) this marker points to +the outer-most code block.") ;;;###autoload (defun org-babel-execute-src-block (&optional arg info params) @@ -547,7 +562,11 @@ Optionally supply a value for PARAMS which will be merged with the header arguments specified at the front of the source code block." (interactive) - (let* ((info (if info + (let* ((org-babel-current-src-block-location + (or org-babel-current-src-block-location + (nth 6 info) + (org-babel-where-is-src-block-head))) + (info (if info (copy-tree info) (org-babel-get-src-block-info))) (merged-params (org-babel-merge-params (nth 2 info) params))) @@ -586,7 +605,7 @@ block." (or (org-bound-and-true-p org-babel-call-process-region-original) (symbol-function 'call-process-region))) - (indent (car (last info))) + (indent (nth 5 info)) result cmd) (unwind-protect (let ((call-process-region @@ -610,7 +629,8 @@ block." (if (member "none" result-params) (progn (funcall cmd body params) - (message "result silenced")) + (message "result silenced") + (setq result nil)) (setq result ((lambda (result) (if (and (eq (cdr (assoc :result-type params)) @@ -643,9 +663,9 @@ block." (setq result-params (remove "file" result-params))))) (org-babel-insert-result - result result-params info new-hash indent lang) - (run-hooks 'org-babel-after-execute-hook) - result)) + result result-params info new-hash indent lang)) + (run-hooks 'org-babel-after-execute-hook) + result) (setq call-process-region 'org-babel-call-process-region-original))))))))) @@ -655,7 +675,14 @@ Expand a block of code with org-babel according to its header arguments. This generic implementation of body expansion is called for languages which have not defined their own specific org-babel-expand-body:lang function." - (mapconcat #'identity (append var-lines (list body)) "\n")) + (let ((pro (cdr (assoc :prologue params))) + (epi (cdr (assoc :epilogue params)))) + (mapconcat #'identity + (append (when pro (list pro)) + var-lines + (list body) + (when epi (list epi))) + "\n"))) ;;;###autoload (defun org-babel-expand-src-block (&optional arg info params) @@ -750,7 +777,7 @@ arguments and pop open the results in a preview buffer." (lang-headers (intern (concat "org-babel-header-args:" lang))) (headers (org-babel-combine-header-arg-lists org-babel-common-header-args-w-values - (if (boundp lang-headers) (eval lang-headers) nil))) + (when (boundp lang-headers) (eval lang-headers)))) (arg (org-icompleting-read "Header Arg: " (mapcar @@ -911,6 +938,10 @@ evaluation mechanisms." (defvar org-bracket-link-regexp) +(defun org-babel-active-location-p () + (memq (car (save-match-data (org-element-context))) + '(babel-call inline-babel-call inline-src-block src-block))) + ;;;###autoload (defun org-babel-open-src-block-result (&optional re-run) "If `point' is on a src block then open the results of the @@ -918,7 +949,7 @@ source code block, otherwise return nil. With optional prefix argument RE-RUN the source-code block is evaluated even if results already exist." (interactive "P") - (let ((info (org-babel-get-src-block-info))) + (let ((info (org-babel-get-src-block-info 'light))) (when info (save-excursion ;; go to the results, if there aren't any then run the block @@ -971,24 +1002,25 @@ end-body --------- point at the end of the body" (setq to-be-removed (current-buffer)) (goto-char (point-min)) (while (re-search-forward org-babel-src-block-regexp nil t) - (goto-char (match-beginning 0)) - (let ((full-block (match-string 0)) - (beg-block (match-beginning 0)) - (end-block (match-end 0)) - (lang (match-string 2)) - (beg-lang (match-beginning 2)) - (end-lang (match-end 2)) - (switches (match-string 3)) - (beg-switches (match-beginning 3)) - (end-switches (match-end 3)) - (header-args (match-string 4)) - (beg-header-args (match-beginning 4)) - (end-header-args (match-end 4)) - (body (match-string 5)) - (beg-body (match-beginning 5)) - (end-body (match-end 5))) - ,@body - (goto-char end-block)))) + (when (org-babel-active-location-p) + (goto-char (match-beginning 0)) + (let ((full-block (match-string 0)) + (beg-block (match-beginning 0)) + (end-block (match-end 0)) + (lang (match-string 2)) + (beg-lang (match-beginning 2)) + (end-lang (match-end 2)) + (switches (match-string 3)) + (beg-switches (match-beginning 3)) + (end-switches (match-end 3)) + (header-args (match-string 4)) + (beg-header-args (match-beginning 4)) + (end-header-args (match-end 4)) + (body (match-string 5)) + (beg-body (match-beginning 5)) + (end-body (match-end 5))) + ,@body + (goto-char end-block))))) (unless visited-p (kill-buffer to-be-removed)) (goto-char point)))) (def-edebug-spec org-babel-map-src-blocks (form body)) @@ -1009,8 +1041,9 @@ buffer." (setq to-be-removed (current-buffer)) (goto-char (point-min)) (while (re-search-forward org-babel-inline-src-block-regexp nil t) - (goto-char (match-beginning 1)) - (save-match-data ,@body) + (when (org-babel-active-location-p) + (goto-char (match-beginning 1)) + (save-match-data ,@body)) (goto-char (match-end 0)))) (unless visited-p (kill-buffer to-be-removed)) (goto-char point)))) @@ -1034,8 +1067,9 @@ buffer." (setq to-be-removed (current-buffer)) (goto-char (point-min)) (while (re-search-forward org-babel-lob-one-liner-regexp nil t) - (goto-char (match-beginning 1)) - (save-match-data ,@body) + (when (org-babel-active-location-p) + (goto-char (match-beginning 1)) + (save-match-data ,@body)) (goto-char (match-end 0)))) (unless visited-p (kill-buffer to-be-removed)) (goto-char point)))) @@ -1058,9 +1092,11 @@ buffer." (setq to-be-removed (current-buffer)) (goto-char (point-min)) (while (re-search-forward ,rx nil t) - (goto-char (match-beginning 1)) - (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1)) - (save-match-data ,@body) + (when (org-babel-active-location-p) + (goto-char (match-beginning 1)) + (when (looking-at org-babel-inline-src-block-regexp) + (forward-char 1)) + (save-match-data ,@body)) (goto-char (match-end 0)))) (unless visited-p (kill-buffer to-be-removed)) (goto-char point)))) @@ -1142,9 +1178,12 @@ the current subtree." (defun org-babel-set-current-result-hash (hash) "Set the current in-buffer hash to HASH." (org-babel-where-is-src-block-result) - (save-excursion (goto-char (match-beginning 3)) - ;; (mapc #'delete-overlay (overlays-at (point))) - (replace-match hash nil nil nil 3) + (save-excursion (goto-char (match-beginning 5)) + (mapc #'delete-overlay (overlays-at (point))) + (forward-char org-babel-hash-show) + (mapc #'delete-overlay (overlays-at (point))) + (replace-match hash nil nil nil 5) + (goto-char (point-at-bol)) (org-babel-hide-hash))) (defun org-babel-hide-hash () @@ -1275,26 +1314,38 @@ portions of results lines." (defvar org-file-properties) (defun org-babel-params-from-properties (&optional lang) "Retrieve parameters specified as properties. -Return an association list of any source block params which -may be specified in the properties of the current outline entry." +Return a list of association lists of source block params +specified in the properties of the current outline entry." (save-match-data - (let (val sym) - (org-babel-parse-multiple-vars - (delq nil - (mapcar - (lambda (header-arg) - (and (setq val (org-entry-get (point) header-arg t)) - (cons (intern (concat ":" header-arg)) - (org-babel-read val)))) + (list + ;; DEPRECATED header arguments specified as separate property at + ;; point of definition + (let (val sym) + (org-babel-parse-multiple-vars + (delq nil (mapcar - #'symbol-name + (lambda (header-arg) + (and (setq val (org-entry-get (point) header-arg t)) + (cons (intern (concat ":" header-arg)) + (org-babel-read val)))) (mapcar - #'car - (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values - (progn - (setq sym (intern (concat "org-babel-header-args:" lang))) - (and (boundp sym) (eval sym)))))))))))) + #'symbol-name + (mapcar + #'car + (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (progn + (setq sym (intern (concat "org-babel-header-args:" lang))) + (and (boundp sym) (eval sym)))))))))) + ;; header arguments specified with the header-args property at + ;; point of call + (org-babel-parse-header-arguments + (org-entry-get org-babel-current-src-block-location + "header-args" 'inherit)) + (when lang ;; language-specific header arguments at point of call + (org-babel-parse-header-arguments + (org-entry-get org-babel-current-src-block-location + (concat "header-args:" lang) 'inherit)))))) (defvar org-src-preserve-indentation) (defun org-babel-parse-src-block-match () @@ -1320,12 +1371,13 @@ may be specified in the properties of the current outline entry." (insert (org-unescape-code-in-string body)) (unless preserve-indentation (org-do-remove-indentation)) (buffer-string))) - (org-babel-merge-params - org-babel-default-header-args - (org-babel-params-from-properties lang) - (if (boundp lang-headers) (eval lang-headers) nil) - (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) "")))) + (apply #'org-babel-merge-params + org-babel-default-header-args + (when (boundp lang-headers) (eval lang-headers)) + (append + (org-babel-params-from-properties lang) + (list (org-babel-parse-header-arguments + (org-no-properties (or (match-string 4) "")))))) switches block-indentation))) @@ -1335,12 +1387,13 @@ may be specified in the properties of the current outline entry." (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) (list lang (org-unescape-code-in-string (org-no-properties (match-string 5))) - (org-babel-merge-params - org-babel-default-inline-header-args - (org-babel-params-from-properties lang) - (if (boundp lang-headers) (eval lang-headers) nil) - (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) ""))))))) + (apply #'org-babel-merge-params + org-babel-default-inline-header-args + (if (boundp lang-headers) (eval lang-headers) nil) + (append + (org-babel-params-from-properties lang) + (list (org-babel-parse-header-arguments + (org-no-properties (or (match-string 4) ""))))))))) (defun org-babel-balanced-split (string alts) "Split STRING on instances of ALTS. @@ -1581,7 +1634,7 @@ If the point is not on a source block then return nil." (< top initial) (< initial bottom) (progn (goto-char top) (beginning-of-line 1) (looking-at org-babel-src-block-regexp)) - (point)))))) + (point-marker)))))) ;;;###autoload (defun org-babel-goto-src-block-head () @@ -1676,7 +1729,8 @@ buffer or nil if no such result exists." (when (and (string= "name" (downcase (match-string 1))) (or (beginning-of-line 1) (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp))) + (looking-at org-babel-multi-line-header-regexp) + (looking-at org-babel-lob-one-liner-regexp))) (throw 'is-a-code-block (org-babel-find-named-result name (point)))) (beginning-of-line 0) (point)))))) @@ -1753,9 +1807,13 @@ region is not active then the point is demarcated." (move-end-of-line 2)) (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>)) (let ((start (point)) - (lang (org-icompleting-read "Lang: " - (mapcar (lambda (el) (symbol-name (car el))) - org-babel-load-languages))) + (lang (org-icompleting-read + "Lang: " + (mapcar #'symbol-name + (delete-dups + (append (mapcar #'car org-babel-load-languages) + (mapcar (lambda (el) (intern (car el))) + org-src-lang-modes)))))) (body (delete-and-extract-region (if (org-region-active-p) (mark) (point)) (point)))) (insert (concat (if (looking-at "^") "" "\n") @@ -1781,10 +1839,7 @@ following the source block." (looking-at org-babel-lob-one-liner-regexp))) (inlinep (when (org-babel-get-inline-src-block-matches) (match-end 0))) - (name (if on-lob-line - (mapconcat #'identity (butlast (org-babel-lob-get-info)) - "") - (nth 4 (or info (org-babel-get-src-block-info 'light))))) + (name (nth 4 (or info (org-babel-get-src-block-info 'light)))) (head (unless on-lob-line (org-babel-where-is-src-block-head))) found beg end) (when head (goto-char head)) @@ -1860,14 +1915,14 @@ following the source block." ((org-at-item-p) (org-babel-read-list)) ((looking-at org-bracket-link-regexp) (org-babel-read-link)) ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) - ((looking-at "^[ \t]*: ") + ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$")) (setq result-string (org-babel-trim (mapconcat (lambda (line) - (if (and (> (length line) 1) - (string-match "^[ \t]*: \\(.+\\)" line)) - (match-string 1 line) - line)) + (or (and (> (length line) 1) + (string-match "^[ \t]*: ?\\(.+\\)" line) + (match-string 1 line)) + "")) (split-string (buffer-substring (point) (org-babel-result-end)) "[\r\n]+") @@ -2131,7 +2186,7 @@ code ---- the results are extracted in the syntax of the source (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1)) nil t) (forward-char 1)) - (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") + (while (looking-at "[ \t]*\\(: \\|:$\\|\\[\\[\\)") (forward-line 1)))) (point))))) @@ -2164,8 +2219,9 @@ file's directory then expand relative links." (funcall chars-between end (save-excursion (goto-char end) (point-at-eol)))) (save-excursion (goto-char beg) - (insert (format "=%s=" (prog1 (buffer-substring beg end) - (delete-region beg end))))) + (insert (format org-babel-inline-result-wrap + (prog1 (buffer-substring beg end) + (delete-region beg end))))) (let ((size (count-lines beg end))) (save-excursion (cond ((= size 0)) ; do nothing for an empty result @@ -2222,7 +2278,8 @@ parameters when merging lists." new-params)) result-params) output))) - params results exports tangle noweb cache vars shebang comments padline) + params results exports tangle noweb cache vars shebang comments padline + clearnames) (mapc (lambda (plist) @@ -2239,21 +2296,25 @@ parameters when merging lists." (setq vars (append (if (member name (mapcar #'car vars)) - (delq nil - (mapcar - (lambda (p) - (unless (equal (car p) name) p)) - vars)) + (progn + (push name clearnames) + (delq nil + (mapcar + (lambda (p) + (unless (equal (car p) name) p)) + vars))) vars) (list (cons name pair)))) ;; if no name is given and we already have named variables ;; then assign to named variables in order (if (and vars (nth variable-index vars)) - (prog1 (setf (cddr (nth variable-index vars)) - (concat (symbol-name - (car (nth variable-index vars))) - "=" (cdr pair))) - (incf variable-index)) + (let ((name (car (nth variable-index vars)))) + (push name clearnames) ; clear out colnames + ; and rownames + ; for replace vars + (prog1 (setf (cddr (nth variable-index vars)) + (concat (symbol-name name) "=" (cdr pair))) + (incf variable-index))) (error "Variable \"%s\" must be assigned a default value" (cdr pair)))))) (:results @@ -2300,6 +2361,20 @@ parameters when merging lists." plists) (setq vars (reverse vars)) (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) + ;; clear out col-names and row-names for replaced variables + (mapc + (lambda (name) + (mapc + (lambda (param) + (when (assoc param params) + (setf (cdr (assoc param params)) + (org-remove-if (lambda (pair) (equal (car pair) name)) + (cdr (assoc param params)))) + (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param) + (null (cdr pair)))) + params)))) + (list :colname-names :rowname-names))) + clearnames) (mapc (lambda (hd) (let ((key (intern (concat ":" (symbol-name hd)))) @@ -2360,7 +2435,7 @@ would set the value of argument \"a\" equal to \"9\". Note that these arguments are not evaluated in the current source-code block but are passed literally to the \"example-block\"." (let* ((parent-buffer (or parent-buffer (current-buffer))) - (info (or info (org-babel-get-src-block-info))) + (info (or info (org-babel-get-src-block-info 'light))) (lang (nth 0 info)) (body (nth 1 info)) (ob-nww-start org-babel-noweb-wrap-start) @@ -2511,10 +2586,10 @@ block but are passed literally to the \"example-block\"." (defun org-babel-read (cell &optional inhibit-lisp-eval) "Convert the string value of CELL to a number if appropriate. Otherwise if cell looks like lisp (meaning it starts with a -\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, otherwise -return it unmodified as a string. Optional argument NO-LISP-EVAL -inhibits lisp evaluation for situations in which is it not -appropriate." +\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, +otherwise return it unmodified as a string. Optional argument +NO-LISP-EVAL inhibits lisp evaluation for situations in which is +it not appropriate." (if (and (stringp cell) (not (equal cell ""))) (or (org-babel-number-p cell) (if (and (not inhibit-lisp-eval) diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index d3d76e5..60ab8c5 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -58,6 +58,11 @@ :group 'org-babel :type 'string) +(defcustom org-babel-ditaa-java-cmd "java" + "Java executable to use when evaluating ditaa blocks." + :group 'org-babel + :type 'string) + (defcustom org-ditaa-eps-jar-path (expand-file-name "DitaaEps.jar" (file-name-directory org-ditaa-jar-path)) "Path to the DitaaEps.jar executable." @@ -86,7 +91,8 @@ This function is called by `org-babel-execute-src-block'." (java (cdr (assoc :java params))) (in-file (org-babel-temp-file "ditaa-")) (eps (cdr (assoc :eps params))) - (cmd (concat "java " java " " org-ditaa-jar-option " " + (cmd (concat org-babel-ditaa-java-cmd + " " java " " org-ditaa-jar-option " " (shell-quote-argument (expand-file-name (if eps org-ditaa-eps-jar-path org-ditaa-jar-path))) diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el index 681362f..85a8c4e 100644 --- a/lisp/ob-eval.el +++ b/lisp/ob-eval.el @@ -27,6 +27,7 @@ ;; shell commands. ;;; Code: +(require 'org-macs) (eval-when-compile (require 'cl)) (defvar org-babel-error-buffer-name "*Org-Babel Error Output*") diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 1aa9c92..c8479e3 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -122,11 +122,11 @@ Assume point is at the beginning of block's starting line." (org-babel-exp-in-export-file lang (setf (nth 2 info) (org-babel-process-params - (org-babel-merge-params - org-babel-default-header-args - (org-babel-params-from-properties lang) - (if (boundp lang-headers) (eval lang-headers) nil) - raw-params)))) + (apply #'org-babel-merge-params + org-babel-default-header-args + (if (boundp lang-headers) (eval lang-headers) nil) + (append (org-babel-params-from-properties lang) + (list raw-params)))))) (setf hash (org-babel-sha1-hash info))) (org-babel-exp-do-export info 'block hash))))) @@ -206,17 +206,20 @@ this template." (results (org-babel-exp-do-export (list "emacs-lisp" "results" - (org-babel-merge-params - org-babel-default-header-args - org-babel-default-lob-header-args - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-no-properties - (concat ":var results=" - (mapconcat 'identity - (butlast lob-info) - " "))))) - "" nil (car (last lob-info))) + (apply #'org-babel-merge-params + org-babel-default-header-args + org-babel-default-lob-header-args + (append + (org-babel-params-from-properties) + (list + (org-babel-parse-header-arguments + (org-no-properties + (concat + ":var results=" + (mapconcat 'identity + (butlast lob-info 2) + " "))))))) + "" (nth 3 lob-info) (nth 2 lob-info)) 'lob)) (rep (org-fill-template org-babel-exp-call-line-template @@ -387,7 +390,8 @@ inhibit insertion of results into the buffer." (org-babel-expand-noweb-references info (org-babel-exp-get-export-buffer)) (nth 1 info))) - (info (copy-sequence info))) + (info (copy-sequence info)) + (org-babel-current-src-block-location (point-marker))) ;; skip code blocks which we can't evaluate (when (fboundp (intern (concat "org-babel-execute:" lang))) (org-babel-eval-wipe-error-buffer) diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el index 1eab03e..df7bfa0 100644 --- a/lisp/ob-fortran.el +++ b/lisp/ob-fortran.el @@ -32,6 +32,7 @@ (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-every "org" (pred seq)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90")) @@ -143,6 +144,12 @@ of the same value." ((stringp val) (format "character(len=%d), parameter :: %S = '%s'\n" (length val) var val)) + ;; val is a matrix + ((and (listp val) (org-every #'listp val)) + (format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n" + var (length val) (length (car val)) + (org-babel-fortran-transform-list val) + (length (car val)) (length val))) ((listp val) (format "real, parameter :: %S(%d) = %s\n" var (length val) (org-babel-fortran-transform-list val))) diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el index 4b3a1c6..cc9186b 100644 --- a/lisp/ob-gnuplot.el +++ b/lisp/ob-gnuplot.el @@ -52,77 +52,117 @@ '((:results . "file") (:exports . "results") (:session . nil)) "Default arguments to use when evaluating a gnuplot source block.") +(defvar org-babel-header-args:gnuplot + '((title . :any) + (lines . :any) + (sets . :any) + (x-labels . :any) + (y-labels . :any) + (timefmt . :any) + (time-ind . :any) + (missing . :any) + (term . :any)) + "Gnuplot specific header args.") + (defvar org-babel-gnuplot-timestamp-fmt nil) +(defvar *org-babel-gnuplot-missing* nil) + +(defcustom *org-babel-gnuplot-terms* + '((eps . "postscript eps")) + "List of file extensions and the associated gnuplot terminal." + :group 'org-babel + :type '(repeat (cons (symbol :tag "File extension") + (string :tag "Gnuplot terminal")))) + (defun org-babel-gnuplot-process-vars (params) "Extract variables from PARAMS and process the variables. Dumps all vectors into files and returns an association list of variable names and the related value to be used in the gnuplot code." - (mapcar - (lambda (pair) - (cons - (car pair) ;; variable name - (if (listp (cdr pair)) ;; variable value - (org-babel-gnuplot-table-to-data - (cdr pair) (org-babel-temp-file "gnuplot-") params) - (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params)))) + (mapcar + (lambda (pair) + (cons + (car pair) ;; variable name + (if (listp (cdr pair)) ;; variable value + (org-babel-gnuplot-table-to-data + (cdr pair) (org-babel-temp-file "gnuplot-") params) + (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var))))) (defun org-babel-expand-body:gnuplot (body params) "Expand BODY according to PARAMS, return the expanded body." (save-window-excursion (let* ((vars (org-babel-gnuplot-process-vars params)) (out-file (cdr (assoc :file params))) - (term (or (cdr (assoc :term params)) - (when out-file (file-name-extension out-file)))) + (prologue (cdr (assoc :prologue params))) + (epilogue (cdr (assoc :epilogue params))) + (term (or (cdr (assoc :term params)) + (when out-file + (let ((ext (file-name-extension out-file))) + (or (cdr (assoc (intern (downcase ext)) + *org-babel-gnuplot-terms*)) + ext))))) (cmdline (cdr (assoc :cmdline params))) - (title (plist-get params :title)) - (lines (plist-get params :line)) - (sets (plist-get params :set)) - (x-labels (plist-get params :xlabels)) - (y-labels (plist-get params :ylabels)) - (timefmt (plist-get params :timefmt)) - (time-ind (or (plist-get params :timeind) + (title (cdr (assoc :title params))) + (lines (cdr (assoc :line params))) + (sets (cdr (assoc :set params))) + (x-labels (cdr (assoc :xlabels params))) + (y-labels (cdr (assoc :ylabels params))) + (timefmt (cdr (assoc :timefmt params))) + (time-ind (or (cdr (assoc :timeind params)) (when timefmt 1))) + (missing (cdr (assoc :missing params))) (add-to-body (lambda (text) (setq body (concat text "\n" body)))) output) ;; append header argument settings to body - (when title (funcall add-to-body (format "set title '%s'" title))) ;; title - (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line + (when title (funcall add-to-body (format "set title '%s'" title))) + (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) + (when missing + (funcall add-to-body (format "set datafile missing '%s'" missing))) (when sets (mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets)) (when x-labels (funcall add-to-body (format "set xtics (%s)" (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) + (format "\"%s\" %d" + (cdr pair) (car pair))) x-labels ", ")))) (when y-labels (funcall add-to-body (format "set ytics (%s)" (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) + (format "\"%s\" %d" + (cdr pair) (car pair))) y-labels ", ")))) (when time-ind (funcall add-to-body "set xdata time") (funcall add-to-body (concat "set timefmt \"" (or timefmt "%Y-%m-%d-%H:%M:%S") "\""))) - (when out-file (funcall add-to-body (format "set output \"%s\"" out-file))) + (when out-file + ;; set the terminal at the top of the block + (funcall add-to-body (format "set output \"%s\"" out-file)) + ;; and close the terminal at the bottom of the block + (setq body (concat body "\nset output\n"))) (when term (funcall add-to-body (format "set term %s" term))) ;; insert variables into code body: this should happen last ;; placing the variables at the *top* of the code in case their ;; values are used later - (funcall add-to-body (mapconcat #'identity - (org-babel-variable-assignments:gnuplot params) - "\n")) + (funcall add-to-body + (mapconcat #'identity + (org-babel-variable-assignments:gnuplot params) + "\n")) ;; replace any variable names preceded by '$' with the actual ;; value of the variable (mapc (lambda (pair) (setq body (replace-regexp-in-string (format "\\$%s" (car pair)) (cdr pair) body))) - vars)) + vars) + (when prologue (funcall add-to-body prologue)) + (when epilogue (setq body (concat body "\n" epilogue)))) body)) (defun org-babel-execute:gnuplot (body params) @@ -199,7 +239,8 @@ then create one. Return the initialized session. The current (defun org-babel-gnuplot-quote-timestamp-field (s) "Convert S from timestamp to Unix time and export to gnuplot." - (format-time-string org-babel-gnuplot-timestamp-fmt (org-time-string-to-time s))) + (format-time-string org-babel-gnuplot-timestamp-fmt + (org-time-string-to-time s))) (defvar org-table-number-regexp) (defvar org-ts-regexp3) @@ -210,7 +251,12 @@ then create one. Return the initialized session. The current (if (string-match org-table-number-regexp s) s (if (string-match org-ts-regexp3 s) (org-babel-gnuplot-quote-timestamp-field s) - (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")))) + (if (zerop (length s)) + (or *org-babel-gnuplot-missing* s) + (if (string-match "[ \"]" "?") + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") + "\"") + s))))) (defun org-babel-gnuplot-table-to-data (table data-file params) "Export TABLE to DATA-FILE in a format readable by gnuplot. diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index 6f0fbcd..a012711 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -52,7 +52,8 @@ (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) -(defvar org-babel-default-header-args:haskell '()) +(defvar org-babel-default-header-args:haskell + '((:padlines . "no"))) (defvar org-babel-haskell-lhs2tex-command "lhs2tex") @@ -149,7 +150,7 @@ specifying a variable of the same value." (defvar org-src-preserve-indentation) (declare-function org-export-to-file "ox" (backend file - &optional subtreep visible-only body-only ext-plist)) + &optional async subtreep visible-only body-only ext-plist)) (defun org-babel-haskell-export-to-lhs (&optional arg) "Export to a .lhs file with all haskell code blocks escaped. When called with a prefix argument the resulting diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index 94d5133..edc9fe8 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -50,6 +50,17 @@ '((:results . "latex") (:exports . "results")) "Default arguments to use when evaluating a LaTeX source block.") +(defcustom org-babel-latex-htlatex nil + "The htlatex command to enable conversion of latex to SVG or HTML." + :group 'org-babel + :type 'string) + +(defcustom org-babel-latex-htlatex-packages + '("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}") + "Packages to use for htlatex export." + :group 'org-babel + :type '(list string)) + (defun org-babel-expand-body:latex (body params) "Expand BODY according to PARAMS, return the expanded body." (mapc (lambda (pair) ;; replace variables @@ -84,7 +95,11 @@ This function is called by `org-babel-execute-src-block'." ((and (string-match "\\.png$" out-file) (not imagemagick)) (org-create-formula-image body out-file org-format-latex-options in-buffer)) - ((or (string-match "\\.pdf$" out-file) imagemagick) + ((string-match "\\.tikz$" out-file) + (when (file-exists-p out-file) (delete-file out-file)) + (with-temp-file out-file + (insert body))) + ((or (string-match "\\.pdf$" out-file) imagemagick) (with-temp-file tex-file (require 'ox-latex) (insert @@ -124,6 +139,40 @@ This function is called by `org-babel-execute-src-block'." transient-pdf-file out-file im-in-options im-out-options) (when (file-exists-p transient-pdf-file) (delete-file transient-pdf-file)))))) + ((and (or (string-match "\\.svg$" out-file) + (string-match "\\.html$" out-file)) + org-babel-latex-htlatex) + (with-temp-file tex-file + (insert (concat + "\\documentclass[preview]{standalone} +\\def\\pgfsysdriver{pgfsys-tex4ht.def} +" + (mapconcat (lambda (pkg) + (concat "\\usepackage" pkg)) + org-babel-latex-htlatex-packages + "\n") + "\\begin{document}" + body + "\\end{document}"))) + (when (file-exists-p out-file) (delete-file out-file)) + (let ((default-directory (file-name-directory tex-file))) + (shell-command (format "%s %s" org-babel-latex-htlatex tex-file))) + (cond + ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg")) + (if (string-match "\\.svg$" out-file) + (progn + (shell-command "pwd") + (shell-command (format "mv %s %s" + (concat (file-name-sans-extension tex-file) "-1.svg") + out-file))) + (error "SVG file produced but HTML file requested."))) + ((file-exists-p (concat (file-name-sans-extension tex-file) ".html")) + (if (string-match "\\.html$" out-file) + (shell-command "mv %s %s" + (concat (file-name-sans-extension tex-file) + ".html") + out-file) + (error "HTML file produced but SVG file requested."))))) ((string-match "\\.\\([^\\.]+\\)$" out-file) (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" (match-string 1 out-file)))) diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el index 802aa60..d37940a 100644 --- a/lisp/ob-lob.el +++ b/lisp/ob-lob.el @@ -35,7 +35,7 @@ This is an association list. Populate the library by adding files to `org-babel-lob-files'.") -(defcustom org-babel-lob-files '() +(defcustom org-babel-lob-files nil "Files used to populate the `org-babel-library-of-babel'. To add files to this list use the `org-babel-lob-ingest' command." :group 'org-babel @@ -114,25 +114,38 @@ if so then run the appropriate source block from the Library." (or (funcall nonempty 8 19) "")) (funcall nonempty 9 18))) (list (length (if (= (length (match-string 12)) 0) - (match-string 2) (match-string 11))))))))) + (match-string 2) (match-string 11))) + (save-excursion + (forward-line -1) + (and (looking-at (concat org-babel-src-name-regexp + "\\([^\n]*\\)$")) + (org-no-properties (match-string 1)))))))))) (defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el (defun org-babel-lob-execute (info) "Execute the lob call specified by INFO." - (let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info)))) - (pre-params (org-babel-merge-params - org-babel-default-header-args - org-babel-default-header-args:emacs-lisp - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-no-properties - (concat ":var results=" - (mapconcat #'identity (butlast info) " ")))))) + (let* ((mkinfo (lambda (p) + (list "emacs-lisp" "results" p nil + (nth 3 info) ;; name + (nth 2 info)))) + (pre-params (apply #'org-babel-merge-params + org-babel-default-header-args + org-babel-default-header-args:emacs-lisp + (append + (org-babel-params-from-properties) + (list + (org-babel-parse-header-arguments + (org-no-properties + (concat + ":var results=" + (mapconcat #'identity (butlast info 2) + " ")))))))) (pre-info (funcall mkinfo pre-params)) (cache-p (and (cdr (assoc :cache pre-params)) (string= "yes" (cdr (assoc :cache pre-params))))) (new-hash (when cache-p (org-babel-sha1-hash pre-info))) - (old-hash (when cache-p (org-babel-current-result-hash)))) + (old-hash (when cache-p (org-babel-current-result-hash))) + (org-babel-current-src-block-location (point-marker))) (if (and cache-p (equal new-hash old-hash)) (save-excursion (goto-char (org-babel-where-is-src-block-result)) (forward-line 1) diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el index 6a83908..25f79c5 100644 --- a/lisp/ob-ocaml.el +++ b/lisp/ob-ocaml.el @@ -51,6 +51,13 @@ (defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;") (defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe") +(defcustom org-babel-ocaml-command "ocaml" + "Name of the command for executing Ocaml code." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-babel + :type 'string) + (defun org-babel-execute:ocaml (body params) "Execute a block of Ocaml code with Babel." (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) @@ -63,7 +70,7 @@ (session org-babel-ocaml-eoe-output t full-body) (insert (concat - (org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator)) + (org-babel-chomp full-body)";;\n"org-babel-ocaml-eoe-indicator)) (tuareg-interactive-send-input))) (clean (car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out) @@ -74,10 +81,13 @@ (progn (setq out t) nil)))) (mapcar #'org-babel-trim (reverse raw)))))))) (org-babel-reassemble-table - (let ((raw (org-babel-trim clean))) - (org-babel-result-cond (cdr (assoc :result-params params)) - ;; strip type information from output - (if (string-match "= \\(.+\\)$" raw) (match-string 1 raw) raw) + (let ((raw (org-babel-trim clean)) + (result-params (cdr (assoc :result-params params)))) + (org-babel-result-cond result-params + ;; strip type information from output unless verbatim is specified + (if (and (not (member "verbatim" result-params)) + (string-match "= \\(.+\\)$" raw)) + (match-string 1 raw) raw) (org-babel-ocaml-parse-output raw))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) @@ -93,9 +103,10 @@ (stringp session)) session tuareg-interactive-buffer-name))) - (save-window-excursion - (if (fboundp 'tuareg-run-caml) (tuareg-run-caml) (tuareg-run-ocaml)) - (get-buffer tuareg-interactive-buffer-name)))) + (save-window-excursion (if (fboundp 'tuareg-run-process-if-needed) + (tuareg-run-process-if-needed org-babel-ocaml-command) + (tuareg-run-caml))) + (get-buffer tuareg-interactive-buffer-name))) (defun org-babel-variable-assignments:ocaml (params) "Return list of ocaml statements assigning the block's variables." @@ -113,7 +124,7 @@ (defun org-babel-ocaml-parse-output (output) "Parse OUTPUT. OUTPUT is string output from an ocaml process." - (let ((regexp "%s = \\(.+\\)$")) + (let ((regexp "[^:]+ : %s = \\(.+\\)$")) (cond ((string-match (format regexp "string") output) (org-babel-read (match-string 1 output))) diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el index c2a3abb..40bedfd 100644 --- a/lisp/ob-octave.el +++ b/lisp/ob-octave.el @@ -151,7 +151,8 @@ create. Return the initialized session." "Create an octave inferior process buffer. If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." - (if matlabp (require 'matlab) (require 'octave-inf)) + (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror) + (require 'octave))) (unless (string= session "none") (let ((session (or session (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) diff --git a/lisp/ob-org.el b/lisp/ob-org.el index 18cce3b..892c56c 100644 --- a/lisp/ob-org.el +++ b/lisp/ob-org.el @@ -43,8 +43,9 @@ (defun org-babel-expand-body:org (body params) (dolist (var (mapcar #'cdr (org-babel-get-header params :var))) (setq body (replace-regexp-in-string - (regexp-quote (format "$%s" (car var))) (cdr var) body - nil 'literal))) + (regexp-quote (format "$%s" (car var))) + (format "%s" (cdr var)) + body nil 'literal))) body) (defun org-babel-execute:org (body params) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index eca4c82..17da109 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -33,7 +33,7 @@ (declare-function org-remove-indentation "org" ) (declare-function py-shell "ext:python-mode" (&optional argprompt)) (declare-function py-toggle-shells "ext:python-mode" (arg)) -(declare-function run-python "ext:python" (&optional cmd noshow new)) +(declare-function run-python "ext:python" (cmd &optional dedicated show)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) @@ -179,21 +179,20 @@ then create. Return the initialized session." (require org-babel-python-mode) (save-window-excursion (let* ((session (if session (intern session) :default)) - (python-buffer (org-babel-python-session-buffer session))) + (python-buffer (org-babel-python-session-buffer session)) + (cmd (if (member system-type '(cygwin windows-nt ms-dos)) + (concat org-babel-python-command " -i") + org-babel-python-command))) (cond ((and (eq 'python org-babel-python-mode) (fboundp 'run-python)) ; python.el - (if (version< "24.1" emacs-version) - (progn - (unless python-buffer - (setq python-buffer (org-babel-python-with-earmufs session))) - (let ((python-shell-buffer-name - (org-babel-python-without-earmufs python-buffer))) - (run-python - (if (member system-type '(cygwin windows-nt ms-dos)) - (concat org-babel-python-command " -i") - org-babel-python-command)))) - (run-python))) + (if (not (version< "24.1" emacs-version)) + (run-python cmd) + (unless python-buffer + (setq python-buffer (org-babel-python-with-earmufs session))) + (let ((python-shell-buffer-name + (org-babel-python-without-earmufs python-buffer))) + (run-python cmd)))) ((and (eq 'python-mode org-babel-python-mode) (fboundp 'py-shell)) ; python-mode.el ;; Make sure that py-which-bufname is initialized, as otherwise diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index a2814ea..5a3c8ba 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -83,7 +83,10 @@ the variable." (let ((var (match-string 1 assignment)) (ref (match-string 2 assignment))) (cons (intern var) - (let ((out (org-babel-read ref))) + (let ((out (save-excursion + (when org-babel-current-src-block-location + (goto-char org-babel-current-src-block-location)) + (org-babel-read ref)))) (if (equal out ref) (if (string-match "^\".*\"$" ref) (read ref) diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index 20fb418..af52831 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -50,6 +50,22 @@ (defvar org-babel-ruby-command "ruby" "Name of command to use for executing ruby code.") +(defcustom org-babel-ruby-hline-to "nil" + "Replace hlines in incoming tables with this when translating to ruby." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-babel-ruby-nil-to 'hline + "Replace 'nil' in ruby tables with this before returning." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + + + (defun org-babel-execute:ruby (body params) "Execute a block of Ruby code with Babel. This function is called by `org-babel-execute-src-block'." @@ -115,13 +131,21 @@ Convert an elisp value into a string of ruby source code specifying a variable of the same value." (if (listp var) (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]") - (format "%S" var))) + (if (equal var 'hline) + org-babel-ruby-hline-to + (format "%S" var)))) (defun org-babel-ruby-table-or-string (results) "Convert RESULTS into an appropriate elisp value. If RESULTS look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) + ((lambda (res) + (if (listp res) + (mapcar (lambda (el) (if (equal el 'nil) + org-babel-ruby-nil-to el)) + res) + res)) + (org-babel-script-escape results))) (defun org-babel-ruby-initiate-session (&optional session params) "Initiate a ruby session. diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el index 89dd003..f979640 100644 --- a/lisp/ob-scheme.el +++ b/lisp/ob-scheme.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2010-2013 Free Software Foundation, Inc. -;; Author: Eric Schulte +;; Authors: Eric Schulte, Michael Gauland ;; Keywords: literate programming, reproducible research, scheme ;; Homepage: http://orgmode.org @@ -33,27 +33,25 @@ ;; - a working scheme implementation ;; (e.g. guile http://www.gnu.org/software/guile/guile.html) ;; -;; - for session based evaluation cmuscheme.el is required which is -;; included in Emacs +;; - for session based evaluation geiser is required, which is available from +;; ELPA. ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) +(require 'geiser nil t) +(defvar geiser-repl--repl) ; Defined in geiser-repl.el +(defvar geiser-impl--implementation) ; Defined in geiser-impl.el +(defvar geiser-default-implementation) ; Defined in geiser-impl.el +(defvar geiser-active-implementations) ; Defined in geiser-impl.el -(declare-function run-scheme "ext:cmuscheme" (cmd)) +(declare-function run-geiser "geiser-repl" (impl)) +(declare-function geiser-mode "geiser-mode" ()) +(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg)) +(declare-function geiser-repl-exit "geiser-repl" (&optional arg)) (defvar org-babel-default-header-args:scheme '() "Default header arguments for scheme code blocks.") -(defvar org-babel-scheme-eoe "org-babel-scheme-eoe" - "String to indicate that evaluation has completed.") - -(defcustom org-babel-scheme-cmd "guile" - "Name of command used to evaluate scheme blocks." - :group 'org-babel - :version "24.1" - :type 'string) - (defun org-babel-expand-body:scheme (body params) "Expand BODY according to PARAMS, return the expanded body." (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) @@ -65,72 +63,127 @@ ")\n" body ")") body))) -(defvar scheme-program-name) + +(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal) + "Map of scheme sessions to session names.") + +(defun org-babel-scheme-cleanse-repl-map () + "Remove dead buffers from the REPL map." + (maphash + (lambda (x y) + (when (not (buffer-name y)) + (remhash x org-babel-scheme-repl-map))) + org-babel-scheme-repl-map)) + +(defun org-babel-scheme-get-session-buffer (session-name) + "Look up the scheme buffer for a session; return nil if it doesn't exist." + (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions + (gethash session-name org-babel-scheme-repl-map)) + +(defun org-babel-scheme-set-session-buffer (session-name buffer) + "Record the scheme buffer used for a given session." + (puthash session-name buffer org-babel-scheme-repl-map)) + +(defun org-babel-scheme-get-buffer-impl (buffer) + "Returns the scheme implementation geiser associates with the buffer." + (with-current-buffer (set-buffer buffer) + geiser-impl--implementation)) + +(defun org-babel-scheme-get-repl (impl name) + "Switch to a scheme REPL, creating it if it doesn't exist:" + (let ((buffer (org-babel-scheme-get-session-buffer name))) + (or buffer + (progn + (run-geiser impl) + (if name + (progn + (rename-buffer name t) + (org-babel-scheme-set-session-buffer name (current-buffer)))) + (current-buffer))))) + +(defun org-babel-scheme-make-session-name (buffer name impl) + "Generate a name for the session buffer. + +For a named session, the buffer name will be the session name. + +If the session is unnamed (nil), generate a name. + +If the session is 'none', use nil for the session name, and +org-babel-scheme-execute-with-geiser will use a temporary session." + (let ((result + (cond ((not name) + (concat buffer " " (symbol-name impl) " REPL")) + ((string= name "none") nil) + (name)))) + result)) + +(defun org-babel-scheme-execute-with-geiser (code output impl repl) + "Execute code in specified REPL. If the REPL doesn't exist, create it +using the given scheme implementation. + +Returns the output of executing the code if the output parameter +is true; otherwise returns the last value." + (let ((result nil)) + (with-temp-buffer + (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl)) + (newline) + (insert (if output + (format "(with-output-to-string (lambda () %s))" code) + code)) + (geiser-mode) + (let ((repl-buffer (save-current-buffer + (org-babel-scheme-get-repl impl repl)))) + (when (not (eq impl (org-babel-scheme-get-buffer-impl + (current-buffer)))) + (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) + (org-babel-scheme-get-buffer-impl (current-buffer)) + (symbolp (org-babel-scheme-get-buffer-impl + (current-buffer))))) + (setq geiser-repl--repl repl-buffer) + (setq geiser-impl--implementation nil) + (geiser-eval-region (point-min) (point-max)) + (setq result + (if (equal (substring (current-message) 0 3) "=> ") + (replace-regexp-in-string "^=> " "" (current-message)) + "\"An error occurred.\"")) + (when (not repl) + (save-current-buffer (set-buffer repl-buffer) + (geiser-repl-exit)) + (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) + (kill-buffer repl-buffer)) + (setq result (if (or (string= result "#<void>") + (string= result "#<unspecified>")) + nil + (read result))))) + result)) + (defun org-babel-execute:scheme (body params) "Execute a block of Scheme code with org-babel. This function is called by `org-babel-execute-src-block'" - (let* ((result-type (cdr (assoc :result-type params))) - (org-babel-scheme-cmd (or (cdr (assoc :scheme params)) - org-babel-scheme-cmd)) - (full-body (org-babel-expand-body:scheme body params)) - (result (if (not (string= (cdr (assoc :session params)) "none")) - ;; session evaluation - (let ((session (org-babel-prep-session:scheme - (cdr (assoc :session params)) params))) - (org-babel-comint-with-output - (session (format "%S" org-babel-scheme-eoe) t body) - (mapc - (lambda (line) - (insert (org-babel-chomp line)) - (comint-send-input nil t)) - (list body (format "%S" org-babel-scheme-eoe))))) - ;; external evaluation - (let ((script-file (org-babel-temp-file "scheme-script-"))) - (with-temp-file script-file - (insert - ;; return the value or the output - (if (string= result-type "value") - (format "(display %s)" full-body) - full-body))) - (org-babel-eval - (format "%s %s" org-babel-scheme-cmd - (org-babel-process-file-name script-file)) ""))))) - (org-babel-result-cond (cdr (assoc :result-params params)) - result (read result)))) - -(defun org-babel-prep-session:scheme (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (org-babel-scheme-initiate-session session)) - (vars (mapcar #'cdr (org-babel-get-header params :var))) - (var-lines - (mapcar - (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var))))) - vars))) - (when session - (org-babel-comint-in-buffer session - (sit-for .5) (goto-char (point-max)) - (mapc (lambda (var) - (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session) - (sit-for .1) (goto-char (point-max))) var-lines))) - session)) - -(defun org-babel-scheme-initiate-session (&optional session) - "If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session." - (require 'cmuscheme) - (unless (string= session "none") - (let ((session-buffer (save-window-excursion - (run-scheme org-babel-scheme-cmd) - (rename-buffer session) - (current-buffer)))) - (if (org-babel-comint-buffer-livep session-buffer) - (progn (sit-for .25) session-buffer) - (sit-for .5) - (org-babel-scheme-initiate-session session))))) + (let* ((source-buffer (current-buffer)) + (source-buffer-name (replace-regexp-in-string ;; zap surrounding * + "^ ?\\*\\([^*]+\\)\\*" "\\1" + (buffer-name source-buffer)))) + (save-excursion + (org-babel-reassemble-table + (let* ((result-type (cdr (assoc :result-type params))) + (impl (or (when (cdr (assoc :scheme params)) + (intern (cdr (assoc :scheme params)))) + geiser-default-implementation + (car geiser-active-implementations))) + (session (org-babel-scheme-make-session-name + source-buffer-name (cdr (assoc :session params)) impl)) + (full-body (org-babel-expand-body:scheme body params))) + (org-babel-scheme-execute-with-geiser + full-body ; code + (string= result-type "output") ; output? + impl ; implementation + (and (not (string= session "none")) session))) ; session + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))))) (provide 'ob-scheme) - - ;;; ob-scheme.el ends here diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el index 7eda1b5..ec1306b 100644 --- a/lisp/ob-sh.el +++ b/lisp/ob-sh.el @@ -106,7 +106,7 @@ var of the same value." "Convert an elisp value to a string." (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) (cond - ((and (listp var) (or (listp (car var)) 'hline)) + ((and (listp var) (or (listp (car var)) (equal (car var) 'hline))) (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) ((listp var) (mapconcat echo-var var "\n")) diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el index a41580f..dc6313d 100644 --- a/lisp/ob-shen.el +++ b/lisp/ob-shen.el @@ -36,6 +36,7 @@ (require 'ob) (declare-function shen-eval-defun "ext:inf-shen" (&optional and-go)) +(declare-function org-babel-ruby-var-to-ruby "ob-ruby" (var)) (defvar org-babel-default-header-args:shen '() "Default header arguments for shen code blocks.") diff --git a/lisp/ob-table.el b/lisp/ob-table.el index 869d992..8b3e36d 100644 --- a/lisp/ob-table.el +++ b/lisp/ob-table.el @@ -97,9 +97,11 @@ as shown in the example below. (lambda (el) (if (eq '$ el) (prog1 nil (setq quote t)) - (prog1 (if quote - (format "\"%s\"" el) - (org-no-properties el)) + (prog1 + (cond + (quote (format "\"%s\"" el)) + ((stringp el) (org-no-properties el)) + (t el)) (setq quote nil)))) (cdr var))))) variables))) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index f15567f..8141943 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -30,7 +30,10 @@ (eval-when-compile (require 'cl)) +(declare-function org-edit-special "org" (&optional arg)) (declare-function org-link-escape "org" (text &optional table)) +(declare-function org-store-link "org" (arg)) +(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) (declare-function org-heading-components "org" ()) (declare-function org-back-to-heading "org" (invisible-ok)) (declare-function org-fill-template "org" (template alist)) @@ -111,7 +114,7 @@ result. The default value is `org-babel-trim'." (defun org-babel-find-file-noselect-refresh (file) "Find file ensuring that the latest changes on disk are represented in the file." - (find-file-noselect file) + (find-file-noselect file 'nowarn) (with-current-buffer (get-file-buffer file) (revert-buffer t t t))) @@ -185,7 +188,7 @@ used to limit the exported source code blocks by language." org-babel-default-header-args)) (tangle-file (when (equal arg '(16)) - (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info)))) + (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light)))) (user-error "Point is not in a source code block")))) path-collector) (mapc ;; map over all languages @@ -207,6 +210,7 @@ used to limit the exported source code blocks by language." (let* ((tangle (funcall get-spec :tangle)) (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) (funcall get-spec :shebang))) + (tangle-mode (funcall get-spec :tangle-mode)) (base-name (cond ((string= "yes" tangle) (file-name-sans-extension @@ -224,7 +228,7 @@ used to limit the exported source code blocks by language." (make-directory (file-name-directory file-name) 'parents)) ;; delete any old versions of file (when (and (file-exists-p file-name) - (not (member file-name path-collector))) + (not (member file-name (mapcar #'car path-collector)))) (delete-file file-name)) ;; drop source-block to file (with-temp-buffer @@ -242,10 +246,14 @@ used to limit the exported source code blocks by language." (insert content) (write-region nil nil file-name)))) ;; if files contain she-bangs, then make the executable - (when she-bang (set-file-modes file-name #o755)) + (when she-bang + (unless tangle-mode (setq tangle-mode #o755))) ;; update counter (setq block-counter (+ 1 block-counter)) - (add-to-list 'path-collector file-name))))) + (add-to-list 'path-collector + (cons file-name tangle-mode) + nil + (lambda (a b) (equal (car a) (car b)))))))) specs))) (if (equal arg '(4)) (org-babel-tangle-single-block 1 t) @@ -253,15 +261,20 @@ used to limit the exported source code blocks by language." (message "Tangled %d code block%s from %s" block-counter (if (= block-counter 1) "" "s") (file-name-nondirectory - (buffer-file-name (or (buffer-base-buffer) (current-buffer))))) + (buffer-file-name + (or (buffer-base-buffer) (current-buffer))))) ;; run `org-babel-post-tangle-hook' in all tangled files (when org-babel-post-tangle-hook (mapc (lambda (file) (org-babel-with-temp-filebuffer file (run-hooks 'org-babel-post-tangle-hook))) - path-collector)) - path-collector)))) + (mapcar #'car path-collector))) + ;; set permissions on tangled files + (mapc (lambda (pair) + (when (cdr pair) (set-file-modes (car pair) (cdr pair)))) + path-collector) + (mapcar #'car path-collector))))) (defun org-babel-tangle-clean () "Remove comments inserted by `org-babel-tangle'. @@ -493,13 +506,15 @@ which enable the original code blocks to be found." "Jump from a tangled code file to the related Org-mode file." (interactive) (let ((mid (point)) - start end done + start body-start end done target-buffer target-char link path block-name body) (save-window-excursion (save-excursion (while (and (re-search-backward org-bracket-link-analytic-regexp nil t) (not ; ever wider searches until matching block comments (and (setq start (point-at-eol)) + (setq body-start (save-excursion + (forward-line 2) (point-at-bol))) (setq link (match-string 0)) (setq path (match-string 3)) (setq block-name (match-string 5)) @@ -520,8 +535,19 @@ which enable the original code blocks to be found." (org-babel-next-src-block (string-to-number (match-string 1 block-name))) (org-babel-goto-named-src-block block-name)) + ;; position at the beginning of the code block body + (goto-char (org-babel-where-is-src-block-head)) + (forward-line 1) + ;; Use org-edit-special to isolate the code. + (org-edit-special) + ;; Then move forward the correct number of characters in the + ;; code buffer. + (forward-char (- mid body-start)) + ;; And return to the Org-mode buffer with the point in the right + ;; place. + (org-edit-src-exit) (setq target-char (point))) - (pop-to-buffer target-buffer) + (org-src-switch-to-buffer target-buffer t) (prog1 body (goto-char target-char)))) (provide 'ob-tangle) @@ -22,6 +22,8 @@ ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Code: +(require 'org-macs) +(require 'org-compat) (require 'ob-eval) (require 'ob-core) (require 'ob-comint) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 270a73d..8cfe858 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -227,7 +227,9 @@ As the value of this option simply gets inserted into the HTML <head> header, you can \"misuse\" it to also add other text to the header." :group 'org-agenda-export :group 'org-export-html - :type 'string) + :type '(choice + (const nil) + (string))) (defcustom org-agenda-persistent-filter nil "When set, keep filters from one agenda view to the next." @@ -328,6 +330,7 @@ the daily/weekly agenda, see `org-agenda-skip-function'.") (const org-agenda-span) (choice (const :tag "Day" 'day) (const :tag "Week" 'week) + (const :tag "Fortnight" 'fortnight) (const :tag "Month" 'month) (const :tag "Year" 'year) (integer :tag "Custom"))) @@ -1124,7 +1127,8 @@ option will be ignored." Should be 1 or 7. Obsolete, see `org-agenda-span'." :group 'org-agenda-daily/weekly - :type 'integer) + :type '(choice (const nil) + (integer))) (make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1") @@ -1135,6 +1139,7 @@ Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly :type '(choice (const :tag "Day" day) (const :tag "Week" week) + (const :tag "Fortnight" fortnight) (const :tag "Month" month) (const :tag "Year" year) (integer :tag "Custom"))) @@ -1729,9 +1734,7 @@ that passed since this item was scheduled first." These entries are added to the agenda when pressing \"[\"." :group 'org-agenda-line-format :version "24.1" - :type '(list - (string :tag "Scheduled today ") - (string :tag "Scheduled previously"))) + :type 'string) (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ") "Text preceding deadline items in the agenda view. @@ -1894,7 +1897,7 @@ returns a face, or nil if does not want to specify a face and let the normal rules apply." :group 'org-agenda-line-format :version "24.1" - :type 'function) + :type '(choice (const nil) (function))) (defcustom org-agenda-category-icon-alist nil "Alist of category icon to be displayed in agenda views. @@ -1976,7 +1979,7 @@ Note that for the purpose of tag filtering, only the lower-case version of all tags will be considered, so that this function will only ever see the lower-case version of all tags." :group 'org-agenda - :type 'function) + :type '(choice (const nil) (function))) (defcustom org-agenda-bulk-custom-functions nil "Alist of characters and custom functions for bulk actions. @@ -2334,7 +2337,11 @@ The following commands are available: ["Week View" org-agenda-week-view :active (org-agenda-check-type nil 'agenda) :style radio :selected (eq org-agenda-current-span 'week) - :keys "v w (or just w)"] + :keys "v w"] + ["Fortnight View" org-agenda-fortnight-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'fortnight) + :keys "v f"] ["Month View" org-agenda-month-view :active (org-agenda-check-type nil 'agenda) :style radio :selected (eq org-agenda-current-span 'month) @@ -4171,7 +4178,7 @@ items if they have an hour specification like [h]h:mm." (sd (or start-day today)) (ndays (org-agenda-span-to-ndays span sd)) (org-agenda-start-on-weekday - (if (eq ndays 7) + (if (or (eq ndays 7) (eq ndays 14)) org-agenda-start-on-weekday)) (thefiles (org-agenda-files nil 'ifmode)) (files thefiles) @@ -4340,6 +4347,7 @@ items if they have an hour specification like [h]h:mm." (cond ((symbolp n) n) ((= n 1) 'day) ((= n 7) 'week) + ((= n 14) 'fortnight) (t n))) (defun org-agenda-span-to-ndays (span &optional start-day) @@ -4348,6 +4356,7 @@ START-DAY is an absolute time value." (cond ((numberp span) span) ((eq span 'day) 1) ((eq span 'week) 7) + ((eq span 'fortnight) 14) ((eq span 'month) (let ((date (calendar-gregorian-from-absolute start-day))) (calendar-last-day-of-month (car date) (caddr date)))) @@ -7829,6 +7838,8 @@ With prefix ARG, go forward that many times the current span." (setq sd (+ arg sd))) ((eq span 'week) (setq sd (+ (* 7 arg) sd))) + ((eq span 'fortnight) + (setq sd (+ (* 14 arg) sd))) ((eq span 'month) (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) sd (calendar-absolute-from-gregorian greg2)) @@ -7858,7 +7869,7 @@ With prefix ARG, go backward that many times the current span." (defun org-agenda-view-mode-dispatch () "Call one of the view mode commands." (interactive) - (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort + (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") (let ((a (read-char-exclusive))) @@ -7866,6 +7877,7 @@ With prefix ARG, go backward that many times the current span." (?\ (call-interactively 'org-agenda-reset-view)) (?d (call-interactively 'org-agenda-day-view)) (?w (call-interactively 'org-agenda-week-view)) + (?t (call-interactively 'org-agenda-fortnight-view)) (?m (call-interactively 'org-agenda-month-view)) (?y (call-interactively 'org-agenda-year-view)) (?l (call-interactively 'org-agenda-log-mode)) @@ -7904,6 +7916,15 @@ week 12 of year 2007. Years in the range 1938-2037 can also be written as 2-digit years." (interactive "P") (org-agenda-change-time-span 'week iso-week)) +(defun org-agenda-fortnight-view (&optional iso-week) + "Switch to daily view for agenda. +With argument ISO-WEEK, switch to the corresponding ISO week. +If ISO-WEEK has more then 2 digits, only the last two encode the +week. Any digits before this encode a year. So 200712 means +week 12 of year 2007. Years in the range 1938-2037 can also be +written as 2-digit years." + (interactive "P") + (org-agenda-change-time-span 'fortnight iso-week)) (defun org-agenda-month-view (&optional month) "Switch to monthly view for agenda. With argument MONTH, switch to that month." @@ -7925,7 +7946,7 @@ written as 2-digit years." (defun org-agenda-change-time-span (span &optional n) "Change the agenda view to SPAN. -SPAN may be `day', `week', `month', `year'." +SPAN may be `day', `week', `fortnight', `month', `year'." (org-agenda-check-type t 'agenda) (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) (curspan (nth 2 args))) @@ -7946,7 +7967,7 @@ SPAN may be `day', `week', `month', `year'." (defun org-agenda-compute-starting-span (sd span &optional n) "Compute starting date for agenda. -SPAN may be `day', `week', `month', `year'. The return value +SPAN may be `day', `week', `fortnight', `month', `year'. The return value is a cons cell with the starting date and the number of days, so that the date SD will be in that range." (let* ((greg (calendar-gregorian-from-absolute sd)) @@ -7959,7 +7980,7 @@ so that the date SD will be in that range." (setq sd (+ (calendar-absolute-from-gregorian (list mg 1 yg)) n -1)))) - ((eq span 'week) + ((or (eq span 'week) (eq span 'fortnight)) (let* ((nt (calendar-day-of-week (calendar-gregorian-from-absolute sd))) (d (if org-agenda-start-on-weekday diff --git a/lisp/org-attach.el b/lisp/org-attach.el index faefa6b..898d911 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -42,6 +42,8 @@ (require 'org-id) (require 'org) +(declare-function vc-git-root "vc-git" (file)) + (defgroup org-attach nil "Options concerning entry attachments in Org-mode." :tag "Org Attach" @@ -261,14 +263,15 @@ the ATTACH_DIR property) their own attachment directory." (defun org-attach-commit () "Commit changes to git if `org-attach-directory' is properly initialized. This checks for the existence of a \".git\" directory in that directory." - (let ((dir (expand-file-name org-attach-directory)) - (changes 0)) - (when (file-exists-p (expand-file-name ".git" dir)) + (let* ((dir (expand-file-name org-attach-directory)) + (git-dir (vc-git-root dir)) + (changes 0)) + (when git-dir (with-temp-buffer (cd dir) (let ((have-annex (and org-attach-git-annex-cutoff - (file-exists-p (expand-file-name ".git/annex" dir))))) + (file-exists-p (expand-file-name "annex" git-dir))))) (dolist (new-or-modified (split-string (shell-command-to-string diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el index 39902c0..8d85335 100644 --- a/lisp/org-bibtex.el +++ b/lisp/org-bibtex.el @@ -224,7 +224,9 @@ For example setting to 'BIB_' would allow interoperability with fireforg." :group 'org-bibtex :version "24.1" - :type 'string) + :type '(choice + (const nil) + (string))) (defcustom org-bibtex-treat-headline-as-title t "Treat headline text as title if title property is absent. diff --git a/lisp/org-capture.el b/lisp/org-capture.el index a4f0fd0..0a6e4e4 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1267,8 +1267,11 @@ Of course, if exact position has been required, just put it there." (save-restriction (widen) (goto-char pos) - (with-demoted-errors - (bookmark-set "org-capture-last-stored")) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) (move-marker org-capture-last-stored-marker (point))))))) (defun org-capture-narrow (beg end) @@ -1734,11 +1737,15 @@ The template may still contain \"%?\" for cursor positioning." (goto-char (match-beginning 0)) (let ((template-start (point))) (forward-char 1) - (let ((result (org-eval - (org-capture--expand-keyword-in-embedded-elisp - (read (current-buffer)))))) + (let* ((sexp (read (current-buffer))) + (result (org-eval + (org-capture--expand-keyword-in-embedded-elisp sexp)))) (delete-region template-start (point)) - (insert result)))))) + (when result + (if (stringp result) + (insert result) + (error "Capture template sexp `%s' must evaluate to string or nil" + sexp)))))))) (defun org-capture--expand-keyword-in-embedded-elisp (attr) "Recursively replace capture link keywords in ATTR sexp. diff --git a/lisp/org-clock.el b/lisp/org-clock.el index fc619e0..9f22562 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -159,7 +159,7 @@ state to switch it to." This is the string shown in the mode line when a clock is running. The function is called with point at the beginning of the headline." :group 'org-clock - :type 'function) + :type '(choice (const nil) (function))) (defcustom org-clock-string-limit 0 "Maximum length of clock strings in the mode line. 0 means no limit." @@ -263,6 +263,7 @@ The function or program will be called with the notification string as argument." :group 'org-clock :type '(choice + (const nil) (string :tag "Program") (function :tag "Function"))) @@ -361,13 +362,13 @@ play with them." "Format string for the total time cells." :group 'org-clock :version "24.1" - :type 'boolean) + :type 'string) (defcustom org-clock-file-time-cell-format "*%s*" "Format string for the file time cells." :group 'org-clock :version "24.1" - :type 'boolean) + :type 'string) (defcustom org-clock-clocked-in-display 'mode-line "When clocked in for a task, org-mode can display the current @@ -1667,6 +1668,12 @@ Optional argument N tells to change by that many units." (message "Clock canceled") (run-hooks 'org-clock-cancel-hook)) +(defcustom org-clock-goto-before-context 2 + "Number of lines of context to display before currently clocked-in entry. +This applies when using `org-clock-goto'." + :group 'org-clock + :type 'integer) + ;;;###autoload (defun org-clock-goto (&optional select) "Go to the currently clocked-in entry, or to the most recently clocked one. @@ -1690,7 +1697,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (org-show-entry) (org-back-to-heading t) (org-cycle-hide-drawers 'children) - (recenter) + (recenter org-clock-goto-before-context) (org-reveal) (if recent (message "No running clock, this is the most recently clocked task")) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index a98deec..8790ad4 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -169,8 +169,10 @@ This is the compiled version of the format.") (get-text-property (point-at-bol) 'face)) 'default)) (color (list :foreground (face-attribute ref-face :foreground))) - (face (list color 'org-column ref-face)) - (face1 (list color 'org-agenda-column-dateline ref-face)) + (font (list :height (face-attribute 'default :height) + :family (face-attribute 'default :family))) + (face (list color font 'org-column ref-face)) + (face1 (list color font 'org-agenda-column-dateline ref-face)) (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) pom property ass width f string ov column val modval s2 title calc) ;; Check if the entry is in another buffer. @@ -1304,10 +1306,10 @@ PARAMS is a property list of parameters: (if (eq 'hline x) x (cons "" x))) tbl)) (setq tbl (append tbl (list (cons "/" (make-list nfields "<>")))))) - (setq pos (point)) (when content-lines (while (string-match "^#" (car content-lines)) (insert (pop content-lines) "\n"))) + (setq pos (point)) (insert (org-listtable-to-string tbl)) (when (plist-get params :width) (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x))) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index bd81f68..c4d15d8 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -113,18 +113,41 @@ any other entries, and any resulting duplicates will be removed entirely." ;;;; Emacs/XEmacs compatibility -(defun org-defvaralias (new-alias base-variable &optional docstring) - "Compatibility function for defvaralias. +(eval-and-compile + (defun org-defvaralias (new-alias base-variable &optional docstring) + "Compatibility function for defvaralias. Don't do the aliasing when `defvaralias' is not bound." - (declare (indent 1)) - (when (fboundp 'defvaralias) - (defvaralias new-alias base-variable docstring))) + (declare (indent 1)) + (when (fboundp 'defvaralias) + (defvaralias new-alias base-variable docstring))) -(eval-and-compile (when (and (not (boundp 'user-emacs-directory)) (boundp 'user-init-directory)) (org-defvaralias 'user-emacs-directory 'user-init-directory))) +(when (featurep 'xemacs) + (defadvice custom-handle-keyword + (around org-custom-handle-keyword + activate preactivate) + "Remove custom keywords not recognized to avoid producing an error." + (cond + ((eq (ad-get-arg 1) :package-version)) + (t ad-do-it))) + (defadvice define-obsolete-variable-alias + (around org-define-obsolete-variable-alias + (obsolete-name current-name &optional when docstring) + activate preactivate) + "Declare arguments defined in later versions of Emacs." + ad-do-it) + (defadvice define-obsolete-function-alias + (around org-define-obsolete-function-alias + (obsolete-name current-name &optional when docstring) + activate preactivate) + "Declare arguments defined in later versions of Emacs." + ad-do-it) + (defvar customize-package-emacs-version-alist nil) + (defvar temporary-file-directory (temp-directory))) + ;; Keys (defconst org-xemacs-key-equivalents '(([mouse-1] . [button1]) @@ -313,9 +336,12 @@ Works on both Emacs and XEmacs." (indent-line-to column))) (defun org-move-to-column (column &optional force buffer) - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (move-to-column column force buffer)) - (move-to-column column force))) + ;; set buffer-invisibility-spec to nil so that move-to-column + ;; does the right thing despite the presence of invisible text. + (let ((buffer-invisibility-spec nil)) + (if (featurep 'xemacs) + (org-xemacs-without-invisibility (move-to-column column force buffer)) + (move-to-column column force)))) (defun org-get-x-clipboard-compat (value) "Get the clipboard value on XEmacs or Emacs 21." @@ -390,11 +416,11 @@ TIME defaults to the current time." "Suppress popup windows. Let-bind some variables to nil around BODY to achieve the desired effect, which variables to use depends on the Emacs version." - (if (org-version-check "24.2.50" "" :predicate) - `(let (pop-up-frames display-buffer-alist) - ,@body) - `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) - ,@body))) + (if (org-version-check "24.2.50" "" :predicate) + `(let (pop-up-frames display-buffer-alist) + ,@body) + `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) + ,@body))) (if (fboundp 'string-match-p) (defalias 'org-string-match-p 'string-match-p) diff --git a/lisp/org-ctags.el b/lisp/org-ctags.el index 833c1dd..9d8ed6c 100644 --- a/lisp/org-ctags.el +++ b/lisp/org-ctags.el @@ -131,7 +131,7 @@ ;; ;; (progn ;; (message "-- rebuilding tags tables...") -;; (mapc 'org-create-tags tags-table-list)) +;; (mapc 'org-ctags-create-tags tags-table-list)) ;;; Code: @@ -156,11 +156,8 @@ Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ See the ctags documentation for more information.") (defcustom org-ctags-path-to-ctags - (case system-type - (windows-nt "ctags.exe") - (darwin "ctags-exuberant") - (t "ctags-exuberant")) - "Full path to the ctags executable file." + (if (executable-find "ctags-exuberant") "ctags-exuberant" "ctags") + "Name of the ctags executable file." :group 'org-ctags :version "24.1" :type 'file) diff --git a/lisp/org-element.el b/lisp/org-element.el index 3cf87b2..807fdb4 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -683,9 +683,12 @@ Assume point is at the beginning of the footnote definition." "^\\([ \t]*\n\\)\\{2,\\}") limit 'move)) (match-beginning 0) (point)))) - (contents-begin (progn (search-forward "]") - (skip-chars-forward " \r\t\n" ending) - (and (/= (point) ending) (point)))) + (contents-begin (progn + (search-forward "]") + (skip-chars-forward " \r\t\n" ending) + (cond ((= (point) ending) nil) + ((= (line-beginning-position) begin) (point)) + (t (line-beginning-position))))) (contents-end (and contents-begin ending)) (end (progn (goto-char ending) (skip-chars-forward " \r\t\n" limit) @@ -1151,6 +1154,90 @@ CONTENTS is the contents of the element." ;;;; Plain List +(defun org-element--list-struct (limit) + ;; Return structure of list at point. Internal function. See + ;; `org-list-struct' for details. + (let ((case-fold-search t) + (top-ind limit) + (item-re (org-item-re)) + (drawers-re (concat ":\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ ")) + items struct) + (save-excursion + (catch 'exit + (while t + (cond + ;; At limit: end all items. + ((>= (point) limit) + (throw 'exit + (let ((end (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point)))) + (dolist (item items (sort (nconc items struct) + 'car-less-than-car)) + (setcar (nthcdr 6 item) end))))) + ;; At list end: end all items. + ((looking-at org-list-end-re) + (throw 'exit (dolist (item items (sort (nconc items struct) + 'car-less-than-car)) + (setcar (nthcdr 6 item) (point))))) + ;; At a new item: end previous sibling. + ((looking-at item-re) + (let ((ind (save-excursion (skip-chars-forward " \t") + (current-column)))) + (setq top-ind (min top-ind ind)) + (while (and items (<= ind (nth 1 (car items)))) + (let ((item (pop items))) + (setcar (nthcdr 6 item) (point)) + (push item struct))) + (push (progn (looking-at org-list-full-item-re) + (let ((bullet (match-string-no-properties 1))) + (list (point) + ind + bullet + (match-string-no-properties 2) ; counter + (match-string-no-properties 3) ; checkbox + ;; Description tag. + (and (save-match-data + (string-match "[-+*]" bullet)) + (match-string-no-properties 4)) + ;; Ending position, unknown so far. + nil))) + items)) + (forward-line 1)) + ;; Skip empty lines. + ((looking-at "^[ \t]*$") (forward-line)) + ;; Skip inline tasks and blank lines along the way. + ((and inlinetask-re (looking-at inlinetask-re)) + (forward-line) + (let ((origin (point))) + (when (re-search-forward inlinetask-re limit t) + (if (looking-at "^\\*+ END[ \t]*$") (forward-line) + (goto-char origin))))) + ;; At some text line. Check if it ends any previous item. + (t + (let ((ind (progn (skip-chars-forward " \t") (current-column)))) + (when (<= ind top-ind) + (skip-chars-backward " \r\t\n") + (forward-line)) + (while (<= ind (nth 1 (car items))) + (let ((item (pop items))) + (setcar (nthcdr 6 item) (line-beginning-position)) + (push item struct) + (unless items + (throw 'exit (sort struct 'car-less-than-car)))))) + ;; Skip blocks (any type) and drawers contents. + (cond + ((and (looking-at "#\\+BEGIN\\(:[ \t]*$\\|_\\S-\\)+") + (re-search-forward + (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1)) + limit t))) + ((and (looking-at drawers-re) + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) + (forward-line)))))))) + (defun org-element-plain-list-parser (limit affiliated structure) "Parse a plain list. @@ -1167,9 +1254,8 @@ containing `:type', `:begin', `:end', `:contents-begin' and Assume point is at the beginning of the list." (save-excursion - (let* ((struct (or structure (org-list-struct))) + (let* ((struct (or structure (org-element--list-struct limit))) (prevs (org-list-prevs-alist struct)) - (parents (org-list-parents-alist struct)) (type (org-list-get-list-type (point) struct prevs)) (contents-begin (point)) (begin (car affiliated)) @@ -2015,11 +2101,11 @@ Return a list whose CAR is `node-property' and CDR is a plist containing `:key', `:value', `:begin', `:end' and `:post-blank' keywords." (save-excursion + (looking-at org-property-re) (let ((case-fold-search t) (begin (point)) - (key (progn (looking-at "[ \t]*:\\(.*?\\):[ \t]+\\(.*?\\)[ \t]*$") - (org-match-string-no-properties 1))) - (value (org-match-string-no-properties 2)) + (key (org-match-string-no-properties 2)) + (value (org-match-string-no-properties 3)) (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (point-at-bol))))) @@ -2089,20 +2175,21 @@ Assume point is at the beginning of the paragraph." (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t))) ;; Stop at valid blocks. - (and (looking-at - "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") (save-excursion (re-search-forward (format "^[ \t]*#\\+END_%s[ \t]*$" - (match-string 1)) + (regexp-quote + (org-match-string-no-properties 1))) limit t))) ;; Stop at valid latex environments. (and (looking-at - "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}[ \t]*$") + "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") (save-excursion (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$" - (match-string 1)) + (regexp-quote + (org-match-string-no-properties 1))) limit t))) ;; Stop at valid keywords. (looking-at "[ \t]*#\\+\\S-+:") @@ -2560,17 +2647,15 @@ Assume point is at the first star marker." CONTENTS is the contents of the object." (format "*%s*" contents)) -(defun org-element-text-markup-successor (limit) +(defun org-element-text-markup-successor () "Search for the next text-markup object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is a symbol among `bold', `italic', `underline', `strike-through', `code' and `verbatim' and CDR is beginning position." (save-excursion (unless (bolp) (backward-char)) - (when (re-search-forward org-emph-re limit t) + (when (re-search-forward org-emph-re nil t) (let ((marker (match-string 3))) (cons (cond ((equal marker "*") 'bold) @@ -2652,11 +2737,9 @@ CONTENTS is nil." (org-element-property :name entity) (when (org-element-property :use-brackets-p entity) "{}"))) -(defun org-element-latex-or-entity-successor (limit) +(defun org-element-latex-or-entity-successor () "Search for the next latex-fragment or entity object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `entity' or `latex-fragment' and CDR is beginning position." (save-excursion @@ -2670,7 +2753,7 @@ Return value is a cons cell whose CAR is `entity' or (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps))) matchers "\\|") "\\|" entity-re) - limit t) + nil t) (goto-char (match-beginning 0)) (if (looking-at entity-re) ;; Determine if it's a real entity or a LaTeX command. @@ -2722,18 +2805,16 @@ CONTENTS is nil." (org-element-property :back-end export-snippet) (org-element-property :value export-snippet))) -(defun org-element-export-snippet-successor (limit) +(defun org-element-export-snippet-successor () "Search for the next export-snippet object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `export-snippet' and CDR its beginning position." (save-excursion (let (beg) - (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t) + (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t) (setq beg (match-beginning 0)) - (search-forward "@@" limit t)) + (search-forward "@@" nil t)) (cons 'export-snippet beg))))) @@ -2789,21 +2870,19 @@ CONTENTS is nil." (concat ":" (org-element-interpret-data inline-def)))))) (format "[%s]" (concat label def)))) -(defun org-element-footnote-reference-successor (limit) +(defun org-element-footnote-reference-successor () "Search for the next footnote-reference object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `footnote-reference' and CDR is beginning position." (save-excursion (catch 'exit - (while (re-search-forward org-footnote-re limit t) + (while (re-search-forward org-footnote-re nil t) (save-excursion (let ((beg (match-beginning 0)) (count 1)) (backward-char) - (while (re-search-forward "[][]" limit t) + (while (re-search-forward "[][]" nil t) (if (equal (match-string 0) "[") (incf count) (decf count)) (when (zerop count) (throw 'exit (cons 'footnote-reference beg)))))))))) @@ -2846,11 +2925,9 @@ CONTENTS is nil." main-source) (and post-options (format "[%s]" post-options))))) -(defun org-element-inline-babel-call-successor (limit) +(defun org-element-inline-babel-call-successor () "Search for the next inline-babel-call object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `inline-babel-call' and CDR is beginning position." (save-excursion @@ -2858,7 +2935,7 @@ CDR is beginning position." ;; `org-babel-inline-lob-one-liner-regexp'. (when (re-search-forward "call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?" - limit t) + nil t) (cons 'inline-babel-call (match-beginning 0))))) @@ -2867,8 +2944,6 @@ CDR is beginning position." (defun org-element-inline-src-block-parser () "Parse inline source block at point. -LIMIT bounds the search. - Return a list whose CAR is `inline-src-block' and CDR a plist with `:begin', `:end', `:language', `:value', `:parameters' and `:post-blank' as keywords. @@ -2903,16 +2978,14 @@ CONTENTS is nil." (if arguments (format "[%s]" arguments) "") body))) -(defun org-element-inline-src-block-successor (limit) +(defun org-element-inline-src-block-successor () "Search for the next inline-babel-call element. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `inline-babel-call' and CDR is beginning position." (save-excursion (unless (bolp) (backward-char)) - (when (re-search-forward org-babel-inline-src-block-regexp limit t) + (when (re-search-forward org-babel-inline-src-block-regexp nil t) (cons 'inline-src-block (match-beginning 1))))) ;;;; Italic @@ -3006,15 +3079,13 @@ Assume point is at the beginning of the line break." CONTENTS is nil." "\\\\\n") -(defun org-element-line-break-successor (limit) +(defun org-element-line-break-successor () "Search for the next line-break object. -LIMIT bounds the search. - 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) + (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t) (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)) @@ -3127,28 +3198,24 @@ CONTENTS is the contents of the object, or nil." raw-link (if contents (format "[%s]" contents) ""))))) -(defun org-element-link-successor (limit) +(defun org-element-link-successor () "Search for the next link object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `link' and CDR is beginning position." (save-excursion (let ((link-regexp (if (not org-target-link-regexp) org-any-link-re (concat org-any-link-re "\\|" org-target-link-regexp)))) - (when (re-search-forward link-regexp limit t) + (when (re-search-forward link-regexp nil t) (cons 'link (match-beginning 0)))))) -(defun org-element-plain-link-successor (limit) +(defun org-element-plain-link-successor () "Search for the next plain link object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `link' and CDR is beginning position." - (and (save-excursion (re-search-forward org-plain-link-re limit t)) + (and (save-excursion (re-search-forward org-plain-link-re nil t)) (cons 'link (match-beginning 0)))) @@ -3196,17 +3263,15 @@ Assume point is at the macro." CONTENTS is nil." (org-element-property :value macro)) -(defun org-element-macro-successor (limit) +(defun org-element-macro-successor () "Search for the next macro object. -LIMIT bounds the search. - 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) + nil t) (cons 'macro (match-beginning 0))))) @@ -3242,15 +3307,13 @@ Assume point is at the radio target." CONTENTS is the contents of the object." (concat "<<<" contents ">>>")) -(defun org-element-radio-target-successor (limit) +(defun org-element-radio-target-successor () "Search for the next radio-target object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `radio-target' and CDR is beginning position." (save-excursion - (when (re-search-forward org-radio-target-regexp limit t) + (when (re-search-forward org-radio-target-regexp nil t) (cons 'radio-target (match-beginning 0))))) @@ -3282,15 +3345,13 @@ Assume point is at the beginning of the statistics-cookie." CONTENTS is nil." (org-element-property :value statistics-cookie)) -(defun org-element-statistics-cookie-successor (limit) +(defun org-element-statistics-cookie-successor () "Search for the next statistics cookie object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `statistics-cookie' and CDR is beginning position." (save-excursion - (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t) + (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t) (cons 'statistics-cookie (match-beginning 0))))) @@ -3363,16 +3424,14 @@ CONTENTS is the contents of the object." (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") contents)) -(defun org-element-sub/superscript-successor (limit) +(defun org-element-sub/superscript-successor () "Search for the next sub/superscript object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is either `subscript' or `superscript' and CDR is beginning position." (save-excursion (unless (bolp) (backward-char)) - (when (re-search-forward org-match-substring-regexp limit t) + (when (re-search-forward org-match-substring-regexp nil t) (cons (if (string= (match-string 2) "_") 'subscript 'superscript) (match-beginning 2))))) @@ -3439,11 +3498,9 @@ and `:post-blank' keywords." CONTENTS is the contents of the cell, or nil." (concat " " contents " |")) -(defun org-element-table-cell-successor (limit) +(defun org-element-table-cell-successor () "Search for the next table-cell object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `table-cell' and CDR is beginning position." (when (looking-at "[ \t]*.*?[ \t]*|") (cons 'table-cell (point)))) @@ -3476,15 +3533,13 @@ Assume point is at the target." CONTENTS is nil." (format "<<%s>>" (org-element-property :value target))) -(defun org-element-target-successor (limit) +(defun org-element-target-successor () "Search for the next target object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `target' and CDR is beginning position." (save-excursion - (when (re-search-forward org-target-regexp limit t) + (when (re-search-forward org-target-regexp nil t) (cons 'target (match-beginning 0))))) @@ -3662,11 +3717,9 @@ CONTENTS is nil." (eq type 'active-range) (and hour-end minute-end))))))))) -(defun org-element-timestamp-successor (limit) +(defun org-element-timestamp-successor () "Search for the next timestamp object. -LIMIT bounds the search. - Return value is a cons cell whose CAR is `timestamp' and CDR is beginning position." (save-excursion @@ -3676,7 +3729,7 @@ beginning position." "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" "\\|" "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") - limit t) + nil t) (cons 'timestamp (match-beginning 0))))) @@ -3758,14 +3811,14 @@ CONTENTS is nil." (limit &optional granularity special structure) "Parse the element starting at point. -LIMIT bounds the search. - Return value is a list like (TYPE PROPS) where TYPE is the type of the element and PROPS a plist of properties associated to the element. Possible types are defined in `org-element-all-elements'. +LIMIT bounds the search. + Optional argument GRANULARITY determines the depth of the recursion. Allowed values are `headline', `greater-element', `element', `object' or nil. When it is broader than `object' (or @@ -3875,7 +3928,8 @@ element it has to parse." ;; List. ((looking-at (org-item-re)) (org-element-plain-list-parser - limit affiliated (or structure (org-list-struct)))) + limit affiliated + (or structure (org-element--list-struct limit)))) ;; Default element: Paragraph. (t (org-element-paragraph-parser limit affiliated))))))))) @@ -4314,57 +4368,56 @@ RESTRICTION is a list of object successors which are allowed in the current object." (let ((candidates 'initial)) (save-excursion - (goto-char beg) - (while (and (< (point) end) - (setq candidates (org-element--get-next-object-candidates - end restriction candidates))) - (let ((next-object - (let ((pos (apply 'min (mapcar 'cdr candidates)))) - (save-excursion - (goto-char pos) - (funcall (intern (format "org-element-%s-parser" - (car (rassq pos candidates))))))))) - ;; 1. Text before any object. Untabify it. - (let ((obj-beg (org-element-property :begin next-object))) - (unless (= (point) obj-beg) - (setq acc - (org-element-adopt-elements - acc - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) obj-beg)))))) - ;; 2. Object... - (let ((obj-end (org-element-property :end next-object)) - (cont-beg (org-element-property :contents-begin next-object))) - ;; Fill contents of NEXT-OBJECT by side-effect, if it has - ;; a recursive type. - (when (and cont-beg - (memq (car next-object) org-element-recursive-objects)) - (save-restriction - (narrow-to-region - cont-beg - (org-element-property :contents-end next-object)) + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (while (and (not (eobp)) + (setq candidates + (org-element--get-next-object-candidates + restriction candidates))) + (let ((next-object + (let ((pos (apply 'min (mapcar 'cdr candidates)))) + (save-excursion + (goto-char pos) + (funcall (intern (format "org-element-%s-parser" + (car (rassq pos candidates))))))))) + ;; 1. Text before any object. Untabify it. + (let ((obj-beg (org-element-property :begin next-object))) + (unless (= (point) obj-beg) + (setq acc + (org-element-adopt-elements + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) obj-beg)))))) + ;; 2. Object... + (let ((obj-end (org-element-property :end next-object)) + (cont-beg (org-element-property :contents-begin next-object))) + ;; Fill contents of NEXT-OBJECT by side-effect, if it has + ;; a recursive type. + (when (and cont-beg + (memq (car next-object) org-element-recursive-objects)) (org-element--parse-objects - (point-min) (point-max) next-object - (org-element-restriction next-object)))) - (setq acc (org-element-adopt-elements acc next-object)) - (goto-char obj-end)))) - ;; 3. Text after last object. Untabify it. - (unless (= (point) end) - (setq acc - (org-element-adopt-elements - acc - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) end))))) - ;; Result. - acc))) - -(defun org-element--get-next-object-candidates (limit restriction objects) + cont-beg (org-element-property :contents-end next-object) + next-object (org-element-restriction next-object))) + (setq acc (org-element-adopt-elements acc next-object)) + (goto-char obj-end)))) + ;; 3. Text after last object. Untabify it. + (unless (eobp) + (setq acc + (org-element-adopt-elements + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) end))))) + ;; Result. + acc)))) + +(defun org-element--get-next-object-candidates (restriction objects) "Return an alist of candidates for the next object. -LIMIT bounds the search, and RESTRICTION narrows candidates to -some object successors. +RESTRICTION is a list of object types, as symbols. Only +candidates with such types are looked after. OBJECTS is the previous candidates alist. If it is set to `initial', no search has been done before, and all symbols in @@ -4379,7 +4432,7 @@ beginning position." ;; allowed in RESTRICTION. (mapcar (lambda (res) - (funcall (intern (format "org-element-%s-successor" res)) limit)) + (funcall (intern (format "org-element-%s-successor" res)))) restriction) ;; Focus on objects returned during last search. Keep those ;; still after point. Search again objects before it. @@ -4390,8 +4443,7 @@ beginning position." (succ (or (cdr (assq type org-element-object-successor-alist)) type))) (and succ - (funcall (intern (format "org-element-%s-successor" succ)) - limit))))) + (funcall (intern (format "org-element-%s-successor" succ))))))) objects)))) @@ -4683,11 +4735,12 @@ first element of current section." (org-back-to-heading) (forward-line) (org-skip-whitespace) - (when (> (line-beginning-position) origin) + (when (or (eobp) (> (line-beginning-position) origin)) ;; In blank lines just after the headline, point still ;; belongs to the headline. (throw 'exit - (progn (org-back-to-heading) + (progn (skip-chars-backward " \r\t\n") + (beginning-of-line) (if (not keep-trail) (org-element-headline-parser (point-max) t) (list (org-element-headline-parser @@ -4728,11 +4781,18 @@ first element of current section." ;; into elements with an explicit ending, but ;; return that element instead. (and (= cend origin) - (memq type - '(center-block - drawer dynamic-block inlinetask item - plain-list property-drawer quote-block - special-block)))) + (or (memq type + '(center-block + drawer dynamic-block inlinetask + property-drawer quote-block + special-block)) + ;; Corner case: if a list ends at the + ;; end of a buffer without a final new + ;; line, return last element in last + ;; item instead. + (and (memq type '(item plain-list)) + (progn (goto-char cend) + (or (bolp) (not (eobp)))))))) (throw 'exit (if keep-trail trail element)) (setq parent element) (case type @@ -4763,103 +4823,109 @@ object type, but always include `:begin', `:end', `:parent' and Optional argument ELEMENT, when non-nil, is the closest element containing point, as returned by `org-element-at-point'. Providing it allows for quicker computation." - (org-with-wide-buffer - (let* ((origin (point)) - (element (or element (org-element-at-point))) - (type (org-element-type element)) - end) - ;; Check if point is inside an element containing objects or at - ;; a secondary string. In that case, move to beginning of the - ;; element or secondary string and set END to the other side. - (if (not (or (let ((post (org-element-property :post-affiliated element))) - (and post (> post origin) - (< (org-element-property :begin element) origin) - (progn (beginning-of-line) - (looking-at org-element--affiliated-re) - (member (upcase (match-string 1)) - org-element-parsed-keywords)) - ;; We're at an affiliated keyword. Change - ;; type to retrieve correct restrictions. - (setq type 'keyword) - ;; Determine if we're at main or dual value. - (if (and (match-end 2) (<= origin (match-end 2))) - (progn (goto-char (match-beginning 2)) - (setq end (match-end 2))) - (goto-char (match-end 0)) - (setq end (line-end-position))))) - (and (eq type 'item) - (let ((tag (org-element-property :tag element))) - (and tag - (progn - (beginning-of-line) - (search-forward tag (point-at-eol)) - (goto-char (match-beginning 0)) - (and (>= origin (point)) - (<= origin - ;; `1+' is required so some - ;; successors can match - ;; properly their object. - (setq end (1+ (match-end 0))))))))) - (and (memq type '(headline inlinetask)) - (progn (beginning-of-line) - (skip-chars-forward "* ") - (setq end (point-at-eol)))) - (and (memq type '(paragraph table-row verse-block)) - (let ((cbeg (org-element-property - :contents-begin element)) - (cend (org-element-property - :contents-end element))) - (and cbeg cend ; cbeg is nil for table rules - (>= origin cbeg) - (<= origin cend) - (progn (goto-char cbeg) (setq end cend))))) - (and (eq type 'keyword) - (let ((key (org-element-property :key element))) - (and (member key org-element-document-properties) - (progn (beginning-of-line) - (search-forward key (line-end-position) t) - (forward-char) - (setq end (line-end-position)))))))) - element + (catch 'objects-forbidden + (org-with-wide-buffer + (let* ((origin (point)) + (element (or element (org-element-at-point))) + (type (org-element-type element)) + context) + ;; Check if point is inside an element containing objects or at + ;; a secondary string. In that case, narrow buffer to the + ;; containing area. Otherwise, return ELEMENT. + (cond + ;; At a parsed affiliated keyword, check if we're inside main + ;; or dual value. + ((let ((post (org-element-property :post-affiliated element))) + (and post (< origin post))) + (beginning-of-line) + (looking-at org-element--affiliated-re) + (cond + ((not (member (upcase (match-string 1)) org-element-parsed-keywords)) + (throw 'objects-forbidden element)) + ((< (match-end 0) origin) + (narrow-to-region (match-end 0) (line-end-position))) + ((and (match-beginning 2) + (>= origin (match-beginning 2)) + (< origin (match-end 2))) + (narrow-to-region (match-beginning 2) (match-end 2))) + (t (throw 'objects-forbidden element))) + ;; Also change type to retrieve correct restrictions. + (setq type 'keyword)) + ;; At an item, objects can only be located within tag, if any. + ((eq type 'item) + (let ((tag (org-element-property :tag element))) + (if (not tag) (throw 'objects-forbidden element) + (beginning-of-line) + (search-forward tag (line-end-position)) + (goto-char (match-beginning 0)) + (if (and (>= origin (point)) (< origin (match-end 0))) + (narrow-to-region (point) (match-end 0)) + (throw 'objects-forbidden element))))) + ;; At an headline or inlinetask, objects are located within + ;; their title. + ((memq type '(headline inlinetask)) + (goto-char (org-element-property :begin element)) + (skip-chars-forward "* ") + (if (and (>= origin (point)) (< origin (line-end-position))) + (narrow-to-region (point) (line-end-position)) + (throw 'objects-forbidden element))) + ;; At a paragraph, a table-row or a verse block, objects are + ;; located within their contents. + ((memq type '(paragraph table-row verse-block)) + (let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + ;; CBEG is nil for table rules. + (if (and cbeg cend (>= origin cbeg) (< origin cend)) + (narrow-to-region cbeg cend) + (throw 'objects-forbidden element)))) + ;; At a parsed keyword, objects are located within value. + ((eq type 'keyword) + (if (not (member (org-element-property :key element) + org-element-document-properties)) + (throw 'objects-forbidden element) + (beginning-of-line) + (search-forward ":") + (if (and (>= origin (point)) (< origin (line-end-position))) + (narrow-to-region (point) (line-end-position)) + (throw 'objects-forbidden element)))) + (t (throw 'objects-forbidden element))) + (goto-char (point-min)) (let ((restriction (org-element-restriction type)) - (parent element) - (candidates 'initial)) - (catch 'exit - (while (setq candidates (org-element--get-next-object-candidates - end restriction candidates)) - (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates)) - candidates))) - ;; If ORIGIN is before next object in element, there's - ;; no point in looking further. - (if (> (cdr closest-cand) origin) (throw 'exit parent) - (let* ((object - (progn (goto-char (cdr closest-cand)) - (funcall (intern (format "org-element-%s-parser" - (car closest-cand)))))) - (cbeg (org-element-property :contents-begin object)) - (cend (org-element-property :contents-end object)) - (obj-end (org-element-property :end object))) - (cond - ;; ORIGIN is after OBJECT, so skip it. - ((<= obj-end origin) - (if (/= obj-end end) (goto-char obj-end) - (throw 'exit - (org-element-put-property - object :parent parent)))) - ;; ORIGIN is within a non-recursive object or at - ;; an object boundaries: Return that object. - ((or (not cbeg) (> cbeg origin) (< cend origin)) - (throw 'exit - (org-element-put-property object :parent parent))) - ;; Otherwise, move within current object and - ;; restrict search to the end of its contents. - (t (goto-char cbeg) - (org-element-put-property object :parent parent) - (setq parent object - restriction (org-element-restriction object) - candidates 'initial - end cend))))))) - parent)))))) + (parent element) + (candidates 'initial)) + (catch 'exit + (while (setq candidates + (org-element--get-next-object-candidates + restriction candidates)) + (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates)) + candidates))) + ;; If ORIGIN is before next object in element, there's + ;; no point in looking further. + (if (> (cdr closest-cand) origin) (throw 'exit parent) + (let* ((object + (progn (goto-char (cdr closest-cand)) + (funcall (intern (format "org-element-%s-parser" + (car closest-cand)))))) + (cbeg (org-element-property :contents-begin object)) + (cend (org-element-property :contents-end object)) + (obj-end (org-element-property :end object))) + (cond + ;; ORIGIN is after OBJECT, so skip it. + ((<= obj-end origin) (goto-char obj-end)) + ;; ORIGIN is within a non-recursive object or at + ;; an object boundaries: Return that object. + ((or (not cbeg) (< origin cbeg) (>= origin cend)) + (throw 'exit + (org-element-put-property object :parent parent))) + ;; Otherwise, move within current object and + ;; restrict search to the end of its contents. + (t (goto-char cbeg) + (narrow-to-region (point) cend) + (org-element-put-property object :parent parent) + (setq parent object + restriction (org-element-restriction object) + candidates 'initial))))))) + parent)))))) (defun org-element-nested-p (elem-A elem-B) "Non-nil when elements ELEM-A and ELEM-B are nested." diff --git a/lisp/org-entities.el b/lisp/org-entities.el index 019b6c8..638da78 100644 --- a/lisp/org-entities.el +++ b/lisp/org-entities.el @@ -154,6 +154,9 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("real" "\\Re" t "ℜ" "R" "R" "ℜ") ("image" "\\Im" t "ℑ" "I" "I" "ℑ") ("weierp" "\\wp" t "℘" "P" "P" "℘") + ("ell" "\\ell" t "ℓ" "ell" "ell" "ℓ") + ("imath" "\\imath" t "ı" "[dotless i]" "dotless i" "ı") + ("jmath" "\\jmath" t "ȷ" "[dotless j]" "dotless j" "ȷ") "** Greek" ("Alpha" "A" nil "Α" "Alpha" "Alpha" "Α") @@ -203,6 +206,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "υ") ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") ("phi" "\\phi" t "φ" "phi" "phi" "φ") + ("varphi" "\\varphi" t "ϕ" "varphi" "varphi" "ɸ") ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") ("chi" "\\chi" t "χ" "chi" "chi" "χ") ("acutex" "\\acute x" t "´x" "'x" "'x" "𝑥́") @@ -212,10 +216,15 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") ("omega" "\\omega" t "ω" "omega" "omega" "ω") ("piv" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") + ("varpi" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "∂") "** Hebrew" ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + ("aleph" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + ("gimel" "\\gimel" t "ℷ" "gimel" "gimel" "ℷ") + ("beth" "\\beth" t "ℶ" "beth" "beth" "ב") + ("dalet" "\\daleth" t "ℸ" "dalet" "dalet" "ד") "** Dead languages" ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") @@ -226,6 +235,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." "* Punctuation" "** Dots and Marks" ("dots" "\\dots{}" nil "…" "..." "..." "…") + ("cdots" "\\cdots{}" t "⋯" "..." "..." "⋯") ("hellip" "\\dots{}" nil "…" "..." "..." "…") ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") ("iexcl" "!`" nil "¡" "!" "¡" "¡") @@ -253,20 +263,23 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." "* Other" "** Misc. (often used)" ("circ" "\\^{}" nil "ˆ" "^" "^" "ˆ") - ("vert" "\\vert{}" t "|" "|" "|" "|") + ("vert" "\\vert{}" t "|" "|" "|" "|") ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") + ("S" "\\S" nil "§" "paragraph" "§" "§") ("sect" "\\S" nil "§" "paragraph" "§" "§") ("amp" "\\&" nil "&" "&" "&" "&") ("lt" "\\textless{}" nil "<" "<" "<" "<") ("gt" "\\textgreater{}" nil ">" ">" ">" ">") - ("tilde" "\\~{}" nil "˜" "~" "~" "~") + ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~") ("slash" "/" nil "/" "/" "/" "/") ("plus" "+" nil "+" "+" "+" "+") ("under" "\\_" nil "_" "_" "_" "_") ("equal" "=" nil "=" "=" "=" "=") ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") + ("dag" "\\dag{}" nil "†" "[dagger]" "[dagger]" "†") ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") + ("ddag" "\\ddag{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") "** Whitespace" ("nbsp" "~" nil " " " " " " " ") @@ -297,6 +310,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") ("times" "\\texttimes{}" nil "×" "*" "×" "×") ("frasl" "/" nil "⁄" "/" "/" "⁄") + ("colon" "\\colon" t ":" ":" ":" ":") ("div" "\\textdiv{}" nil "÷" "/" "÷" "÷") ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") ("frac14" "\\textonequarter{}" nil "¼" "1/4" "¼" "¼") @@ -326,7 +340,9 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("cap" "\\cap" t "∩" "[intersection]" "[intersection]" "∩") ("cup" "\\cup" t "∪" "[union]" "[union]" "∪") ("int" "\\int" t "∫" "[integral]" "[integral]" "∫") + ("therefore" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") ("there4" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") + ("because" "\\because" t "∵" "[because]" "[because]" "∵") ("sim" "\\sim" t "∼" "~" "~" "∼") ("cong" "\\cong" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") ("simeq" "\\simeq" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") @@ -335,8 +351,26 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("ne" "\\ne" t "≠" "[not equal to]" "[not equal to]" "≠") ("neq" "\\neq" t "≠" "[not equal to]" "[not equal to]" "≠") ("equiv" "\\equiv" t "≡" "[identical to]" "[identical to]" "≡") + + ("triangleq" "\\triangleq" t "≜" "[defined to]" "[defined to]" "≜") ("le" "\\le" t "≤" "<=" "<=" "≤") + ("leq" "\\le" t "≤" "<=" "<=" "≤") ("ge" "\\ge" t "≥" ">=" ">=" "≥") + ("geq" "\\ge" t "≥" ">=" ">=" "≥") + ("lessgtr" "\\lessgtr" t "≶" "[less than or greater than]" "[less than or greater than]" "≶") + ("lesseqgtr" "\\lesseqgtr" t "⋚" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚") + ("ll" "\\ll" t "≪" "<<" "<<" "≪") + ("Ll" "\lll" t "⋘" "<<<" "<<<" "⋘") + ("lll" "\lll" t "⋘" "<<<" "<<<" "⋘") + ("gg" "\\gg" t "≫" ">>" ">>" "≫") + ("Gg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") + ("ggg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") + ("prec" "\\prec" t "≺" "[precedes]" "[precedes]" "≺") + ("preceq" "\\preceq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") + ("preccurlyeq" "\\preccurlyeq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") + ("succ" "\\succ" t "≻" "[succeeds]" "[succeeds]" "≻") + ("succeq" "\\succeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") + ("succcurlyeq" "\\succcurlyeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") ("sub" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") ("subset" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") ("sup" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") @@ -345,9 +379,12 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("sube" "\\subseteq" t "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆") ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") ("supe" "\\supseteq" t "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇") + ("setminus" "\\setminus" t "∖" "\" "\" "⧵") ("forall" "\\forall" t "∀" "[for all]" "[for all]" "∀") ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("nexist" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") + ("nexists" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "∅") ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "∅") ("isin" "\\in" t "∈" "[element of]" "[element of]" "∈") @@ -366,6 +403,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("rfloor" "\\rfloor" t "⌋" "[right floor]" "[right floor]" "⌋") ("lang" "\\langle" t "⟨" "<" "<" "⟨") ("rang" "\\rangle" t "⟩" ">" ">" "⟩") + ("hbar" "\\hbar" t "ℏ" "hbar" "hbar" "ℏ") + ("mho" "\\mho" t "℧" "mho" "mho" "℧") "** Arrows" ("larr" "\\leftarrow" t "←" "<-" "<-" "←") @@ -436,7 +475,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ") ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") - ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + ("check" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") "** Miscellaneous (seldom used)" ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") @@ -451,7 +491,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("rlm" "" nil "‏" "" "" "") "** Smilies" - ("smile" "\\smile" t "☺" ":-)" ":-)" "⌣") + ("smile" "\\smile" t "⌣" ":-)" ":-)" "⌣") + ("frown" "\\frown" t "⌢" ":-(" ":-(" "⌢") ("smiley" "\\smiley{}" nil "☺" ":-)" ":-)" "☺") ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "☻") ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "☹") @@ -463,10 +504,11 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") - ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") - ("Diamond" "\\diamond" t "⋄" "[diamond]" "[diamond]" "⋄") - ("loz" "\\diamond" t "◊" "[lozenge]" "[lozenge]" "◊") + ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") + ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") + ("diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") + ("Diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") + ("loz" "\\lozenge" t "◊" "[lozenge]" "[lozenge]" "⧫") ) "Default entities used in Org-mode to produce special characters. For details see `org-entities-user'.") diff --git a/lisp/org-faces.el b/lisp/org-faces.el index 5472964..d64fd0e 100644 --- a/lisp/org-faces.el +++ b/lisp/org-faces.el @@ -217,12 +217,6 @@ column view defines special faces for each outline level. See the file "Face for column display of entry properties." :group 'org-faces) -(when (fboundp 'set-face-attribute) - ;; Make sure that a fixed-width face is used when we have a column table. - (set-face-attribute 'org-column nil - :height (face-attribute 'default :height) - :family (face-attribute 'default :family))) - (defface org-agenda-column-dateline (org-compatible-face 'org-column '((t nil))) @@ -264,7 +258,7 @@ column view defines special faces for each outline level. See the file '((((class color) (background light)) (:foreground "Purple" :underline t)) (((class color) (background dark)) (:foreground "Cyan" :underline t)) (t (:underline t))) - "Face for links." + "Face for footnotes." :group 'org-faces) (defface org-ellipsis diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index b014cd8..3c0d97c 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -166,6 +166,7 @@ The main values of this variable can be set with in-buffer options: #+STARTUP: nofnadjust" :group 'org-footnote :type '(choice + (const :tag "No adjustment" nil) (const :tag "Renumber" renumber) (const :tag "Sort" sort) (const :tag "Renumber and Sort" t))) diff --git a/lisp/org-habit.el b/lisp/org-habit.el index 8465ba4..eba9037 100644 --- a/lisp/org-habit.el +++ b/lisp/org-habit.el @@ -85,6 +85,12 @@ today's agenda, even if they are not scheduled." :version "24.1" :type 'character) +(defcustom org-habit-show-done-always-green nil + "Non-nil means DONE days will always be green in the consistency graph. +It will be green even if it was done after the deadline." + :group 'org-habit + :type 'boolean) + (defface org-habit-clear-face '((((background light)) (:background "#8270f9")) (((background dark)) (:background "blue"))) @@ -272,8 +278,9 @@ Habits are assigned colors on the following basis: (if donep '(org-habit-ready-face . org-habit-ready-future-face) '(org-habit-alert-face . org-habit-alert-future-face))) - (t - '(org-habit-overdue-face . org-habit-overdue-future-face))))) + ((and org-habit-show-done-always-green donep) + '(org-habit-ready-face . org-habit-ready-future-face)) + (t '(org-habit-overdue-face . org-habit-overdue-future-face))))) (defun org-habit-build-graph (habit starting current ending) "Build a graph for the given HABIT, from STARTING to ENDING. diff --git a/lisp/org-id.el b/lisp/org-id.el index 32c05e6..f1fa05b 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -437,6 +437,7 @@ and time is the usual three-integer representation of time." ;; Storing ID locations (files) +;;;###autoload (defun org-id-update-id-locations (&optional files silent) "Scan relevant files for IDs. Store the relation between files and corresponding IDs. @@ -527,7 +528,9 @@ When CHECK is given, prepare detailed information about duplicate IDs." (org-id-hash-to-alist org-id-locations) org-id-locations))) (with-temp-file org-id-locations-file - (print out (current-buffer)))))) + (let ((print-level nil) + (print-length nil)) + (print out (current-buffer))))))) (defun org-id-locations-load () "Read the data from `org-id-locations-file'." diff --git a/lisp/org-list.el b/lisp/org-list.el index 86afe11..1b3c509 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1863,9 +1863,10 @@ Initial position of cursor is restored after the changes." (item-re (org-item-re)) (shift-body-ind (function - ;; Shift the indentation between END and BEG by DELTA. - ;; Start from the line before END. - (lambda (end beg delta) + ;; Shift the indentation between END and BEG by DELTA. If + ;; MAX-IND is non-nil, ensure that no line will be indented + ;; more than that number. Start from the line before END. + (lambda (end beg delta max-ind) (goto-char end) (skip-chars-backward " \r\t\n") (beginning-of-line) @@ -1879,7 +1880,8 @@ Initial position of cursor is restored after the changes." ;; Shift only non-empty lines. ((org-looking-at-p "^[ \t]*\\S-") (let ((i (org-get-indentation))) - (org-indent-line-to (+ i delta))))) + (org-indent-line-to + (if max-ind (min (+ i delta) max-ind) (+ i delta)))))) (forward-line -1))))) (modify-item (function @@ -1915,53 +1917,60 @@ Initial position of cursor is restored after the changes." (indent-to new-ind))))))) ;; 1. First get list of items and position endings. We maintain ;; two alists: ITM-SHIFT, determining indentation shift needed - ;; at item, and END-POS, a pseudo-alist where key is ending + ;; at item, and END-LIST, a pseudo-alist where key is ending ;; position and value point. (let (end-list acc-end itm-shift all-ends sliced-struct) - (mapc (lambda (e) - (let* ((pos (car e)) - (ind-pos (org-list-get-ind pos struct)) - (ind-old (org-list-get-ind pos old-struct)) - (bul-pos (org-list-get-bullet pos struct)) - (bul-old (org-list-get-bullet pos old-struct)) - (ind-shift (- (+ ind-pos (length bul-pos)) - (+ ind-old (length bul-old)))) - (end-pos (org-list-get-item-end pos old-struct))) - (push (cons pos ind-shift) itm-shift) - (unless (assq end-pos old-struct) - ;; To determine real ind of an ending position that - ;; is not at an item, we have to find the item it - ;; belongs to: it is the last item (ITEM-UP), whose - ;; ending is further than the position we're - ;; interested in. - (let ((item-up (assoc-default end-pos acc-end '>))) - (push (cons end-pos item-up) end-list))) - (push (cons end-pos pos) acc-end))) - old-struct) + (dolist (e old-struct) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (ind-old (org-list-get-ind pos old-struct)) + (bul-pos (org-list-get-bullet pos struct)) + (bul-old (org-list-get-bullet pos old-struct)) + (ind-shift (- (+ ind-pos (length bul-pos)) + (+ ind-old (length bul-old)))) + (end-pos (org-list-get-item-end pos old-struct))) + (push (cons pos ind-shift) itm-shift) + (unless (assq end-pos old-struct) + ;; To determine real ind of an ending position that + ;; is not at an item, we have to find the item it + ;; belongs to: it is the last item (ITEM-UP), whose + ;; ending is further than the position we're + ;; interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (push (cons end-pos item-up) end-list))) + (push (cons end-pos pos) acc-end))) ;; 2. Slice the items into parts that should be shifted by the - ;; same amount of indentation. The slices are returned in - ;; reverse order so changes modifying buffer do not change - ;; positions they refer to. + ;; same amount of indentation. Each slice follow the pattern + ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in + ;; reverse order. (setq all-ends (sort (append (mapcar 'car itm-shift) (org-uniquify (mapcar 'car end-list))) '<)) (while (cdr all-ends) (let* ((up (pop all-ends)) (down (car all-ends)) - (ind (if (assq up struct) - (cdr (assq up itm-shift)) - (cdr (assq (cdr (assq up end-list)) itm-shift))))) - (push (list down up ind) sliced-struct))) + (itemp (assq up struct)) + (item (if itemp up (cdr (assq up end-list)))) + (ind (cdr (assq item itm-shift))) + ;; If we're not at an item, there's a child of the item + ;; point belongs to above. Make sure this slice isn't + ;; moved within that child by specifying a maximum + ;; indentation. + (max-ind (and (not itemp) + (+ (org-list-get-ind item struct) + (length (org-list-get-bullet item struct)) + org-list-indent-offset)))) + (push (list down up ind max-ind) sliced-struct))) ;; 3. Shift each slice in buffer, provided delta isn't 0, from ;; end to beginning. Take a special action when beginning is ;; at item bullet. - (mapc (lambda (e) - (unless (zerop (nth 2 e)) (apply shift-body-ind e)) - (let* ((beg (nth 1 e)) - (cell (assq beg struct))) - (unless (or (not cell) (equal cell (assq beg old-struct))) - (funcall modify-item beg)))) - sliced-struct)) + (dolist (e sliced-struct) + (unless (and (zerop (nth 2 e)) (not (nth 3 e))) + (apply shift-body-ind e)) + (let* ((beg (nth 1 e)) + (cell (assq beg struct))) + (unless (or (not cell) (equal cell (assq beg old-struct))) + (funcall modify-item beg))))) ;; 4. Go back to initial position and clean marker. (goto-char origin) (move-marker origin nil))) @@ -2799,13 +2808,14 @@ optional argument WITH-CASE, the sorting considers case as well. The command prompts for the sorting type unless it has been given to the function through the SORTING-TYPE argument, which needs to -be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise -meaning of each character: +be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the +detailed meaning of each character: n Numerically, by converting the beginning of the item to a number. a Alphabetically. Only the first line of item is checked. t By date/time, either the first active time stamp in the entry, if any, or by the first inactive one. In a timer list, sort the timers. +x By \"checked\" status of a check list. Capital letters will reverse the sort order. @@ -2827,7 +2837,7 @@ ignores hidden links." (or sorting-type (progn (message - "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") + "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:") (read-char-exclusive)))) (getkey-func (or getkey-func @@ -2844,7 +2854,8 @@ ignores hidden links." (sort-func (cond ((= dcst ?a) 'string<) ((= dcst ?f) compare-func) - ((= dcst ?t) '<))) + ((= dcst ?t) '<) + ((= dcst ?x) 'string<))) (next-record (lambda () (skip-chars-forward " \r\t\n") (or (eobp) (beginning-of-line)))) @@ -2875,6 +2886,9 @@ ignores hidden links." (point-at-eol) t))) (org-time-string-to-seconds (match-string 0))) (t (org-float-time now)))) + ((= dcst ?x) (or (and (stringp (match-string 1)) + (match-string 1)) + "")) ((= dcst ?f) (if getkey-func (let ((value (funcall getkey-func))) diff --git a/lisp/org-loaddefs.el b/lisp/org-loaddefs.el index f911927..0862dcb 100644 --- a/lisp/org-loaddefs.el +++ b/lisp/org-loaddefs.el @@ -14,7 +14,7 @@ ;;;;;; org-babel-pop-to-session-maybe org-babel-load-in-session-maybe ;;;;;; org-babel-expand-src-block-maybe org-babel-view-src-block-info ;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob-core" -;;;;;; "ob-core.el" "e079d8aba02a20a56288a4ed1f86d604") +;;;;;; "ob-core.el" "5020331fabde60f15398bf24d3981977") ;;; Generated autoloads from ob-core.el (autoload 'org-babel-execute-safely-maybe "ob-core" "\ @@ -240,7 +240,7 @@ Describe all keybindings behind `org-babel-key-prefix'. ;;;*** ;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe) -;;;;;; "ob-lob" "ob-lob.el" "be09335287121c6bf4403a57f3244b94") +;;;;;; "ob-lob" "ob-lob.el" "d94d0930566ed1471ffe0d04603ac1bc") ;;; Generated autoloads from ob-lob.el (autoload 'org-babel-lob-execute-maybe "ob-lob" "\ @@ -258,7 +258,7 @@ Return a Library of Babel function call as a string. ;;;*** ;;;### (autoloads (org-babel-tangle org-babel-tangle-file) "ob-tangle" -;;;;;; "ob-tangle.el" "f2e6212ecf8512d3893e6198962eb888") +;;;;;; "ob-tangle.el" "4be192fcb6c6b0ed49ed439b74cbc014") ;;; Generated autoloads from ob-tangle.el (autoload 'org-babel-tangle-file "ob-tangle" "\ @@ -290,7 +290,7 @@ used to limit the exported source code blocks by language. ;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views ;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda ;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org-agenda.el" -;;;;;; (20959 48141)) +;;;;;; (21065 1984)) ;;; Generated autoloads from org-agenda.el (autoload 'org-toggle-sticky-agenda "org-agenda" "\ @@ -598,7 +598,7 @@ This command is set with the variable `org-archive-default-command'. ;;;*** -;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "0f042777440a0b6677b74d048cc07bba") +;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "2acf3dc22dcf986b2dbf07e1c0f4bba4") ;;; Generated autoloads from org-attach.el (autoload 'org-attach "org-attach" "\ @@ -621,8 +621,8 @@ Extract anniversaries from BBDB for display in the agenda. ;;;*** ;;;### (autoloads (org-capture-import-remember-templates org-capture -;;;;;; org-capture-string) "org-capture" "org-capture.el" (20959 -;;;;;; 48141)) +;;;;;; org-capture-string) "org-capture" "org-capture.el" (21034 +;;;;;; 2917)) ;;; Generated autoloads from org-capture.el (autoload 'org-capture-string "org-capture" "\ @@ -667,7 +667,7 @@ Set `org-capture-templates' to be similar to `org-remember-templates'. ;;;### (autoloads (org-dblock-write:clocktable org-clock-report org-clock-get-clocktable ;;;;;; org-clock-display org-clock-sum org-clock-goto org-clock-cancel ;;;;;; org-clock-out org-clock-in-last org-clock-in org-resolve-clocks) -;;;;;; "org-clock" "org-clock.el" "dc41f9f7d7c12101c0f61cfa3276c451") +;;;;;; "org-clock" "org-clock.el" "f999bab8b47b8a6252326354ab4c7908") ;;; Generated autoloads from org-clock.el (autoload 'org-resolve-clocks "org-clock" "\ @@ -769,7 +769,7 @@ Write the standard clocktable. ;;;*** ;;;### (autoloads (org-agenda-columns org-insert-columns-dblock org-dblock-write:columnview -;;;;;; org-columns) "org-colview" "org-colview.el" (20959 48141)) +;;;;;; org-columns) "org-colview" "org-colview.el" (21055 52523)) ;;; Generated autoloads from org-colview.el (autoload 'org-columns "org-colview" "\ @@ -813,7 +813,7 @@ Turn on or update column view in the agenda. ;;;*** ;;;### (autoloads (org-check-version) "org-compat" "org-compat.el" -;;;;;; (20959 48141)) +;;;;;; (21034 2917)) ;;; Generated autoloads from org-compat.el (autoload 'org-check-version "org-compat" "\ @@ -838,7 +838,7 @@ tree can be found. ;;;*** ;;;### (autoloads (org-element-context org-element-at-point org-element-interpret-data) -;;;;;; "org-element" "org-element.el" "63f37029da475dfaf7d33aa9b1ced9fa") +;;;;;; "org-element" "org-element.el" "40963ed55ee478e87d9b5d7252b51b9d") ;;; Generated autoloads from org-element.el (autoload 'org-element-interpret-data "org-element" "\ @@ -928,7 +928,7 @@ Show the raw feed buffer of a feed. ;;;*** ;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote" -;;;;;; "org-footnote.el" "0c5e60ed6c35672fea1ddebc70d622d7") +;;;;;; "org-footnote.el" "498ce4bcc019503ef9657f915606b130") ;;; Generated autoloads from org-footnote.el (autoload 'org-footnote-action "org-footnote" "\ @@ -959,9 +959,9 @@ referenced sequence. ;;;*** -;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-find -;;;;;; org-id-goto org-id-get org-id-get-create) "org-id" "org-id.el" -;;;;;; "7b374ed9fe87717fa9c66320c507cd02") +;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-update-id-locations +;;;;;; org-id-find org-id-goto org-id-get org-id-get-create) "org-id" +;;;;;; "org-id.el" "058cecf9786ef0ba525ed56f747a79e0") ;;; Generated autoloads from org-id.el (autoload 'org-id-get-create "org-id" "\ @@ -995,6 +995,16 @@ With optional argument MARKERP, return the position as a new marker. \(fn ID &optional MARKERP)" nil nil) +(autoload 'org-id-update-id-locations "org-id" "\ +Scan relevant files for IDs. +Store the relation between files and corresponding IDs. +This will scan all agenda files, all associated archives, and all +files currently mentioned in `org-id-locations'. +When FILES is given, scan these files instead. +When CHECK is given, prepare detailed information about duplicate IDs. + +\(fn &optional FILES SILENT)" t nil) + (autoload 'org-id-find-id-file "org-id" "\ Query the id database for the file in which this ID is located. @@ -1036,7 +1046,7 @@ Dispatch to the appropriate function to store a link to an IRC session. ;;;*** ;;;### (autoloads (org-load-noerror-mustsuffix) "org-macs" "org-macs.el" -;;;;;; (20959 48141)) +;;;;;; (21034 2917)) ;;; Generated autoloads from org-macs.el (autoload 'org-load-noerror-mustsuffix "org-macs" "\ @@ -1047,7 +1057,7 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a ;;;*** ;;;### (autoloads (org-mobile-pull org-mobile-push) "org-mobile" -;;;;;; "org-mobile.el" "385f6e8212babd40eb1d232951b3aa53") +;;;;;; "org-mobile.el" "c69640ad752b53de4ac6874cbf252ec2") ;;; Generated autoloads from org-mobile.el (autoload 'org-mobile-push "org-mobile" "\ @@ -1098,7 +1108,7 @@ line directly before or after the table. ;;;;;; org-table-justify-field-maybe org-table-align org-table-export ;;;;;; org-table-import org-table-convert-region org-table-create ;;;;;; org-table-create-or-convert-from-region org-table-create-with-table\.el) -;;;;;; "org-table" "org-table.el" "62264557dc8b58dedacbfeabf2b684de") +;;;;;; "org-table" "org-table.el" "3c271d409dab6979db5a32f1f13820f5") ;;; Generated autoloads from org-table.el (autoload 'org-table-create-with-table\.el "org-table" "\ @@ -1692,7 +1702,7 @@ provide ORGTBL directives for the generated table. ;;;*** ;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region -;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "24d58bf234f548224d83186703c58ff0") +;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "c0a04a9b6c18954e7eadb2f39ca2e805") ;;; Generated autoloads from org-timer.el (autoload 'org-timer-start "org-timer" "\ @@ -1753,7 +1763,7 @@ replace any running timer. ;;;*** ;;;### (autoloads (org-git-version org-release) "org-version" "org-version.el" -;;;;;; (20987 50561)) +;;;;;; (21066 16879)) ;;; Generated autoloads from org-version.el (autoload 'org-release "org-version" "\ @@ -1779,7 +1789,7 @@ The location of ODT styles.") ;;;;;; org-run-like-in-org-mode turn-on-orgstruct++ turn-on-orgstruct ;;;;;; orgstruct-mode org-global-cycle org-cycle org-mode org-clock-persistence-insinuate ;;;;;; turn-on-orgtbl org-version org-babel-load-file org-babel-do-load-languages) -;;;;;; "org" "org.el" (20981 63218)) +;;;;;; "org" "org.el" (21055 52523)) ;;; Generated autoloads from org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -2002,7 +2012,7 @@ Call the customize function with org as argument. ;;;### (autoloads (org-ascii-publish-to-utf8 org-ascii-publish-to-latin1 ;;;;;; org-ascii-publish-to-ascii org-ascii-export-to-ascii org-ascii-export-as-ascii) -;;;;;; "ox-ascii" "ox-ascii.el" "5f7a6cd3b95f22ce8e88639a2b243fce") +;;;;;; "ox-ascii" "ox-ascii.el" "31dee5d02171d258b9bb18ee9aa5312a") ;;; Generated autoloads from ox-ascii.el (autoload 'org-ascii-export-as-ascii "ox-ascii" "\ @@ -2105,7 +2115,7 @@ Return output file name. ;;;### (autoloads (org-beamer-publish-to-pdf org-beamer-publish-to-latex ;;;;;; org-beamer-insert-options-template org-beamer-select-environment ;;;;;; org-beamer-export-to-pdf org-beamer-export-to-latex org-beamer-export-as-latex -;;;;;; org-beamer-mode) "ox-beamer" "ox-beamer.el" "11dab554b2c2ee20a9a438bc326e8d50") +;;;;;; org-beamer-mode) "ox-beamer" "ox-beamer.el" "5c4d3f062f8733a52c5db34802d9cd3e") ;;; Generated autoloads from ox-beamer.el (autoload 'org-beamer-mode "ox-beamer" "\ @@ -2247,7 +2257,7 @@ Return output file name. ;;;### (autoloads (org-html-publish-to-html org-html-export-to-html ;;;;;; org-html-convert-region-to-html org-html-export-as-html org-html-htmlize-generate-css) -;;;;;; "ox-html" "ox-html.el" "c2b19e22435d430bf1593bea56e42027") +;;;;;; "ox-html" "ox-html.el" "34ee110c82e50b2994c7404c69f5b0a0") ;;; Generated autoloads from ox-html.el (put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) @@ -2355,7 +2365,7 @@ Return output file name. ;;;### (autoloads (org-icalendar-combine-agenda-files org-icalendar-export-agenda-files ;;;;;; org-icalendar-export-to-ics) "ox-icalendar" "ox-icalendar.el" -;;;;;; "c6f84f8db517191e8801d63586766cf9") +;;;;;; "02da3bde4cd0abae11ec2334c0b3c83e") ;;; Generated autoloads from ox-icalendar.el (autoload 'org-icalendar-export-to-ics "ox-icalendar" "\ @@ -2407,7 +2417,7 @@ The file is stored under the name chosen in ;;;### (autoloads (org-latex-publish-to-pdf org-latex-publish-to-latex ;;;;;; org-latex-export-to-pdf org-latex-export-to-latex org-latex-convert-region-to-latex -;;;;;; org-latex-export-as-latex) "ox-latex" "ox-latex.el" "f52187024b023fd6440cf60e6ae07fc9") +;;;;;; org-latex-export-as-latex) "ox-latex" "ox-latex.el" "a33b28d484ae85af5b338e9ef175718e") ;;; Generated autoloads from ox-latex.el (autoload 'org-latex-export-as-latex "ox-latex" "\ @@ -2476,8 +2486,6 @@ EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -Return output file's name. - \(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) (autoload 'org-latex-export-to-pdf "ox-latex" "\ @@ -2535,7 +2543,7 @@ Return output file name. ;;;*** ;;;### (autoloads (org-md-export-to-markdown org-md-convert-region-to-md -;;;;;; org-md-export-as-markdown) "ox-md" "ox-md.el" "262746b5e61bae2dd8fa7b41a62f0b43") +;;;;;; org-md-export-as-markdown) "ox-md" "ox-md.el" "9613796f5e2e5a59ccd56f1fb52df3c7") ;;; Generated autoloads from ox-md.el (autoload 'org-md-export-as-markdown "ox-md" "\ @@ -2597,7 +2605,7 @@ Return output file's name. ;;;*** ;;;### (autoloads (org-odt-convert org-odt-export-to-odt org-odt-export-as-odf-and-open -;;;;;; org-odt-export-as-odf) "ox-odt" "ox-odt.el" "39cfdee79dd956aaa2c77d9fcbd784f8") +;;;;;; org-odt-export-as-odf) "ox-odt" "ox-odt.el" "d211042456ad899332c26ca9dcad8724") ;;; Generated autoloads from ox-odt.el (put 'org-odt-preferred-output-format 'safe-local-variable 'stringp) @@ -2660,7 +2668,7 @@ using `org-open-file'. ;;;*** ;;;### (autoloads (org-org-publish-to-org org-org-export-to-org org-org-export-as-org) -;;;;;; "ox-org" "ox-org.el" "f98bca16d7ddf4ac4fae1846af828ddf") +;;;;;; "ox-org" "ox-org.el" "0b39e4bd2eb545309d3495257b1ced80") ;;; Generated autoloads from ox-org.el (autoload 'org-org-export-as-org "ox-org" "\ @@ -2734,7 +2742,7 @@ Return output file name. ;;;### (autoloads (org-publish-current-project org-publish-current-file ;;;;;; org-publish-all org-publish) "ox-publish" "ox-publish.el" -;;;;;; "d325ba3d14653089f60939fd3886e5ff") +;;;;;; "5ece54cc06ba971c01450eb7a8359e21") ;;; Generated autoloads from ox-publish.el (defalias 'org-publish-project 'org-publish) @@ -2778,7 +2786,7 @@ the project. ;;;*** ;;;### (autoloads (org-texinfo-convert-region-to-texinfo org-texinfo-publish-to-texinfo) -;;;;;; "ox-texinfo" "ox-texinfo.el" "cab6e0b3aba287d44098955a1cbbff8e") +;;;;;; "ox-texinfo" "ox-texinfo.el" "84c96e4b93249af64d8e4a3959149d33") ;;; Generated autoloads from ox-texinfo.el (autoload 'org-texinfo-publish-to-texinfo "ox-texinfo" "\ @@ -2802,14 +2810,18 @@ this command to convert it. ;;;*** -;;;### (autoloads (org-export-dispatch org-export-insert-default-template -;;;;;; org-export-replace-region-by org-export-string-as org-export-to-file -;;;;;; org-export-to-buffer org-export-as) "ox" "ox.el" "4f0b60e1ffe1fa2295371b17a6d6e885") +;;;### (autoloads (org-export-dispatch org-export-to-file org-export-to-buffer +;;;;;; org-export-insert-default-template org-export-replace-region-by +;;;;;; org-export-string-as org-export-as) "ox" "ox.el" "76fb6fbf6c207c4514de682af5006106") ;;; Generated autoloads from ox.el (autoload 'org-export-as "ox" "\ Transcode current Org buffer into BACKEND code. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + If narrowing is active in the current buffer, only transcode its narrowed part. @@ -2833,41 +2845,13 @@ Return code as a string. \(fn BACKEND &optional SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" nil nil) -(autoload 'org-export-to-buffer "ox" "\ -Call `org-export-as' with output to a specified buffer. - -BACKEND is the back-end used for transcoding, as a symbol. - -BUFFER is the output buffer. If it already exists, it will be -erased first, otherwise, it will be created. - -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and -EXT-PLIST are similar to those used in `org-export-as', which -see. - -Depending on `org-export-copy-to-kill-ring', add buffer contents -to kill ring. Return buffer. - -\(fn BACKEND BUFFER &optional SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" nil nil) - -(autoload 'org-export-to-file "ox" "\ -Call `org-export-as' with output to a specified file. - -BACKEND is the back-end used for transcoding, as a symbol. FILE -is the name of the output file, as a string. - -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and -EXT-PLIST are similar to those used in `org-export-as', which -see. - -Depending on `org-export-copy-to-kill-ring', add file contents -to kill ring. Return output file's name. - -\(fn BACKEND FILE &optional SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" nil nil) - (autoload 'org-export-string-as "ox" "\ Transcode STRING into BACKEND code. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + When optional argument BODY-ONLY is non-nil, only return body code, without preamble nor postamble. @@ -2881,22 +2865,94 @@ Return code as a string. (autoload 'org-export-replace-region-by "ox" "\ Replace the active region by its export to BACKEND. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. \(fn BACKEND)" nil nil) (autoload 'org-export-insert-default-template "ox" "\ Insert all export keywords with default values at beginning of line. -BACKEND is a symbol representing the export back-end for which -specific export options should be added to the template, or -`default' for default template. When it is nil, the user will be -prompted for a category. +BACKEND is a symbol referring to the name of a registered export +back-end, for which specific export options should be added to +the template, or `default' for default template. When it is nil, +the user will be prompted for a category. If SUBTREEP is non-nil, export configuration will be set up locally for the subtree through node properties. \(fn &optional BACKEND SUBTREEP)" t nil) +(autoload 'org-export-to-buffer "ox" "\ +Call `org-export-as' with output to a specified buffer. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +BUFFER is the name of the output buffer. If it already exists, +it will be erased first, otherwise, it will be created. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should then be accessible +through the `org-export-stack' interface. When ASYNC is nil, the +buffer is displayed if `org-export-show-temporary-export-buffer' +is non-nil. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is a function which should accept +no argument. It is always called within the current process, +from BUFFER, with point at its beginning. Export back-ends can +use it to set a major mode there, e.g, + + (defun org-latex-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) + (interactive) + (org-export-to-buffer 'latex \"*Org LATEX Export*\" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +This function returns BUFFER. + +\(fn BACKEND BUFFER &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) + +(autoload 'org-export-to-file "ox" "\ +Call `org-export-as' with output to a specified file. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. FILE is the name of the output file, as +a string. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer file then be accessible +through the `org-export-stack' interface. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is called with FILE as its +argument and happens asynchronously when ASYNC is non-nil. It +has to return a file name, or nil. Export back-ends can use this +to send the output file through additional processing, e.g, + + (defun org-latex-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) + (interactive) + (let ((outfile (org-export-output-file-name \".tex\" subtreep))) + (org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))) + +The function returns either a file name returned by POST-PROCESS, +or FILE. + +\(fn BACKEND FILE &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) + (autoload 'org-export-dispatch "ox" "\ Export dispatcher for Org mode. diff --git a/lisp/org-macro.el b/lisp/org-macro.el index 153b3b1..fa74d83 100644 --- a/lisp/org-macro.el +++ b/lisp/org-macro.el @@ -37,12 +37,14 @@ ;; {{{email}}} and {{{title}}} macros. ;;; Code: +(require 'org-macs) (declare-function org-element-at-point "org-element" (&optional keep-trail)) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) (declare-function org-remove-double-quotes "org" (s)) +(declare-function org-mode "org" ()) (declare-function org-file-contents "org" (file &optional noerror)) (declare-function org-with-wide-buffer "org-macs" (&rest body)) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index cc837d0..0083d29 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -33,7 +33,9 @@ (eval-and-compile (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly))) + (defmacro declare-function (fn file &optional arglist fileonly) + `(autoload ',fn ,file))) + (if (>= emacs-major-version 23) (defsubst org-char-to-string(c) "Defsubst to decode UTF-8 character values in emacs 23 and beyond." diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el index 48767b7..7d6e4ec 100644 --- a/lisp/org-mhe.el +++ b/lisp/org-mhe.el @@ -30,6 +30,7 @@ ;;; Code: +(require 'org-macs) (require 'org) ;; Customization variables diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 7cdaf34..a43896b 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -319,23 +319,24 @@ create all custom agenda views, for upload to the mobile phone." (org-agenda-tag-filter org-agenda-tag-filter) (org-agenda-redo-command org-agenda-redo-command)) (save-excursion - (save-window-excursion - (run-hooks 'org-mobile-pre-push-hook) - (org-mobile-check-setup) - (org-mobile-prepare-file-lists) - (message "Creating agendas...") - (let ((inhibit-redisplay t) - (org-agenda-files (mapcar 'car org-mobile-files-alist))) - (org-mobile-create-sumo-agenda)) - (message "Creating agendas...done") - (org-save-all-org-buffers) ; to save any IDs created by this process - (message "Copying files...") - (org-mobile-copy-agenda-files) - (message "Writing index file...") - (org-mobile-create-index-file) - (message "Writing checksums...") - (org-mobile-write-checksums) - (run-hooks 'org-mobile-post-push-hook))) + (save-restriction + (save-window-excursion + (run-hooks 'org-mobile-pre-push-hook) + (org-mobile-check-setup) + (org-mobile-prepare-file-lists) + (message "Creating agendas...") + (let ((inhibit-redisplay t) + (org-agenda-files (mapcar 'car org-mobile-files-alist))) + (org-mobile-create-sumo-agenda)) + (message "Creating agendas...done") + (org-save-all-org-buffers) ; to save any IDs created by this process + (message "Copying files...") + (org-mobile-copy-agenda-files) + (message "Writing index file...") + (org-mobile-create-index-file) + (message "Writing checksums...") + (org-mobile-write-checksums) + (run-hooks 'org-mobile-post-push-hook)))) (setq org-agenda-buffer-name org-agenda-curbuf-name org-agenda-this-buffer-name org-agenda-curbuf-name)) (redraw-display) diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index e464684..77f68f4 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -36,7 +36,7 @@ (declare-function org-split-string "org" (string &optional separators)) (declare-function org-make-org-heading-search-string "org" - (&optional string heading)) + (&optional string)) (declare-function org-get-buffer-tags "org" ()) (declare-function org-get-tags "org" ()) (declare-function org-buffer-property-keys "org" @@ -257,6 +257,8 @@ When completing for #+STARTUP, for example, this function returns (file-name-nondirectory visited-file))) (buffer-name (buffer-base-buffer))))))) + +(declare-function org-export-backend-options "org-export" (cl-x)) (defun pcomplete/org-mode/file-option/options () "Complete arguments for the #+OPTIONS file option." (while (pcomplete-here @@ -269,9 +271,9 @@ When completing for #+STARTUP, for example, this function returns "|:" "tags:" "tasks:" "<:" "todo:") ;; OPTION items from registered back-ends. (let (items) - (dolist (back-end (org-bound-and-true-p - org-export-registered-backends)) - (dolist (option (plist-get (cdr back-end) :options-alist)) + (dolist (backend (org-bound-and-true-p + org-export--registered-backends)) + (dolist (option (org-export-backend-options backend)) (let ((item (nth 2 option))) (when item (push (concat item ":") items))))) items)))))) @@ -324,7 +326,7 @@ This needs more work, to handle headings with lots of spaces in them." (let (tbl) (while (re-search-forward org-todo-line-regexp nil t) (push (org-make-org-heading-search-string - (match-string-no-properties 3) t) + (match-string-no-properties 3)) tbl)) (pcomplete-uniqify-list tbl))) (substring pcomplete-stub 1)))) @@ -394,7 +396,7 @@ Complete a language in the first field, the header arguments and switches." '("-n" "-r" "-l" ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" - ":session" ":shebang" ":tangle" ":var")))) + ":session" ":shebang" ":tangle" ":tangle-mode" ":var")))) (defun pcomplete/org-mode/block-option/clocktable () "Complete keywords in a clocktable line." diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index d676c39..24a319d 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -265,7 +265,7 @@ Here is an example: This is usually a single character string but can also be a string with two characters." :group 'org-protocol - :type 'string) + :type '(choice (const nil) (string))) (defcustom org-protocol-data-separator "/+\\|\\?" "The default data separator to use. diff --git a/lisp/org-src.el b/lisp/org-src.el index 81b8e40..062d2d7 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -179,7 +179,7 @@ but which mess up the display of a snippet in Org exported files.") (defcustom org-src-lang-modes '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) - ("calc" . fundamental) ("C" . c) ("cpp" . c++) + ("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++) ("screen" . shell-script)) "Alist mapping languages to their major mode. The key is the language name, the value is the string that should @@ -757,6 +757,8 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." (delete-region beg (max beg end)) (unless (string-match "\\`[ \t]*\\'" code) (insert code)) + ;; Make sure the overlay stays in place + (when (eq context 'save) (move-overlay ovl beg (point))) (goto-char beg) (if single (just-one-space)))) (if (memq t (mapcar (lambda (overlay) diff --git a/lisp/org-table.el b/lisp/org-table.el index c5a3aca..246cf8d 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -94,6 +94,22 @@ this variable requires a restart of Emacs to become effective." | | | ")) "Templates for radio tables in different major modes. +Each template must define lines that will be treated as a comment and that +must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\" +lines where \"%n\" will be replaced with the name of the table during +insertion of the tempate. The transformed table will later be inserted +between these lines. + +The template should also contain a minimal table in a multiline comment. +If multiline comments are not possible in the buffer language, +you can pack it into a string that will not be used when the code +is compiled or executed. Above the table will you need a line with +the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to +convert the table into a data structure useful in the +language of the buffer. Check the manual for the section on +\"Translator functions\", and more generally check out +http://orgmode.org/manual/Tables-in-arbitrary-syntax.html#Tables-in-arbitrary-syntax + All occurrences of %n in a template will be replaced with the name of the table, obtained by prompting the user." :group 'org-table @@ -419,68 +435,38 @@ available parameters." (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) -(defvar org-table-colgroup-info nil) ; Dynamically scoped. +(defvar org-table-clean-did-remove-column nil) ; dynamically scoped (defun org-table-clean-before-export (lines &optional maybe-quoted) "Check if the table has a marking column. If yes remove the column and the special lines." - (setq org-table-colgroup-info nil) - (if (memq nil - (mapcar - (lambda (x) (or (string-match "^[ \t]*|-" x) - (string-match - (if maybe-quoted - "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|" - "^[ \t]*| *\\([\#!$*_^ /]\\) *|") - x))) - lines)) - ;; No special marking column - (progn - (setq org-table-clean-did-remove-column nil) - (delq nil - (mapcar - (lambda (x) - (cond - ((org-table-colgroup-line-p x) - ;; This line contains colgroup info, extract it - ;; and then discard the line - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (org-split-string x "[ \t]*|[ \t]*"))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it - nil) - (t x))) - lines))) - ;; there is a special marking column - (setq org-table-clean-did-remove-column t) + (let ((special (if maybe-quoted + "^[ \t]*| *\\\\?[\#!$*_^/ ] *|" + "^[ \t]*| *[\#!$*_^/ ] *|")) + (ignore (if maybe-quoted + "^[ \t]*| *\\\\?[!$_^/] *|" + "^[ \t]*| *[!$_^/] *|"))) + (setq org-table-clean-did-remove-column + (not (memq nil + (mapcar + (lambda (line) + (or (string-match org-table-hline-regexp line) + (string-match special line))) + lines)))) (delq nil (mapcar - (lambda (x) + (lambda (line) (cond - ((org-table-colgroup-line-p x) - ;; This line contains colgroup info, extract it - ;; and then discard the line - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (cdr (org-split-string x "[ \t]*|[ \t]*")))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it + ((or (org-table-colgroup-line-p line) ;; colgroup info + (org-table-cookie-line-p line) ;; formatting cookies + (and org-table-clean-did-remove-column + (string-match ignore line))) ;; non-exportable data nil) - ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x) - ;; ignore this line - nil) - ((or (string-match "^\\([ \t]*\\)|-+\\+" x) - (string-match "^\\([ \t]*\\)|[^|]*|" x)) + ((and org-table-clean-did-remove-column + (or (string-match "^\\([ \t]*\\)|-+\\+" line) + (string-match "^\\([ \t]*\\)|[^|]*|" line))) ;; remove the first column - (replace-match "\\1|" t nil x)))) + (replace-match "\\1|" t nil line)) + (t line))) lines)))) (defconst org-table-translate-regexp @@ -567,7 +553,7 @@ nil When nil, the command tries to be smart and figure out the - when each line contains a TAB, assume TAB-separated material - when each line contains a comma, assume CSV material - else, assume one or more SPACE characters as separator." - (interactive "rP") + (interactive "r\nP") (let* ((beg (min beg0 end0)) (end (max beg0 end0)) re) @@ -2750,7 +2736,7 @@ $xyz-> %s @r$c-> %s $1-> %s\n" orig formula form0 form)) (if (listp ev) - (princ (format " %s^\nError: %s" + (princ (format " %s^\nError: %s" (make-string (car ev) ?\-) (nth 1 ev))) (princ (format "Result: %s\nFormat: %s\nFinal: %s" ev (or fmt "NONE") @@ -4407,30 +4393,6 @@ overwritten, and the table is not marked as requiring realignment." (defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" "Regular expression matching exponentials as produced by calc.") -(defun orgtbl-export (table target) - (let ((func (intern (concat "orgtbl-to-" (symbol-name target)))) - (lines (org-split-string table "[ \t]*\n[ \t]*")) - org-table-last-alignment org-table-last-column-widths - maxcol column) - (if (not (fboundp func)) - (user-error "Cannot export orgtbl table to %s" target)) - (setq lines (org-table-clean-before-export lines)) - (setq table - (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-split-string (org-trim x) "\\s-*|\\s-*"))) - lines)) - (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0)) - table))) - (loop for i from (1- maxcol) downto 0 do - (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table)) - (setq column (delq nil column)) - (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths) - (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment)) - (funcall func table nil))) - (defun orgtbl-gather-send-defs () "Gather a plist of :name, :transform, :params for each destination before a radio table." @@ -4453,14 +4415,14 @@ a radio table." (save-excursion (goto-char (point-min)) (unless (re-search-forward - (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t) + (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t) (user-error "Don't know where to insert translated table")) (goto-char (match-beginning 0)) (beginning-of-line 2) (save-excursion (let ((beg (point))) (unless (re-search-forward - (concat "END RECEIVE ORGTBL +" name) nil t) + (concat "END +RECEIVE +ORGTBL +" name) nil t) (user-error "Cannot find end of insertion region")) (beginning-of-line 1) (delete-region beg (point)))) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 2351c4c..db7760d 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -370,6 +370,8 @@ VALUE can be `on', `off', or `pause'." (message "%d minute(s) %d seconds left before next time out" rmins rsecs)))) +(defvar org-clock-sound) + ;;;###autoload (defun org-timer-set-timer (&optional opt) "Prompt for a duration and set a timer. @@ -429,7 +431,7 @@ replace any running timer." (run-with-timer secs nil `(lambda () (setq org-timer-current-timer nil) - (org-notify ,(format "%s: time out" hl) t) + (org-notify ,(format "%s: time out" hl) ,org-clock-sound) (setq org-timer-timer-is-countdown nil) (org-timer-set-mode-line 'off) (run-hooks 'org-timer-done-hook)))) diff --git a/lisp/org-version.el b/lisp/org-version.el index 6f7f8e7..fbb4dc6 100644 --- a/lisp/org-version.el +++ b/lisp/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of org-mode. Inserted by installing org-mode or when a release is made." - (let ((org-release "8.0.7")) + (let ((org-release "8.2.1")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of org-mode. Inserted by installing org-mode or when a release is made." - (let ((org-git-version "8.0.7-dist")) + (let ((org-git-version "8.2.1-dist")) org-git-version)) ;;;###autoload (defvar org-odt-data-dir "/usr/share/emacs/etc/org" diff --git a/lisp/org.el b/lisp/org.el index 798816b..6d34bce 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -416,8 +416,7 @@ For export specific modules, see also `org-export-backends'." (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira) (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) - (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber) - (const :tag "C mac-message: Links to messages in Apple Mail" org-mac-message) + (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link) (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) (const :tag "C man: Support for links to manpages in Org-mode" org-man) (const :tag "C mew: Links to Mew folders/messages" org-mew) @@ -436,8 +435,9 @@ For export specific modules, see also `org-export-backends'." (const :tag "C wl: Links to Wanderlust folders/messages" org-wl) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) -(defvar org-export-registered-backends) ; From ox.el +(defvar org-export--registered-backends) ; From ox.el. (declare-function org-export-derived-backend-p "ox" (backend &rest backends)) +(declare-function org-export-backend-name "ox" (backend)) (defcustom org-export-backends '(ascii html icalendar latex) "List of export back-ends that should be always available. @@ -451,30 +451,29 @@ needed. This variable needs to be set before org.el is loaded. If you need to make a change while Emacs is running, use the customize -interface or run the following code, where VALUE stands for the -new value of the variable, after updating it: +interface or run the following code, where VAL stands for the new +value of the variable, after updating it: \(progn - \(setq org-export-registered-backends + \(setq org-export--registered-backends \(org-remove-if-not \(lambda (backend) - \(or (memq backend val) - \(catch 'parentp - \(mapc - \(lambda (b) - \(and (org-export-derived-backend-p b (car backend)) - \(throw 'parentp t))) - val) - nil))) - org-export-registered-backends)) - \(let ((new-list (mapcar 'car org-export-registered-backends))) + \(let ((name (org-export-backend-name backend))) + \(or (memq name val) + \(catch 'parentp + \(dolist (b val) + \(and (org-export-derived-backend-p b name) + \(throw 'parentp t))))))) + org-export--registered-backends)) + \(let ((new-list (mapcar 'org-export-backend-name + org-export--registered-backends))) \(dolist (backend val) \(cond \((not (load (format \"ox-%s\" backend) t t)) \(message \"Problems while trying to load export back-end `%s'\" backend)) \((not (memq backend new-list)) (push backend new-list)))) - \(set-default var new-list))) + \(set-default 'org-export-backends new-list))) Adding a back-end to this list will also pull the back-end it depends on, if any." @@ -488,21 +487,20 @@ depends on, if any." ;; Any back-end not required anymore (not present in VAL and not ;; a parent of any back-end in the new value) is removed from the ;; list of registered back-ends. - (setq org-export-registered-backends + (setq org-export--registered-backends (org-remove-if-not (lambda (backend) - (or (memq backend val) - (catch 'parentp - (mapc - (lambda (b) - (and (org-export-derived-backend-p b (car backend)) - (throw 'parentp t))) - val) - nil))) - org-export-registered-backends)) + (let ((name (org-export-backend-name backend))) + (or (memq name val) + (catch 'parentp + (dolist (b val) + (and (org-export-derived-backend-p b name) + (throw 'parentp t))))))) + org-export--registered-backends)) ;; Now build NEW-LIST of both new back-ends and required ;; parents. - (let ((new-list (mapcar 'car org-export-registered-backends))) + (let ((new-list (mapcar 'org-export-backend-name + org-export--registered-backends))) (dolist (backend val) (cond ((not (load (format "ox-%s" backend) t t)) @@ -1033,6 +1031,21 @@ commands in the Help buffer using the `?' speed command." (function) (sexp)))))) +(defcustom org-bookmark-names-plist + '(:last-capture "org-capture-last-stored" + :last-refile "org-refile-last-stored" + :last-capture-marker "org-capture-last-stored-marker") + "Names for bookmarks automatically set by some Org commands. +This can provide strings as names for a number of bookmakrs Org sets +automatically. The following keys are currently implemented: + :last-capture + :last-capture-marker + :last-refile +When a key does not show up in the property list, the corresponding bookmark +is not set." + :group 'org-structure + :type 'plist) + (defgroup org-cycle nil "Options concerning visibility cycling in Org-mode." :tag "Org Cycle" @@ -1278,6 +1291,11 @@ OK to kill that hidden subtree. When nil, kill without remorse." (const :tag "Protect hidden subtrees with a security query" t) (const :tag "Never kill a hidden subtree with C-k" error))) +(defcustom org-special-ctrl-o t + "Non-nil means, make `C-o' insert a row in tables." + :group 'org-edit-structure + :type 'boolean) + (defcustom org-catch-invisible-edits nil "Check if in invisible region before inserting or deleting a character. Valid values are: @@ -1596,7 +1614,7 @@ two parameters: the first one is the link, the second one is the description generated by `org-insert-link'. The function should return the description to use." :group 'org-link - :type 'function) + :type '(choice (const nil) (function))) (defgroup org-link-store nil "Options concerning storing links in Org-mode." @@ -1685,7 +1703,7 @@ Org contains a function for this, so if you set this variable to `org-translate-link-from-planner', you should be able follow many links created by planner." :group 'org-link-follow - :type 'function) + :type '(choice (const nil) (function))) (defcustom org-follow-link-hook nil "Hook that is run after a link has been followed." @@ -1767,6 +1785,11 @@ another window." (const vm-visit-folder) (const vm-visit-folder-other-window) (const vm-visit-folder-other-frame))) + (cons (const vm-imap) + (choice + (const vm-visit-imap-folder) + (const vm-visit-imap-folder-other-window) + (const vm-visit-imap-folder-other-frame))) (cons (const gnus) (choice (const gnus) @@ -2165,7 +2188,9 @@ should be continued. For example, the function may decide that the entire subtree of the current entry should be excluded and move point to the end of the subtree." :group 'org-refile - :type 'function) + :type '(choice + (const nil) + (function))) (defcustom org-refile-use-cache nil "Non-nil means cache refile targets to speed up the process. @@ -2808,7 +2833,9 @@ The user can set a different function here, which should take a string as an argument and return the numeric priority." :group 'org-priorities :version "24.1" - :type 'function) + :type '(choice + (const nil) + (function))) (defgroup org-time nil "Options concerning time stamps and deadlines in Org-mode." @@ -3271,7 +3298,7 @@ automatically if necessary." :type '(choice (const :tag "Always" t) (const :tag "Never" nil) - (const :tag "When selection characters are configured" 'auto))) + (const :tag "When selection characters are configured" auto))) (defcustom org-fast-tag-selection-single-key nil "Non-nil means fast tag selection exits after first change. @@ -3492,7 +3519,7 @@ value The value that should be modified. The function should return the value that should be displayed, or nil if the normal value should be used." :group 'org-properties - :type 'function) + :type '(choice (const nil) (function))) (defcustom org-effort-property "Effort" "The property that is being used to keep track of effort estimates. @@ -3754,11 +3781,9 @@ images at the same place." (defcustom org-format-latex-header "\\documentclass{article} \\usepackage[usenames]{color} -\\usepackage{amsmath} -\\usepackage[mathscr]{eucal} -\\pagestyle{empty} % do not remove \[PACKAGES] \[DEFAULT-PACKAGES] +\\pagestyle{empty} % do not remove % The settings below are copied from fullpage.sty \\setlength{\\textwidth}{\\paperwidth} \\addtolength{\\textwidth}{-3cm} @@ -3805,13 +3830,13 @@ header, or they will be appended." ("" "longtable" nil) ("" "float" nil) ("" "wrapfig" nil) + ("" "rotating" nil) ("normalem" "ulem" t) + ("" "amsmath" t) ("" "textcomp" t) ("" "marvosym" t) ("" "wasysym" t) - ("" "latexsym" t) ("" "amssymb" t) - ("" "amstext" nil) ("" "hyperref" nil) "\\tolerance=1000") "Alist of default packages to be inserted in the header. @@ -3823,15 +3848,16 @@ The packages in this list are needed by one part or another of Org mode to function properly: - inputenc, fontenc: for basic font and character selection -- amstext: for subscript and superscript -- textcomp, marvosymb, wasysym, latexsym, amssym: for various - symbols used for interpreting the entities in `org-entities'. - You can skip some of these packages if you don't use any of the - symbols in it. -- ulem: for underline and strike-through +- fixltx2e: Important patches of LaTeX itself - graphicx: for including images +- longtable: For multipage tables - float, wrapfig: for figure placement -- longtable: for long tables +- rotating: for sideways figures and tables +- ulem: for underline and strike-through +- amsmath: for subscript and superscript and math environments +- textcomp, marvosymb, wasysym, amssymb: for various symbols used + for interpreting the entities in `org-entities'. You can skip + some of these packages if you don't use any of their symbols. - hyperref: for cross references Therefore you should not modify this variable unless you know @@ -4285,7 +4311,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (looking-at org-table-hline-regexp)) nil)) -(defvar org-table-clean-did-remove-column nil) (defun org-table-map-tables (function &optional quietly) "Apply FUNCTION to the start of all tables in the buffer." (save-excursion @@ -4305,12 +4330,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (re-search-forward org-table-any-border-regexp nil 1)))) (unless quietly (message "Mapping tables: done"))) -;; Declare and autoload functions from ox.el and al. - -(declare-function org-export-get-environment "ox" - (&optional backend subtreep ext-plist)) -(declare-function org-latex-guess-inputenc "ox-latex" (header)) - ;; Declare and autoload functions from org-agenda.el (eval-and-compile @@ -4493,7 +4512,7 @@ Otherwise, these types are allowed: inactive: only inactive timestamps (<...) scheduled: only scheduled timestamps deadline: only deadline timestamps" - :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline) + :type '(choice (const :tag "Scheduled or deadline" scheduled-or-deadline) (const :tag "All timestamps" all) (const :tag "Only active timestamps" active) (const :tag "Only inactive timestamps" inactive) @@ -4836,7 +4855,7 @@ Support for group tags is controlled by the option ;; Process the tags. (when (and (not tags) org-tag-alist) (setq tags - (mapcar + (mapcar (lambda (tg) (cond ((eq (car tg) :startgroup) "{") ((eq (car tg) :endgroup) "}") ((eq (car tg) :grouptags) ":") @@ -5327,8 +5346,6 @@ The following commands are available: (org-set-local 'outline-regexp org-outline-regexp) (org-set-local 'outline-level 'org-outline-level) (setq bidi-paragraph-direction 'left-to-right) - ;; FIXME Circumvent a bug in outline.el (Emacs <24.4) - (set (make-local-variable 'paragraph-start) " \\|[ \t]*$\\|\\*+ ") (when (and org-ellipsis (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) (fboundp 'make-glyph-code)) @@ -6133,8 +6150,22 @@ Use `org-reduced-level' to remove the effect of `org-odd-levels'." (defvar org-font-lock-keywords nil) -(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\+?\\):\\)[ \t]*\\([^ \t\r\n].*\\)") - "Regular expression matching a property line.") +(defsubst org-re-property (property &optional literal) + "Return a regexp matching a PROPERTY line. +Match group 3 will be set to the value if it exists." + (concat "^\\(?4:[ \t]*\\)\\(?1::\\(?2:" + (if literal property (regexp-quote property)) + "\\):\\)[ \t]+\\(?3:[^ \t\r\n].*?\\)\\(?5:[ \t]*\\)$")) + +(defconst org-property-re + (org-re-property ".*?" 'literal) + "Regular expression matching a property line. +There are four matching groups: +1: :PROPKEY: including the leading and trailing colon, +2: PROPKEY without the leading and trailing colon, +3: PROPVAL without leading or trailing spaces, +4: the indentation of the current line, +5: trailing whitespace.") (defvar org-font-lock-hook nil "Functions to be called for special font lock stuff.") @@ -6481,6 +6512,11 @@ and subscripts." (defvar org-inlinetask-min-level) +(defun org-unlogged-message (&rest args) + "Display a message, but avoid logging it in the *Messages* buffer." + (let ((message-log-max nil)) + (apply 'message args))) + ;;;###autoload (defun org-cycle (&optional arg) "TAB-action and visibility cycling for Org-mode. @@ -6535,8 +6571,7 @@ in special contexts. (and org-cycle-level-after-item/entry-creation (or (org-cycle-level) (org-cycle-item-indentation)))) - (let* (message-log-max ; Don't populate the *Messages* buffer - (limit-level + (let* ((limit-level (or org-cycle-max-level (and (boundp 'org-inlinetask-min-level) org-inlinetask-min-level @@ -6567,11 +6602,11 @@ in special contexts. ((equal arg '(16)) (setq last-command 'dummy) (org-set-startup-visibility) - (message "Startup visibility, plus VISIBILITY properties")) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) ((equal arg '(64)) (show-all) - (message "Entire buffer visible, including drawers")) + (org-unlogged-message "Entire buffer visible, including drawers")) ;; Table: enter it or move to the next field. ((org-at-table-p 'any) @@ -6651,17 +6686,16 @@ in special contexts. (defun org-cycle-internal-global () "Do the global cycling action." ;; Hack to avoid display of messages for .org attachments in Gnus - (let (message-log-max ; Don't populate the *Messages* buffer - (ga (string-match "\\*fontification" (buffer-name)))) + (let ((ga (string-match "\\*fontification" (buffer-name)))) (cond ((and (eq last-command this-command) (eq org-cycle-global-status 'overview)) ;; We just created the overview - now do table of contents ;; This can be slow in very large buffers, so indicate action (run-hook-with-args 'org-pre-cycle-hook 'contents) - (unless ga (message "CONTENTS...")) + (unless ga (org-unlogged-message "CONTENTS...")) (org-content) - (unless ga (message "CONTENTS...done")) + (unless ga (org-unlogged-message "CONTENTS...done")) (setq org-cycle-global-status 'contents) (run-hook-with-args 'org-cycle-hook 'contents)) @@ -6670,7 +6704,7 @@ in special contexts. ;; We just showed the table of contents - now show everything (run-hook-with-args 'org-pre-cycle-hook 'all) (show-all) - (unless ga (message "SHOW ALL")) + (unless ga (org-unlogged-message "SHOW ALL")) (setq org-cycle-global-status 'all) (run-hook-with-args 'org-cycle-hook 'all)) @@ -6678,14 +6712,13 @@ in special contexts. ;; Default action: go to overview (run-hook-with-args 'org-pre-cycle-hook 'overview) (org-overview) - (unless ga (message "OVERVIEW")) + (unless ga (org-unlogged-message "OVERVIEW")) (setq org-cycle-global-status 'overview) (run-hook-with-args 'org-cycle-hook 'overview))))) (defun org-cycle-internal-local () "Do the local cycling action." - (let (message-log-max ; Don't populate the *Messages* buffer - (goal-column 0) eoh eol eos has-children children-skipped struct) + (let ((goal-column 0) eoh eol eos has-children children-skipped struct) ;; First, determine end of headline (EOH), end of subtree or item ;; (EOS), and if item or heading has children (HAS-CHILDREN). (save-excursion @@ -6725,7 +6758,7 @@ in special contexts. ;; Nothing is hidden behind this heading (unless (org-before-first-heading-p) (run-hook-with-args 'org-pre-cycle-hook 'empty)) - (message "EMPTY ENTRY") + (org-unlogged-message "EMPTY ENTRY") (setq org-cycle-subtree-status nil) (save-excursion (goto-char eos) @@ -6760,7 +6793,7 @@ in special contexts. (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded)) (org-list-get-all-items (point) struct prevs)) (goto-char (if (< end eos) end eos))))))) - (message "CHILDREN") + (org-unlogged-message "CHILDREN") (save-excursion (goto-char eos) (outline-next-heading) @@ -6776,7 +6809,8 @@ in special contexts. (unless (org-before-first-heading-p) (run-hook-with-args 'org-pre-cycle-hook 'subtree)) (outline-flag-region eoh eos nil) - (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) + (org-unlogged-message + (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) (setq org-cycle-subtree-status 'subtree) (unless (org-before-first-heading-p) (run-hook-with-args 'org-cycle-hook 'subtree))) @@ -6784,7 +6818,7 @@ in special contexts. ;; Default action: hide the subtree. (run-hook-with-args 'org-pre-cycle-hook 'folded) (outline-flag-region eoh eos t) - (message "FOLDED") + (org-unlogged-message "FOLDED") (setq org-cycle-subtree-status 'folded) (unless (org-before-first-heading-p) (run-hook-with-args 'org-cycle-hook 'folded)))))) @@ -6804,7 +6838,7 @@ With a numeric prefix, show all headlines up to that level." (setq org-cycle-global-status 'contents)) ((equal arg '(4)) (org-set-startup-visibility) - (message "Startup visibility, plus VISIBILITY properties.")) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) (t (org-cycle '(4)))))) @@ -6865,7 +6899,7 @@ of the first headline in the buffer. This is important, because if the first headline is not level one, then (hide-sublevels 1) gives confusing results." (interactive) - (let ((l (org-current-line)) + (let ((pos (point)) (level (save-excursion (goto-char (point-min)) (if (re-search-forward (concat "^" outline-regexp) nil t) @@ -6874,7 +6908,7 @@ results." (funcall outline-level)))))) (and level (hide-sublevels level)) (recenter '(4)) - (org-goto-line l))) + (goto-char pos))) (defun org-content (&optional arg) "Show all headlines in the buffer, like a table of contents. @@ -7514,168 +7548,149 @@ the current headline. If point is not at the beginning, split the line and create a new headline with the text in the current line after point \(see `org-M-RET-may-split-line' on how to modify this behavior). +If point is at the beginning of a normal line, turn this line into +a heading. + When INVISIBLE-OK is set, stop at invisible headlines when going back. This is important for non-interactive uses of the command." (interactive "P") (if (org-called-interactively-p 'any) (org-reveal)) - (cond - ((or (= (buffer-size) 0) - (and (not (save-excursion - (and (ignore-errors (org-back-to-heading invisible-ok)) - (org-at-heading-p)))) - (or arg (not (org-in-item-p))))) - (insert - (if (org-previous-line-empty-p) "" "\n") - (if (org-in-src-block-p) ",* " "* ")) - (run-hooks 'org-insert-heading-hook)) - ((or arg - (and (not (org-in-item-p)) org-insert-heading-respect-content) - (not (org-insert-item - (save-excursion - (beginning-of-line) - (looking-at org-list-full-item-re) - (match-string 3))))) - (let (begn endn) - (when (org-buffer-narrowed-p) - (setq begn (point-min) endn (point-max)) - (widen)) - (let* ((empty-line-p nil) - (eops (equal arg '(16))) ; insert at end of parent subtree - (org-insert-heading-respect-content - (or (not (null arg)) org-insert-heading-respect-content)) - (level nil) - (on-heading (org-at-heading-p)) - ;; Get a level to fall back on - (fix-level - (save-excursion - (org-back-to-heading t) - (looking-at org-outline-regexp) - (make-string (1- (length (match-string 0))) ?*))) - (on-empty-line - (save-excursion (beginning-of-line 1) (looking-at "^\\s-*$"))) - (head (save-excursion - (condition-case nil - (progn - (org-back-to-heading invisible-ok) - (when (and (not on-heading) - (featurep 'org-inlinetask) - (integerp org-inlinetask-min-level) - (>= (length (match-string 0)) - org-inlinetask-min-level)) - ;; Find a heading level before the inline task - (while (and (setq level (org-up-heading-safe)) - (>= level org-inlinetask-min-level))) - (if (org-at-heading-p) - (org-back-to-heading invisible-ok) - (error "This should not happen"))) - (unless (and (save-excursion - (save-match-data - (org-backward-heading-same-level 1 invisible-ok)) - (= (point) (match-beginning 0))) - (not (org-previous-line-empty-p t))) - (setq empty-line-p (org-previous-line-empty-p))) - (match-string 0)) - (error (or fix-level "* "))))) - (blank-a (cdr (assq 'heading org-blank-before-new-entry))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a)) - pos hide-previous previous-pos) - (if ;; At the beginning of a heading, open a new line for insertion - (and (bolp) (org-at-heading-p) - (not eops) - (or (bobp) - (save-excursion (backward-char 1) (not (outline-invisible-p))))) - (open-line (if blank 2 1)) - (save-excursion - (setq previous-pos (point-at-bol)) - (end-of-line) - (setq hide-previous (outline-invisible-p))) - (and org-insert-heading-respect-content - (save-excursion - (while (outline-invisible-p) - (org-show-subtree) - (org-up-heading-safe)))) - (let ((split - (and (org-get-alist-option org-M-RET-may-split-line 'headline) - (save-excursion - (let ((p (point))) - (goto-char (point-at-bol)) - (and (looking-at org-complex-heading-regexp) - (match-beginning 4) - (> p (match-beginning 4))))))) - tags pos) - (cond - ;; Insert a new line, possibly at end of parent subtree - ((and (not arg) (not on-heading) (not on-empty-line) - (not (save-excursion - (beginning-of-line 1) - (or (looking-at org-list-full-item-re) - ;; Don't convert :end: lines to headline - (looking-at "^\\s-*:end:") - (looking-at "^\\s-*#\\+end_?"))))) - (beginning-of-line 1)) - (org-insert-heading-respect-content - (if (not eops) - (progn - (org-end-of-subtree nil t) - (and (looking-at "^\\*") (backward-char 1)) - (while (and (not (bobp)) - ;; Don't delete spaces in empty headlines - (not (looking-back org-outline-regexp)) - (member (char-before) '(?\ ?\t ?\n))) - (backward-delete-char 1))) - (let ((p (point))) - (org-up-heading-safe) - (if (= p (point)) - (goto-char (point-max)) - (org-end-of-subtree nil t)))) - (when (featurep 'org-inlinetask) - (while (and (not (eobp)) - (looking-at "\\(\\*+\\)[ \t]+") - (>= (length (match-string 1)) - org-inlinetask-min-level)) - (org-end-of-subtree nil t))) - (or (bolp) (newline)) - (or (org-previous-line-empty-p) - (and blank (newline))) - (if (or empty-line-p eops) (open-line 1))) - ;; Insert a headling containing text after point - ((org-at-heading-p) - (when hide-previous - (show-children) - (org-show-entry)) - (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") - (setq tags (and (match-end 2) (match-string 2))) - (and (match-end 1) - (delete-region (match-beginning 1) (match-end 1))) - (setq pos (point-at-bol)) - (or split (end-of-line 1)) - (delete-horizontal-space) - (if (string-match "\\`\\*+\\'" - (buffer-substring (point-at-bol) (point))) - (insert " ")) - (newline (if blank 2 1)) - (when tags + (let ((itemp (org-in-item-p)) + (may-split (org-get-alist-option org-M-RET-may-split-line 'headline)) + (respect-content (or org-insert-heading-respect-content + (equal arg '(16)))) + (initial-content "") + (adjust-empty-lines t)) + + (cond + + ((or (= (buffer-size) 0) + (and (not (save-excursion + (and (ignore-errors (org-back-to-heading invisible-ok)) + (org-at-heading-p)))) + (or arg (not itemp)))) + ;; At beginning of buffer or so hight up that only a heading makes sense. + (insert + (if (or (bobp) (org-previous-line-empty-p)) "" "\n") + (if (org-in-src-block-p) ",* " "* ")) + (run-hooks 'org-insert-heading-hook)) + + ((and itemp (not (equal arg '(4)))) + ;; Insert an item + (org-insert-item)) + + (t + ;; Insert a heading + (save-restriction + (widen) + (let* ((level nil) + (on-heading (org-at-heading-p)) + (empty-line-p (if on-heading + (org-previous-line-empty-p) + ;; We will decide later + nil)) + ;; Get a level string to fall back on + (fix-level (save-excursion - (goto-char pos) - (end-of-line 1) - (insert " " tags) - (org-set-tags nil 'align)))) - (t - (or split (end-of-line 1)) - (newline (cond ((and blank (not on-empty-line)) 2) - (blank 1) - (on-empty-line 0) (t 1))))))) - (insert head) (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) - (when (and org-insert-heading-respect-content hide-previous) - (save-excursion - (goto-char previous-pos) - (hide-subtree))) - (when (and begn endn) - (narrow-to-region (min (point) begn) (max (point) endn))) - (run-hooks 'org-insert-heading-hook)))))) + (org-back-to-heading t) + (if (org-previous-line-empty-p) (setq empty-line-p t)) + (looking-at org-outline-regexp) + (make-string (1- (length (match-string 0))) ?*))) + (stars + (save-excursion + (condition-case nil + (progn + (org-back-to-heading invisible-ok) + (when (and (not on-heading) + (featurep 'org-inlinetask) + (integerp org-inlinetask-min-level) + (>= (length (match-string 0)) + org-inlinetask-min-level)) + ;; Find a heading level before the inline task + (while (and (setq level (org-up-heading-safe)) + (>= level org-inlinetask-min-level))) + (if (org-at-heading-p) + (org-back-to-heading invisible-ok) + (error "This should not happen"))) + (unless (and (save-excursion + (save-match-data + (org-backward-heading-same-level + 1 invisible-ok)) + (= (point) (match-beginning 0))) + (not (org-previous-line-empty-p t))) + (setq empty-line-p (or empty-line-p + (org-previous-line-empty-p)))) + (match-string 0)) + (error (or fix-level "* "))))) + (blank-a (cdr (assq 'heading org-blank-before-new-entry))) + (blank (if (eq blank-a 'auto) empty-line-p blank-a)) + pos hide-previous previous-pos) + + ;; If we insert after content, move there and clean up whitespace + (when respect-content + (org-end-of-subtree nil t) + (skip-chars-backward " \r\n") + (and (looking-at "[ \t]+") (replace-match "")) + (forward-char 1) + (when (looking-at "^\\*") + (backward-char 1) + (insert "\n"))) + + ;; If we are splitting, grab the text that should be moved to the new headline + (when may-split + (if (org-on-heading-p) + ;; This is a heading, we split intelligently (keeping tags) + (let ((pos (point))) + (goto-char (point-at-bol)) + (unless (looking-at org-complex-heading-regexp) + (error "This should not happen")) + (when (and (match-beginning 4) + (> pos (match-beginning 4)) + (< pos (match-end 4))) + (setq initial-content (buffer-substring pos (match-end 4))) + (goto-char pos) + (delete-region (point) (match-end 4)) + (if (looking-at "[ \t]*$") + (replace-match "") + (insert (make-string (length initial-content) ?\ ))) + (setq initial-content (org-trim initial-content))) + (goto-char pos)) + ;; a normal line + (unless (bolp) + (setq initial-content (buffer-substring (point) (point-at-eol))) + (delete-region (point) (point-at-eol)) + (setq initial-content (org-trim initial-content))))) + + ;; If we are at the beginning of the line, insert before it. Else after + (cond + ((and (bolp) (looking-at "[ \t]*$"))) + ((and (bolp) (not (looking-at "[ \t]*$"))) + (open-line 1)) + (t + (goto-char (point-at-eol)) + (insert "\n"))) + + ;; Insert the new heading + (insert stars) + (just-one-space) + (insert initial-content) + (when adjust-empty-lines + (if (or (not blank) + (and blank (not (org-previous-line-empty-p)))) + (org-N-empty-lines-before-current (if blank 1 0)))) + (run-hooks 'org-insert-heading-hook))))))) + +(defun org-N-empty-lines-before-current (N) + "Make the number of empty lines before current exactly N. +So this will delete or add empty lines." + (save-excursion + (goto-char (point-at-bol)) + (if (looking-back "\\s-+" nil 'greedy) + (replace-match "")) + (or (bobp) (insert "\n")) + (while (> N 0) + (insert "\n") + (setq N (1- N))))) (defun org-get-heading (&optional no-tags no-todo) "Return the heading of the current entry, without the stars. @@ -7748,7 +7763,7 @@ This is a list with the following elements: "Insert heading with `org-insert-heading-respect-content' set to t." (interactive "P") (let ((org-insert-heading-respect-content t)) - (org-insert-heading arg invisible-ok))) + (org-insert-heading '(4) invisible-ok))) (defun org-insert-todo-heading-respect-content (&optional force-state) "Insert TODO heading with `org-insert-heading-respect-content' set to t." @@ -8888,6 +8903,8 @@ buffer. It will also recognize item context in multiline items." org-fb-vars)) (orgstruct-mode 1) (setq org-fb-vars nil) + (unless org-local-vars + (setq org-local-vars (org-get-local-variables))) (let (var val) (mapc (lambda (x) @@ -8962,26 +8979,30 @@ buffer. It will also recognize item context in multiline items." (let ((f (or (car-safe cell) cell)) (disable-when-heading-prefix (cdr-safe cell))) (when (fboundp f) - (dolist (binding (nconc (where-is-internal f org-mode-map) - (where-is-internal f outline-mode-map))) - ;; TODO use local-function-key-map - (dolist (rep '(("<tab>" . "TAB") - ("<return>" . "RET") - ("<escape>" . "ESC") - ("<delete>" . "DEL"))) - (setq binding (read-kbd-macro - (let ((case-fold-search)) - (replace-regexp-in-string - (regexp-quote (cdr rep)) - (car rep) - (key-description binding)))))) - (let ((key (lookup-key orgstruct-mode-map binding))) - (when (or (not key) (numberp key)) - (condition-case nil - (org-defkey orgstruct-mode-map - binding - (orgstruct-make-binding f binding disable-when-heading-prefix)) - (error nil)))))))) + (let ((new-bindings)) + (dolist (binding (nconc (where-is-internal f org-mode-map) + (where-is-internal f outline-mode-map))) + (push binding new-bindings) + ;; TODO use local-function-key-map + (dolist (rep '(("<tab>" . "TAB") + ("<return>" . "RET") + ("<escape>" . "ESC") + ("<delete>" . "DEL"))) + (setq binding (read-kbd-macro + (let ((case-fold-search)) + (replace-regexp-in-string + (regexp-quote (cdr rep)) + (car rep) + (key-description binding))))) + (pushnew binding new-bindings :test 'equal))) + (dolist (binding new-bindings) + (let ((key (lookup-key orgstruct-mode-map binding))) + (when (or (not key) (numberp key)) + (condition-case nil + (org-defkey orgstruct-mode-map + binding + (orgstruct-make-binding f binding disable-when-heading-prefix)) + (error nil))))))))) (run-hooks 'orgstruct-setup-hook)) (defun orgstruct-make-binding (fun key disable-when-heading-prefix) @@ -9028,7 +9049,10 @@ if `orgstruct-heading-prefix-regexp' is non-nil." (not (let* ,bindings (org-context-p 'headline 'item - ,(when (memq fun '(org-insert-heading)) + ,(when (memq fun + '(org-insert-heading + org-insert-heading-respect-content + org-meta-return)) '(when orgstruct-is-++ 'item-body)))))))) (if fallback @@ -9713,7 +9737,7 @@ according to FMT (default from `org-email-link-description-format')." This is the list that is used for internal purposes.") (defconst org-link-escape-chars-browser - '(?\ ) + '(?\ ?\") "List of escapes for characters that are problematic in links. This is the list that is used before handing over to the browser.") @@ -10443,16 +10467,24 @@ application the system uses for this file type." (apply cmd (nreverse args1)))) ((member type '("http" "https" "ftp" "news")) - (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path) - (org-link-escape - path org-link-escape-chars-browser) - path)))) + (browse-url + (concat type ":" + (if (org-string-match-p + (concat "[[:nonascii:]" + org-link-escape-chars-browser "]") + path) + (org-link-escape path org-link-escape-chars-browser) + path)))) ((string= type "doi") - (browse-url (concat org-doi-server-url (if (org-string-match-p "[[:nonascii:] ]" path) - (org-link-escape - path org-link-escape-chars-browser) - path)))) + (browse-url + (concat org-doi-server-url + (if (org-string-match-p + (concat "[[:nonascii:]" + org-link-escape-chars-browser "]") + path) + (org-link-escape path org-link-escape-chars-browser) + path)))) ((member type '("message")) (browse-url (concat type ":" path))) @@ -10508,8 +10540,14 @@ application the system uses for this file type." (error "Abort")))) ((and (string= type "thisfile") - (run-hook-with-args-until-success - 'org-open-link-functions path))) + (or (run-hook-with-args-until-success + 'org-open-link-functions path) + (and (string-match "^id:" link) + (or (featurep 'org-id) (require 'org-id)) + (progn + (funcall (nth 1 (assoc "id" org-link-protocols)) + (substring path 3)) + t))))) ((string= type "thisfile") (if arg @@ -11406,7 +11444,6 @@ the different parts of the path and defaults to \"/\". If JUST-RETURN-STRING is non-nil, return a string, don't display a message." (interactive "P") (let* (case-fold-search - message-log-max ; Don't populate the *Messages* buffer (bfn (buffer-file-name (buffer-base-buffer))) (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) res) @@ -11423,7 +11460,7 @@ If JUST-RETURN-STRING is non-nil, return a string, don't display a message." separator)) (if just-return-string (org-no-properties res) - (message "%s" res)))) + (org-unlogged-message "%s" res)))) (defvar org-refile-history nil "History for refiling operations.") @@ -11462,7 +11499,13 @@ and not actually move anything. With a double prefix arg \\[universal-argument] \\[universal-argument], \ go to the location where the last refiling operation has put the subtree. -With a prefix argument of `2', refile to the running clock. + +With a numeric prefix argument of `2', refile to the running clock. + +With a numeric prefix argument of `3', emulate `org-refile-keep' +being set to `t' and copy to the target location, don't move it. +Beware that keeping refiled entries may result in duplicated ID +properties. RFLOC can be a refile location obtained in a different way. @@ -11485,6 +11528,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (region-start (and regionp (region-beginning))) (region-end (and regionp (region-end))) (filename (buffer-file-name (buffer-base-buffer cbuf))) + (org-refile-keep (if (equal goto 3) t org-refile-keep)) pos it nbuf file re level reversed) (setq last-command nil) (when regionp @@ -11543,7 +11587,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (setq nbuf (or (find-buffer-visiting file) (find-file-noselect file))) - (if goto + (if (and goto (not (equal goto 3))) (progn (org-pop-to-buffer-same-window nbuf) (goto-char pos) @@ -11584,13 +11628,19 @@ prefix argument (`C-u C-u C-u C-c C-w')." (and org-auto-align-tags (let ((org-loop-over-headlines-in-active-region nil)) (org-set-tags nil t))) - (with-demoted-errors - (bookmark-set "org-refile-last-stored")) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-refile))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) ;; If we are refiling for capture, make sure that the ;; last-capture pointers point here (when (org-bound-and-true-p org-refile-for-capture) - (with-demoted-errors - (bookmark-set "org-capture-last-stored-marker")) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture-marker))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) (move-marker org-capture-last-stored-marker (point))) (if (fboundp 'deactivate-mark) (deactivate-mark)) (run-hooks 'org-after-refile-insert-hook)))) @@ -11913,22 +11963,21 @@ This function can be used in a hook." ;;;; Completion +(declare-function org-export-backend-name "org-export" (cl-x)) +(declare-function org-export-backend-options "org-export" (cl-x)) (defun org-get-export-keywords () "Return a list of all currently understood export keywords. Export keywords include options, block names, attributes and keywords relative to each registered export back-end." - (delq nil - (let (keywords) - (mapc - (lambda (back-end) - (let ((props (cdr back-end))) - ;; Back-end name (for keywords, like #+LATEX:) - (push (upcase (symbol-name (car back-end))) keywords) - ;; Back-end options. - (mapc (lambda (option) (push (cadr option) keywords)) - (plist-get (cdr back-end) :options-alist)))) - (org-bound-and-true-p org-export-registered-backends)) - keywords))) + (let (keywords) + (dolist (backend + (org-bound-and-true-p org-export--registered-backends) + (delq nil keywords)) + ;; Back-end name (for keywords, like #+LATEX:) + (push (upcase (symbol-name (org-export-backend-name backend))) keywords) + (dolist (option-entry (org-export-backend-options backend)) + ;; Back-end options. + (push (nth 1 option-entry) keywords))))) (defconst org-options-keywords '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:" @@ -14006,10 +14055,19 @@ See also `org-scan-tags'. minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher orterms term orlist re-p str-p level-p level-op time-p - prop-p pn pv po gv rest) + prop-p pn pv po gv rest (start 0) (ss 0)) ;; Expand group tags (setq match (org-tags-expand match)) - (if (string-match "/+" match) + + ;; Check if there is a TODO part of this match, which would be the + ;; part after a "/". TO make sure that this slash is not part of + ;; a property value to be matched against, we also check that there + ;; is no " after that slash. + ;; First, find the last slash + (while (string-match "/+" match ss) + (setq start (match-beginning 0) ss (match-end 0))) + (if (and (string-match "/+" match start) + (not (save-match-data (string-match "\"" match start)))) ;; match contains also a todo-matching request (progn (setq tagsmatch (substring match 0 (match-beginning 0)) @@ -15002,16 +15060,6 @@ Being in this list makes sure that they are offered for completion.") org-property-end-re "\\)\n?") "Matches an entire clock drawer.") -(defsubst org-re-property (property) - "Return a regexp matching a PROPERTY line. -Match group 1 will be set to the value." - (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)")) - -(defsubst org-re-property-keyword (property) - "Return a regexp matching a PROPERTY line, possibly with no -value for the property." - (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)?")) - (defun org-property-action () "Do an action on properties." (interactive) @@ -15092,13 +15140,9 @@ When INCREMENT is non-nil, set the property to the next allowed value." (defun org-at-property-p () "Is cursor inside a property drawer?" (save-excursion - (beginning-of-line 1) - (when (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)")) - (save-match-data ;; Used by calling procedures - (let ((p (point)) - (range (unless (org-before-first-heading-p) - (org-get-property-block)))) - (and range (<= (car range) p) (< p (cdr range)))))))) + (when (equal 'node-property (car (org-element-at-point))) + (beginning-of-line 1) + (looking-at org-property-re)))) (defun org-get-property-block (&optional beg end force) "Return the (beg . end) range of the body of the property drawer. @@ -15223,11 +15267,10 @@ things up because then unnecessary parsing is avoided." (setq range (org-get-property-block beg end)) (when range (goto-char (car range)) - (while (re-search-forward - (org-re "^[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):[ \t]*\\(\\S-.*\\)?") + (while (re-search-forward org-property-re (cdr range) t) - (setq key (org-match-string-no-properties 1) - value (org-trim (or (org-match-string-no-properties 2) ""))) + (setq key (org-match-string-no-properties 2) + value (org-trim (or (org-match-string-no-properties 3) ""))) (unless (member key excluded) (push (cons key (or value "")) props))))) (if clocksum @@ -15276,8 +15319,8 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." (setq props (org-update-property-plist key - (if (match-end 1) - (org-match-string-no-properties 1) "") + (if (match-end 3) + (org-match-string-no-properties 3) "") props))))) val) (goto-char (car range)) @@ -15466,7 +15509,7 @@ and the new value.") (setq range (org-get-property-block beg end 'force)) (goto-char (car range)) (if (re-search-forward - (org-re-property-keyword property) (cdr range) t) + (org-re-property property) (cdr range) t) (progn (delete-region (match-beginning 0) (match-end 0)) (goto-char (match-beginning 0))) @@ -15496,10 +15539,9 @@ formats in the current buffer." (while (re-search-forward org-property-start-re nil t) (setq range (org-get-property-block)) (goto-char (car range)) - (while (re-search-forward - (org-re "^[ \t]*:\\([-[:alnum:]_]+\\):") + (while (re-search-forward org-property-re (cdr range) t) - (add-to-list 'rtn (org-match-string-no-properties 1))) + (add-to-list 'rtn (org-match-string-no-properties 2))) (outline-next-heading)))) (when include-specials @@ -15537,7 +15579,7 @@ formats in the current buffer." (let ((re (org-re-property key)) values) (while (re-search-forward re nil t) - (add-to-list 'values (org-trim (match-string 1)))) + (add-to-list 'values (org-trim (match-string 3)))) (delete "" values))))) (defun org-insert-property-drawer () @@ -15566,7 +15608,9 @@ formats in the current buffer." (beginning-of-line 1))) (org-skip-over-state-notes) (skip-chars-backward " \t\n\r") - (if (eq (char-before) ?*) (forward-char 1)) + (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n))) + (forward-char 1)) + (goto-char (point-at-eol)) (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) (beginning-of-line 0) (org-indent-to-column indent) @@ -15999,7 +16043,10 @@ If there is already a timestamp at the cursor, it will be modified. With two universal prefix arguments, insert an active timestamp -with the current time without prompting the user." +with the current time without prompting the user. + +When called from lisp, the timestamp is inactive if INACTIVE is +non-nil." (interactive "P") (let* ((ts nil) (default-time @@ -16046,7 +16093,7 @@ with the current time without prompting the user." " " repeater ">")))) (message "Timestamp updated")) ((equal arg '(16)) - (org-insert-time-stamp (current-time) t)) + (org-insert-time-stamp (current-time) t inactive)) (t (setq time (let ((this-command this-command)) (org-read-date arg 'totime nil nil default-time default-input inactive))) @@ -16068,7 +16115,7 @@ with the current time without prompting the user." (setq dh (- h2 h1) dm (- m2 m1)) (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) (concat t1 "+" (number-to-string dh) - (if (/= 0 dm) (concat ":" (number-to-string dm)))))))) + (and (/= 0 dm) (format ":%02d" dm))))))) (defun org-time-stamp-inactive (&optional arg) "Insert an inactive time stamp. @@ -16098,7 +16145,8 @@ So these are more for recording a certain time/date." (defvar org-read-date-inactive) (defvar org-read-date-minibuffer-local-map - (let ((map (make-sparse-keymap))) + (let* ((org-replace-disputed-keys nil) + (map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (org-defkey map (kbd ".") (lambda () (interactive) @@ -17647,6 +17695,21 @@ is not set, the tables are not re-aligned, etc." :version "24.3" :group 'org-agenda) +(defcustom org-agenda-ignore-drawer-properties nil + "Avoid updating text properties when building the agenda. +Properties are used to prepare buffers for effort estimates, appointments, +and subtree-local categories. +If you don't use these in the agenda, you can add them to this list and +agenda building will be a bit faster. +The value is a list, with zero or more of the symbols `effort', `appt', +or `category'." + :type '(set :greedy t + (const effort) + (const appt) + (const category)) + :version "24.3" + :group 'org-agenda) + (defun org-duration-string-to-minutes (s &optional output-to-string) "Convert a duration string S to minutes. @@ -18008,9 +18071,12 @@ When a buffer is unmodified, it is just killed. When modified, it is saved ;; this is only run for setting agenda tags from setup ;; file (org-set-regexps-and-options))) - (org-refresh-category-properties) - (org-refresh-properties org-effort-property 'org-effort) - (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime) + (or (memq 'category org-agenda-ignore-drawer-properties) + (org-refresh-category-properties)) + (or (memq 'effort org-agenda-ignore-drawer-properties) + (org-refresh-properties org-effort-property 'org-effort)) + (or (memq 'appt org-agenda-ignore-drawer-properties) + (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)) (setq org-todo-keywords-for-agenda (append org-todo-keywords-for-agenda org-todo-keywords-1)) (setq org-done-keywords-for-agenda @@ -18222,37 +18288,38 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (interactive "P") (unless buffer-file-name (user-error "Can't preview LaTeX fragment in a non-file buffer")) - (org-remove-latex-fragment-image-overlays) - (save-excursion - (save-restriction - (let (beg end at msg) - (cond - ((or (equal subtree '(16)) - (not (save-excursion - (re-search-backward org-outline-regexp-bol nil t)))) - (setq beg (point-min) end (point-max) - msg "Creating images for buffer...%s")) - ((equal subtree '(4)) - (org-back-to-heading) - (setq beg (point) end (org-end-of-subtree t) - msg "Creating images for subtree...%s")) - (t - (if (setq at (org-inside-LaTeX-fragment-p)) - (goto-char (max (point-min) (- (cdr at) 2))) - (org-back-to-heading)) - (setq beg (point) end (progn (outline-next-heading) (point)) - msg (if at "Creating image...%s" - "Creating images for entry...%s")))) - (message msg "") - (narrow-to-region beg end) - (goto-char beg) - (org-format-latex - (concat org-latex-preview-ltxpng-directory (file-name-sans-extension - (file-name-nondirectory - buffer-file-name))) - default-directory 'overlays msg at 'forbuffer - org-latex-create-formula-image-program) - (message msg "done. Use `C-c C-c' to remove images."))))) + (when (display-graphic-p) + (org-remove-latex-fragment-image-overlays) + (save-excursion + (save-restriction + (let (beg end at msg) + (cond + ((or (equal subtree '(16)) + (not (save-excursion + (re-search-backward org-outline-regexp-bol nil t)))) + (setq beg (point-min) end (point-max) + msg "Creating images for buffer...%s")) + ((equal subtree '(4)) + (org-back-to-heading) + (setq beg (point) end (org-end-of-subtree t) + msg "Creating images for subtree...%s")) + (t + (if (setq at (org-inside-LaTeX-fragment-p)) + (goto-char (max (point-min) (- (cdr at) 2))) + (org-back-to-heading)) + (setq beg (point) end (progn (outline-next-heading) (point)) + msg (if at "Creating image...%s" + "Creating images for entry...%s")))) + (message msg "") + (narrow-to-region beg end) + (goto-char beg) + (org-format-latex + (concat org-latex-preview-ltxpng-directory (file-name-sans-extension + (file-name-nondirectory + buffer-file-name))) + default-directory 'overlays msg at 'forbuffer + org-latex-create-formula-image-program) + (message msg "done. Use `C-c C-c' to remove images.")))))) (defun org-format-latex (prefix &optional dir overlays msg at forbuffer processing-type) @@ -18485,20 +18552,25 @@ share a good deal of logic." "Invalid value of `org-latex-create-formula-image-program'"))) string tofile options buffer)) +(declare-function org-export-get-backend "ox" (name)) (declare-function org-export--get-global-options "ox" (&optional backend)) (declare-function org-export--get-inbuffer-options "ox" (&optional backend)) +(declare-function org-latex-guess-inputenc "ox-latex" (header)) +(declare-function org-latex-guess-babel-language "ox-latex" (header info)) (defun org-create-formula--latex-header () "Return LaTeX header appropriate for previewing a LaTeX snippet." - (org-latex-guess-inputenc - (org-splice-latex-header - org-format-latex-header - org-latex-default-packages-alist - org-latex-packages-alist t - (plist-get - (org-combine-plists - (org-export--get-global-options 'latex) - (org-export--get-inbuffer-options 'latex)) - :latex-header)))) + (let ((info (org-combine-plists (org-export--get-global-options + (org-export-get-backend 'latex)) + (org-export--get-inbuffer-options + (org-export-get-backend 'latex))))) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-splice-latex-header + org-format-latex-header + org-latex-default-packages-alist + org-latex-packages-alist t + (plist-get info :latex-header))) + info))) ;; This function borrows from Ganesh Swami's latex2png.el (defun org-create-formula-image-with-dvipng (string tofile options buffer) @@ -18581,7 +18653,7 @@ share a good deal of logic." (font-height (face-font 'default)) (face-attribute 'default :height nil))) (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) - (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) + (dpi (number-to-string (* scale (floor (if buffer fnh 120.))))) (fg (or (plist-get options (if buffer :foreground :html-foreground)) "black")) (bg (or (plist-get options (if buffer :background :html-background)) @@ -18774,53 +18846,54 @@ When REFRESH is set, refresh existing images between BEG and END. This will create new image displays only if necessary. BEG and END default to the buffer boundaries." (interactive "P") - (unless refresh - (org-remove-inline-images) - (if (fboundp 'clear-image-cache) (clear-image-cache))) - (save-excursion - (save-restriction - (widen) - (setq beg (or beg (point-min)) end (or end (point-max))) - (goto-char beg) - (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" - (substring (org-image-file-name-regexp) 0 -2) - "\\)\\]" (if include-linked "" "\\]"))) - (case-fold-search t) - old file ov img type attrwidth width) - (while (re-search-forward re end t) - (setq old (get-char-property-and-overlay (match-beginning 1) - 'org-image-overlay) - file (expand-file-name - (concat (or (match-string 3) "") (match-string 4)))) - (when (image-type-available-p 'imagemagick) - (setq attrwidth (if (or (listp org-image-actual-width) - (null org-image-actual-width)) - (save-excursion - (save-match-data - (when (re-search-backward - "#\\+attr.*:width[ \t]+\\([^ ]+\\)" - (save-excursion - (re-search-backward "^[ \t]*$\\|\\`" nil t)) t) - (string-to-number (match-string 1)))))) - width (cond ((eq org-image-actual-width t) nil) - ((null org-image-actual-width) attrwidth) - ((numberp org-image-actual-width) - org-image-actual-width) - ((listp org-image-actual-width) - (or attrwidth (car org-image-actual-width)))) - type (if width 'imagemagick))) - (when (file-exists-p file) - (if (and (car-safe old) refresh) - (image-refresh (overlay-get (cdr old) 'display)) - (setq img (save-match-data (create-image file type nil :width width))) - (when img - (setq ov (make-overlay (match-beginning 0) (match-end 0))) - (overlay-put ov 'display img) - (overlay-put ov 'face 'default) - (overlay-put ov 'org-image-overlay t) - (overlay-put ov 'modification-hooks - (list 'org-display-inline-remove-overlay)) - (push ov org-inline-image-overlays))))))))) + (when (display-graphic-p) + (unless refresh + (org-remove-inline-images) + (if (fboundp 'clear-image-cache) (clear-image-cache))) + (save-excursion + (save-restriction + (widen) + (setq beg (or beg (point-min)) end (or end (point-max))) + (goto-char beg) + (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" + (substring (org-image-file-name-regexp) 0 -2) + "\\)\\]" (if include-linked "" "\\]"))) + (case-fold-search t) + old file ov img type attrwidth width) + (while (re-search-forward re end t) + (setq old (get-char-property-and-overlay (match-beginning 1) + 'org-image-overlay) + file (expand-file-name + (concat (or (match-string 3) "") (match-string 4)))) + (when (image-type-available-p 'imagemagick) + (setq attrwidth (if (or (listp org-image-actual-width) + (null org-image-actual-width)) + (save-excursion + (save-match-data + (when (re-search-backward + "#\\+attr.*:width[ \t]+\\([^ ]+\\)" + (save-excursion + (re-search-backward "^[ \t]*$\\|\\`" nil t)) t) + (string-to-number (match-string 1)))))) + width (cond ((eq org-image-actual-width t) nil) + ((null org-image-actual-width) attrwidth) + ((numberp org-image-actual-width) + org-image-actual-width) + ((listp org-image-actual-width) + (or attrwidth (car org-image-actual-width)))) + type (if width 'imagemagick))) + (when (file-exists-p file) + (if (and (car-safe old) refresh) + (image-refresh (overlay-get (cdr old) 'display)) + (setq img (save-match-data (create-image file type nil :width width))) + (when img + (setq ov (make-overlay (match-beginning 0) (match-end 0))) + (overlay-put ov 'display img) + (overlay-put ov 'face 'default) + (overlay-put ov 'org-image-overlay t) + (overlay-put ov 'modification-hooks + (list 'org-display-inline-remove-overlay)) + (push ov org-inline-image-overlays)))))))))) (define-obsolete-function-alias 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") @@ -19036,6 +19109,8 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) (org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies) (org-defkey org-mode-map [remap open-line] 'org-open-line) +(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph) +(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph) (org-defkey org-mode-map "\C-m" 'org-return) (org-defkey org-mode-map "\C-j" 'org-return-indent) (org-defkey org-mode-map "\C-c?" 'org-table-field-info) @@ -20153,6 +20228,12 @@ This command does many different things, depending on context: (when (and (eq (org-element-type parent) 'item) (= (point-at-bol) (org-element-property :begin parent))) (setq context parent type 'item)))) + ;; When heading text is a link, treat the heading, not the link, + ;; as the current element + (when (eq type 'link) + (let ((parent (org-element-property :parent context))) + (when (and (eq (org-element-type parent) 'headline)) + (setq context parent type 'headline)))) ;; Act according to type of element or object at point. (case type (clock (org-clock-update-time-maybe)) @@ -20298,11 +20379,16 @@ Also updates the keyword regular expressions." (funcall org-finish-function)))) (defun org-open-line (n) - "Insert a new row in tables, call `open-line' elsewhere." + "Insert a new row in tables, call `open-line' elsewhere. +If `org-special-ctrl-o' is nil, just call `open-line' everywhere." (interactive "*p") - (if (org-at-table-p) - (org-table-insert-row) - (open-line n))) + (cond + ((not org-special-ctrl-o) + (open-line n)) + ((org-at-table-p) + (org-table-insert-row)) + (t + (open-line n)))) (defun org-return (&optional indent) "Goto next table row or insert a newline. @@ -20621,17 +20707,22 @@ number of stars to add." (defun org-meta-return (&optional arg) "Insert a new heading or wrap a region in a table. -Calls `org-insert-heading' or `org-table-wrap-region', depending on context. -See the individual commands for more information." +Calls `org-insert-heading' or `org-table-wrap-region', depending +on context. See the individual commands for more information." (interactive "P") (org-check-before-invisible-edit 'insert) - (cond - ((run-hook-with-args-until-success 'org-metareturn-hook)) - ((or (org-at-drawer-p) (org-in-drawer-p) (org-at-property-p)) - (newline-and-indent)) - ((org-at-table-p) - (call-interactively 'org-table-wrap-region)) - (t (call-interactively 'org-insert-heading)))) + (or (run-hook-with-args-until-success 'org-metareturn-hook) + (let* ((element (org-element-at-point)) + (type (org-element-type element))) + (when (eq type 'table-row) + (setq element (org-element-property :parent element)) + (setq type 'table)) + (if (and (eq type 'table) + (eq (org-element-property :type element) 'org) + (>= (point) (org-element-property :contents-begin element)) + (< (point) (org-element-property :contents-end element))) + (call-interactively 'org-table-wrap-region) + (call-interactively 'org-insert-heading))))) ;;; Menu entries @@ -21733,6 +21824,20 @@ Taken from `reduce' in cl-seq.el with all keyword arguments but (setq cl-accum (funcall cl-func cl-accum (pop cl-seq)))) cl-accum)) +(defun org-every (pred seq) + "Return true if PREDICATE is true of every element of SEQ. +Adapted from `every' in cl.el." + (catch 'org-every + (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq) + t)) + +(defun org-some (pred seq) + "Return true if PREDICATE is true of any element of SEQ. +Adapted from `some' in cl.el." + (catch 'org-some + (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq) + nil)) + (defun org-back-over-empty-lines () "Move backwards over whitespace, to the beginning of the first empty line. Returns the number of empty lines passed." @@ -21997,11 +22102,10 @@ hierarchy of headlines by UP levels before marking the subtree." ;; Special polishing for properties, see `org-property-format' (setq column (current-column)) (beginning-of-line 1) - (if (looking-at - "\\([ \t]*\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") - (replace-match (concat (match-string 1) + (if (looking-at org-property-re) + (replace-match (concat (match-string 4) (format org-property-format - (match-string 2) (match-string 3))) + (match-string 1) (match-string 3))) t t)) (org-move-to-column column)))) @@ -22074,28 +22178,26 @@ hierarchy of headlines by UP levels before marking the subtree." ;; `org-setup-filling' installs filling and auto-filling related ;; variables during `org-mode' initialization. +(defvar org-element-paragraph-separate) ; org-element.el (defun org-setup-filling () - (interactive) + (require 'org-element) ;; Prevent auto-fill from inserting unwanted new items. (when (boundp 'fill-nobreak-predicate) (org-set-local 'fill-nobreak-predicate (org-uniquify (append fill-nobreak-predicate - '(org-fill-paragraph-separate-nobreak-p - org-fill-line-break-nobreak-p + '(org-fill-line-break-nobreak-p org-fill-paragraph-with-timestamp-nobreak-p))))) + (let ((paragraph-ending (substring org-element-paragraph-separate 1))) + (org-set-local 'paragraph-start paragraph-ending) + (org-set-local 'paragraph-separate paragraph-ending)) (org-set-local 'fill-paragraph-function 'org-fill-paragraph) (org-set-local 'auto-fill-inhibit-regexp nil) (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) (org-set-local 'comment-line-break-function 'org-comment-line-break-function)) -(defvar org-element-paragraph-separate) ; org-element.el -(defun org-fill-paragraph-separate-nobreak-p () - "Non-nil when a new line at point would end current paragraph." - (looking-at (substring org-element-paragraph-separate 1))) - (defun org-fill-line-break-nobreak-p () "Non-nil when a new line at point would create an Org line break." (save-excursion @@ -22115,70 +22217,73 @@ hierarchy of headlines by UP levels before marking the subtree." Return fill prefix, as a string, or nil if current line isn't meant to be filled. For convenience, if `adaptive-fill-regexp' matches in paragraphs or comments, use it." - (let (prefix) - (catch 'exit - (when (derived-mode-p 'message-mode) - (save-excursion - (beginning-of-line) - (cond ((or (not (message-in-body-p)) - (looking-at orgtbl-line-start-regexp)) - (throw 'exit nil)) - ((looking-at message-cite-prefix-regexp) - (throw 'exit (match-string-no-properties 0))) - ((looking-at org-outline-regexp) - (throw 'exit (make-string (length (match-string 0)) ? )))))) - (org-with-wide-buffer - (let* ((p (line-beginning-position)) - (element (save-excursion - (beginning-of-line) - (or (ignore-errors (org-element-at-point)) - (user-error "An element cannot be parsed line %d" - (line-number-at-pos (point)))))) - (type (org-element-type element)) - (post-affiliated (org-element-property :post-affiliated element))) - (unless (and post-affiliated (< p post-affiliated)) - (case type - (comment + (catch 'exit + (when (derived-mode-p 'message-mode) + (save-excursion + (beginning-of-line) + (cond ((or (not (message-in-body-p)) + (looking-at orgtbl-line-start-regexp)) + (throw 'exit nil)) + ((looking-at message-cite-prefix-regexp) + (throw 'exit (match-string-no-properties 0))) + ((looking-at org-outline-regexp) + (throw 'exit (make-string (length (match-string 0)) ? )))))) + (org-with-wide-buffer + (let* ((p (line-beginning-position)) + (element (save-excursion + (beginning-of-line) + (or (ignore-errors (org-element-at-point)) + (user-error "An element cannot be parsed line %d" + (line-number-at-pos (point)))))) + (type (org-element-type element)) + (post-affiliated (org-element-property :post-affiliated element))) + (unless (and post-affiliated (< p post-affiliated)) + (case type + (comment + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*") + (concat (match-string 0) "# "))) + (footnote-definition "") + ((item plain-list) + (make-string (org-list-item-body-column + (or post-affiliated + (org-element-property :begin element))) + ? )) + (paragraph + ;; Fill prefix is usually the same as the current line, + ;; unless the paragraph is at the beginning of an item. + (let ((parent (org-element-property :parent element))) (save-excursion (beginning-of-line) - (looking-at "[ \t]*#") - (goto-char (match-end 0)) - (let ((comment-prefix (match-string 0))) - (if (looking-at adaptive-fill-regexp) - (concat comment-prefix (match-string 0)) - comment-prefix)))) - (footnote-definition "") - ((item plain-list) - (make-string (org-list-item-body-column - (or post-affiliated - (org-element-property :begin element))) - ? )) - (paragraph - ;; Fill prefix is usually the same as the current line, - ;; unless the paragraph is at the beginning of an item. - (let ((parent (org-element-property :parent element))) - (save-excursion - (beginning-of-line) - (cond ((eq (org-element-type parent) 'item) - (make-string (org-list-item-body-column - (org-element-property :begin parent)) - ? )) - ((looking-at adaptive-fill-regexp) (match-string 0)) - ((looking-at "[ \t]+") (match-string 0)) - (t ""))))) - (comment-block - ;; Only fill contents if P is within block boundaries. - (let* ((cbeg (save-excursion (goto-char post-affiliated) - (forward-line) - (point))) - (cend (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (line-beginning-position)))) - (when (and (>= p cbeg) (< p cend)) - (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) - (match-string 0) - ""))))))))))) + (cond ((eq (org-element-type parent) 'item) + (make-string (org-list-item-body-column + (org-element-property :begin parent)) + ? )) + ((and adaptive-fill-regexp + ;; Locally disable + ;; `adaptive-fill-function' to let + ;; `fill-context-prefix' handle + ;; `adaptive-fill-regexp' variable. + (let (adaptive-fill-function) + (fill-context-prefix + post-affiliated + (org-element-property :end element))))) + ((looking-at "[ \t]+") (match-string 0)) + (t ""))))) + (comment-block + ;; Only fill contents if P is within block boundaries. + (let* ((cbeg (save-excursion (goto-char post-affiliated) + (forward-line) + (point))) + (cend (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (when (and (>= p cbeg) (< p cend)) + (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0) + "")))))))))) (declare-function message-goto-body "message" ()) (defvar message-cite-prefix-regexp) ; From message.el @@ -22588,7 +22693,7 @@ to work in this buffer and calls `reftex-citation' to insert a citation into the buffer. Export of such citations to both LaTeX and HTML is handled by the contributed -package org-exp-bibtex by Taru Karttunen." +package ox-bibtex by Taru Karttunen." (interactive) (let ((reftex-docstruct-symbol 'rds) (reftex-cite-format "\\cite{%l}") @@ -22619,7 +22724,7 @@ beyond the end of the headline." (special (if (consp org-special-ctrl-a/e) (car org-special-ctrl-a/e) org-special-ctrl-a/e)) - refpos) + deactivate-mark refpos) (if (org-bound-and-true-p visual-line-mode) (beginning-of-visual-line 1) (beginning-of-line 1)) @@ -22671,7 +22776,10 @@ beyond the end of the headline." (when (and (= (point) pos) (eq last-command this-command)) (goto-char after-bullet)))))))) (org-no-warnings - (and (featurep 'xemacs) (setq zmacs-region-stays t))))) + (and (featurep 'xemacs) (setq zmacs-region-stays t)))) + (setq disable-point-adjustment + (or (not (invisible-p (point))) + (not (invisible-p (max (point-min) (1- (point)))))))) (defun org-end-of-line (&optional arg) "Go to the end of the line. @@ -22684,7 +22792,8 @@ the cursor is already beyond the end of the headline." (move-fun (cond ((org-bound-and-true-p visual-line-mode) 'end-of-visual-line) ((fboundp 'move-end-of-line) 'move-end-of-line) - (t 'end-of-line)))) + (t 'end-of-line))) + deactivate-mark) (if (or (not special) arg) (call-interactively move-fun) (let* ((element (save-excursion (beginning-of-line) (org-element-at-point))) @@ -22708,7 +22817,10 @@ the cursor is already beyond the end of the headline." ;; after it. Use `end-of-line' to stay on current line. (call-interactively 'end-of-line)) (t (call-interactively move-fun))))) - (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t))))) + (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))) + (setq disable-point-adjustment + (or (not (invisible-p (point))) + (not (invisible-p (max (point-min) (1- (point)))))))) (define-key org-mode-map "\C-a" 'org-beginning-of-line) (define-key org-mode-map "\C-e" 'org-end-of-line) @@ -23182,6 +23294,152 @@ When BLOCK-REGEXP is non-nil, use this regexp to find blocks." (interactive "p") (org-next-block arg t block-regexp)) +(defun org-forward-paragraph () + "Move forward to beginning of next paragraph or equivalent. + +The function moves point to the beginning of the next visible +structural element, which can be a paragraph, a table, a list +item, etc. It also provides some special moves for convenience: + + - On an affiliated keyword, jump to the beginning of the + relative element. + - On an item or a footnote definition, move to the second + element inside, if any. + - On a table or a property drawer, jump after it. + - On a verse or source block, stop after blank lines." + (interactive) + (when (eobp) (user-error "Cannot move further down")) + (let* ((deactivate-mark nil) + (element (org-element-at-point)) + (type (org-element-type element)) + (post-affiliated (org-element-property :post-affiliated element)) + (contents-begin (org-element-property :contents-begin element)) + (contents-end (org-element-property :contents-end element)) + (end (let ((end (org-element-property :end element)) (parent element)) + (while (and (setq parent (org-element-property :parent parent)) + (= (org-element-property :contents-end parent) end)) + (setq end (org-element-property :end parent))) + end))) + (cond ((not element) + (skip-chars-forward " \r\t\n") + (or (eobp) (beginning-of-line))) + ;; On affiliated keywords, move to element's beginning. + ((and post-affiliated (< (point) post-affiliated)) + (goto-char post-affiliated)) + ;; At a table row, move to the end of the table. Similarly, + ;; at a node property, move to the end of the property + ;; drawer. + ((memq type '(node-property table-row)) + (goto-char (org-element-property + :end (org-element-property :parent element)))) + ((memq type '(property-drawer table)) (goto-char end)) + ;; Consider blank lines as separators in verse and source + ;; blocks to ease editing. + ((memq type '(src-block verse-block)) + (when (eq type 'src-block) + (setq contents-end + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (beginning-of-line) + (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n")) + (if (not (re-search-forward "^[ \t]*$" contents-end t)) + (goto-char end) + (skip-chars-forward " \r\t\n") + (if (= (point) contents-end) (goto-char end) + (beginning-of-line)))) + ;; With no contents, just skip element. + ((not contents-begin) (goto-char end)) + ;; If contents are invisible, skip the element altogether. + ((outline-invisible-p (line-end-position)) + (case type + (headline + (org-with-limited-levels (outline-next-visible-heading 1))) + ;; At a plain list, make sure we move to the next item + ;; instead of skipping the whole list. + (plain-list (forward-char) + (org-forward-paragraph)) + (otherwise (goto-char end)))) + ((>= (point) contents-end) (goto-char end)) + ((>= (point) contents-begin) + ;; This can only happen on paragraphs and plain lists. + (case type + (paragraph (goto-char end)) + ;; At a plain list, try to move to second element in + ;; first item, if possible. + (plain-list (end-of-line) + (org-forward-paragraph)))) + ;; When contents start on the middle of a line (e.g. in + ;; items and footnote definitions), try to reach first + ;; element starting after current line. + ((> (line-end-position) contents-begin) + (end-of-line) + (org-forward-paragraph)) + (t (goto-char contents-begin))))) + +(defun org-backward-paragraph () + "Move backward to start of previous paragraph or equivalent. + +The function moves point to the beginning of the current +structural element, which can be a paragraph, a table, a list +item, etc., or to the beginning of the previous visible one if +point is already there. It also provides some special moves for +convenience: + + - On an affiliated keyword, jump to the first one. + - On a table or a property drawer, move to its beginning. + - On a verse or source block, stop before blank lines." + (interactive) + (when (bobp) (user-error "Cannot move further up")) + (let* ((deactivate-mark nil) + (element (org-element-at-point)) + (type (org-element-type element)) + (contents-begin (org-element-property :contents-begin element)) + (contents-end (org-element-property :contents-end element)) + (post-affiliated (org-element-property :post-affiliated element)) + (begin (org-element-property :begin element))) + (cond + ((not element) (goto-char (point-min))) + ((= (point) begin) + (backward-char) + (org-backward-paragraph)) + ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin)) + ((memq type '(node-property table-row)) + (goto-char (org-element-property + :post-affiliated (org-element-property :parent element)))) + ((memq type '(property-drawer table)) (goto-char begin)) + ((memq type '(src-block verse-block)) + (when (eq type 'src-block) + (setq contents-begin + (save-excursion (goto-char begin) (forward-line) (point)))) + (if (= (point) contents-begin) (goto-char post-affiliated) + ;; Inside a verse block, see blank lines as paragraph + ;; separators. + (let ((origin (point))) + (skip-chars-backward " \r\t\n" contents-begin) + (when (re-search-backward "^[ \t]*$" contents-begin 'move) + (skip-chars-forward " \r\t\n" origin) + (if (= (point) origin) (goto-char contents-begin) + (beginning-of-line)))))) + ((not contents-begin) (goto-char (or post-affiliated begin))) + ((eq type 'paragraph) + (goto-char contents-begin) + ;; When at first paragraph in an item or a footnote definition, + ;; move directly to beginning of line. + (let ((parent-contents + (org-element-property + :contents-begin (org-element-property :parent element)))) + (when (and parent-contents (= parent-contents contents-begin)) + (beginning-of-line)))) + ;; At the end of a greater element, move to the beginning of the + ;; last element within. + ((>= (point) contents-end) + (goto-char (1- contents-end)) + (org-backward-paragraph)) + (t (goto-char (or post-affiliated begin)))) + ;; Ensure we never leave point invisible. + (when (outline-invisible-p (point)) (beginning-of-visual-line)))) + (defun org-forward-element () "Move forward by one element. Move to the next element at the same level, when possible." @@ -23611,7 +23869,8 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (not (member-ignore-case word (org-get-export-keywords))) (not (member-ignore-case word (mapcar 'car org-element-block-name-alist))) - (not (member-ignore-case word '("BEGIN" "END" "ATTR")))))) + (not (member-ignore-case word '("BEGIN" "END" "ATTR"))) + (not (org-in-src-block-p))))) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index 59d0152..74a7c64 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -1657,8 +1657,7 @@ contextual information." (buffer-substring (point-min) (point)))) (t (org-remove-indentation (org-element-property :value table)))) ;; Possible add a caption string below. - (when (and caption (not org-ascii-caption-above)) - (concat "\n" caption))))) + (and (not org-ascii-caption-above) caption)))) ;;;; Table Cell @@ -1902,23 +1901,8 @@ Export is done in a buffer named \"*Org ASCII Export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) - (if async - (org-export-async-start - (lambda (output) - (with-current-buffer (get-buffer-create "*Org ASCII Export*") - (erase-buffer) - (insert output) - (goto-char (point-min)) - (text-mode) - (org-export-add-to-stack (current-buffer) 'ascii))) - `(org-export-as 'ascii ,subtreep ,visible-only ,body-only - ',ext-plist)) - (let ((outbuf (org-export-to-buffer - 'ascii "*Org ASCII Export*" - subtreep visible-only body-only ext-plist))) - (with-current-buffer outbuf (text-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf))))) + (org-export-to-buffer 'ascii "*Org ASCII Export*" + async subtreep visible-only body-only ext-plist (lambda () (text-mode)))) ;;;###autoload (defun org-ascii-export-to-ascii @@ -1950,15 +1934,9 @@ file-local settings. Return output file's name." (interactive) - (let ((outfile (org-export-output-file-name ".txt" subtreep))) - (if async - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'ascii)) - `(expand-file-name - (org-export-to-file - 'ascii ,outfile ,subtreep ,visible-only ,body-only ',ext-plist))) - (org-export-to-file - 'ascii outfile subtreep visible-only body-only ext-plist)))) + (let ((file (org-export-output-file-name ".txt" subtreep))) + (org-export-to-file 'ascii file + async subtreep visible-only body-only ext-plist))) ;;;###autoload (defun org-ascii-publish-to-ascii (plist filename pub-dir) diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el index b6e0f3a..a975d24 100644 --- a/lisp/ox-beamer.el +++ b/lisp/ox-beamer.el @@ -194,12 +194,13 @@ open The opening template for the environment, with the following escapes %A the default action/overlay specification %o the options argument of the template %h the headline text - %H if there is headline text, that text in {} braces - %U if there is headline text, that text in [] brackets + %r the raw headline text (i.e. without any processing) + %H if there is headline text, that raw text in {} braces + %U if there is headline text, that raw text in [] brackets close The closing string of the environment." :group 'org-export-beamer :version "24.4" - :package-version '(Org . "8.0") + :package-version '(Org . "8.1") :type '(repeat (list (string :tag "Environment") @@ -538,11 +539,14 @@ used as a communication channel." ((not env) "column") ;; Use specified environment. (t env)))) - (env-format (unless (member environment '("column" "columns")) - (assoc environment - (append org-beamer-environments-special - org-beamer-environments-extra - org-beamer-environments-default)))) + (raw-title (org-element-property :raw-value headline)) + (env-format + (cond ((member environment '("column" "columns")) nil) + ((assoc environment + (append org-beamer-environments-extra + org-beamer-environments-default))) + (t (user-error "Wrong block type at a headline named \"%s\"" + raw-title)))) (title (org-export-data (org-element-property :title headline) info)) (options (let ((options (org-element-property :BEAMER_OPT headline))) (if (not options) "" @@ -587,7 +591,7 @@ used as a communication channel." (if (equal environment "column") options "") (format "%s\\textwidth" column-width))) ;; Block's opening string. - (when env-format + (when (nth 2 env-format) (concat (org-fill-template (nth 2 env-format) @@ -608,12 +612,15 @@ used as a communication channel." (cons "A" ""))))) (list (cons "o" options) (cons "h" title) - (cons "H" (if (equal title "") "" (format "{%s}" title))) - (cons "U" (if (equal title "") "" (format "[%s]" title)))))) + (cons "r" raw-title) + (cons "H" (if (equal raw-title "") "" + (format "{%s}" raw-title))) + (cons "U" (if (equal raw-title "") "" + (format "[%s]" raw-title)))))) "\n")) contents - ;; Block's closing string. - (when environment (concat (nth 3 env-format) "\n")) + ;; Block's closing string, if any. + (and (nth 3 env-format) (concat (nth 3 env-format) "\n")) (when column-width "\\end{column}\n") (when end-columns-p "\\end{columns}")))) @@ -1058,23 +1065,8 @@ Export is done in a buffer named \"*Org BEAMER Export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) - (if async - (org-export-async-start - (lambda (output) - (with-current-buffer (get-buffer-create "*Org BEAMER Export*") - (erase-buffer) - (insert output) - (goto-char (point-min)) - (LaTeX-mode) - (org-export-add-to-stack (current-buffer) 'beamer))) - `(org-export-as 'beamer ,subtreep ,visible-only ,body-only - ',ext-plist)) - (let ((outbuf (org-export-to-buffer - 'beamer "*Org BEAMER Export*" - subtreep visible-only body-only ext-plist))) - (with-current-buffer outbuf (LaTeX-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf))))) + (org-export-to-buffer 'beamer "*Org BEAMER Export*" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) ;;;###autoload (defun org-beamer-export-to-latex @@ -1106,16 +1098,9 @@ file-local settings. Return output file's name." (interactive) - (let ((outfile (org-export-output-file-name ".tex" subtreep))) - (if async - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'beamer)) - `(expand-file-name - (org-export-to-file - 'beamer ,outfile ,subtreep ,visible-only ,body-only - ',ext-plist))) - (org-export-to-file - 'beamer outfile subtreep visible-only body-only ext-plist)))) + (let ((file (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'beamer file + async subtreep visible-only body-only ext-plist))) ;;;###autoload (defun org-beamer-export-to-pdf @@ -1147,18 +1132,10 @@ file-local settings. Return PDF file's name." (interactive) - (if async - (let ((outfile (org-export-output-file-name ".tex" subtreep))) - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'beamer)) - `(expand-file-name - (org-latex-compile - (org-export-to-file - 'beamer ,outfile ,subtreep ,visible-only ,body-only - ',ext-plist))))) - (org-latex-compile - (org-beamer-export-to-latex - nil subtreep visible-only body-only ext-plist)))) + (let ((file (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'beamer file + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))))) ;;;###autoload (defun org-beamer-select-environment () diff --git a/lisp/ox-html.el b/lisp/ox-html.el index 8794882..14b31b2 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -37,7 +37,7 @@ (require 'ox) (require 'ox-publish) (require 'format-spec) -(eval-when-compile (require 'cl) (require 'table)) +(eval-when-compile (require 'cl) (require 'table nil 'noerror)) ;;; Function Declarations @@ -116,6 +116,8 @@ (:html-link-org-as-html nil nil org-html-link-org-files-as-html) (:html-doctype "HTML_DOCTYPE" nil org-html-doctype) (:html-container "HTML_CONTAINER" nil org-html-container-element) + (:html-html5-fancy nil "html5-fancy" org-html-html5-fancy) + (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url) (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) (:html-link-up "HTML_LINK_UP" nil org-html-link-up) (:html-mathjax "HTML_MATHJAX" nil "" space) @@ -123,8 +125,8 @@ (:html-preamble nil "html-preamble" org-html-preamble) (:html-head "HTML_HEAD" nil org-html-head newline) (:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline) - (:html-head-include-default-style "HTML_INCLUDE_STYLE" nil org-html-head-include-default-style newline) - (:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil org-html-head-include-scripts newline) + (:html-head-include-default-style nil "html-style" org-html-head-include-default-style) + (:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts) (:html-table-attributes nil nil org-html-table-default-attributes) (:html-table-row-tags nil nil org-html-table-row-tags) (:html-xml-declaration nil nil org-html-xml-declaration) @@ -143,6 +145,38 @@ (defvar org-html--pre/postamble-class "status" "CSS class used for pre/postamble") +(defconst org-html-doctype-alist + '(("html4-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\" +\"http://www.w3.org/TR/html4/strict.dtd\">") + ("html4-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" +\"http://www.w3.org/TR/html4/loose.dtd\">") + ("html4-frameset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\" +\"http://www.w3.org/TR/html4/frameset.dtd\">") + + ("xhtml-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" +\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">") + ("xhtml-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" +\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">") + ("xhtml-framset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" +\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">") + ("xhtml-11" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" +\"http://www.w3.org/TR/xhtml1/DTD/xhtml11.dtd\">") + + ("html5" . "<!DOCTYPE html>") + ("xhtml5" . "<!DOCTYPE html>")) + "An alist mapping (x)html flavors to specific doctypes.") + +(defconst org-html-html5-elements + '("article" "aside" "audio" "canvas" "details" "figcaption" + "figure" "footer" "header" "menu" "meter" "nav" "output" + "progress" "section" "video") + "New elements in html5. + +<hgroup> is not included because it's currently impossible to +wrap special blocks around multiple headlines. For other blocks +that should contain headlines, use the HTML_CONTAINER property on +the headline itself.") + (defconst org-html-special-string-regexps '(("\\\\-" . "­") ; shy ("---\\([^-]\\)" . "—\\1") ; mdash @@ -680,16 +714,14 @@ When nil, the links still point to the plain `.org' file." ;;;; Links :: Inline images -(defcustom org-html-inline-images 'maybe +(defcustom org-html-inline-images t "Non-nil means inline images into exported HTML pages. This is done using an <img> tag. When nil, an anchor with href is used to -link to the image. If this option is `maybe', then images in links with -an empty description will be inlined, while images with a description will -be linked only." +link to the image." :group 'org-export-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) + :version "24.4" + :package-version '(Org . "8.1") + :type 'boolean) (defcustom org-html-inline-image-rules '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") @@ -748,7 +780,9 @@ in all modes you want. Then, use the command '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" :frame "hsides") "Default attributes and values which will be used in table tags. This is a plist where attributes are symbols, starting with -colons, and values are strings." +colons, and values are strings. + +When exporting to HTML5, these values will be disregarded." :group 'org-export-html :version "24.4" :package-version '(Org . "8.0") @@ -856,7 +890,9 @@ CSS classes, then this prefix can be very useful." "The extension for exported HTML files. %s will be replaced with the charset of the exported file. This may be a string, or an alist with export extensions -and corresponding declarations." +and corresponding declarations. + +This declaration only applies when exporting to XHTML." :group 'org-export-html :type '(choice (string :tag "Single declaration") @@ -872,8 +908,7 @@ Use utf-8 as the default value." :package-version '(Org . "8.0") :type 'coding-system) -(defcustom org-html-doctype - "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" +(defcustom org-html-doctype "xhtml-strict" "Document type definition to use for exported HTML files. Can be set with the in-buffer HTML_DOCTYPE property or for publishing, with :html-doctype." @@ -882,6 +917,20 @@ publishing, with :html-doctype." :package-version '(Org . "8.0") :type 'string) +(defcustom org-html-html5-fancy nil + "Non-nil means using new HTML5 elements. +This variable is ignored for anything other than HTML5 export. + +For compatibility with Internet Explorer, it's probably a good +idea to download some form of the html5shiv (for instance +https://code.google.com/p/html5shiv/) and add it to your +HTML_HEAD_EXTRA, so that your pages don't break for users of IE +versions 8 and below." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defcustom org-html-container-element "div" "HTML element to use for wrapping top level sections. Can be set with the in-buffer HTML_CONTAINER property or for @@ -962,7 +1011,8 @@ You can also customize this for each buffer, using something like (const :format " " mathml) (boolean)))) (defcustom org-html-mathjax-template - "<script type=\"text/javascript\" src=\"%PATH\"> + "<script type=\"text/javascript\" src=\"%PATH\"></script> +<script type=\"text/javascript\"> <!--/*--><![CDATA[/*><!--*/ MathJax.Hub.Config({ // Only one of the two following lines, depending on user settings @@ -1026,7 +1076,7 @@ Setting :html-postamble in publishing projects will take precedence over this variable." :group 'org-export-html :type '(choice (const :tag "No postamble" nil) - (const :tag "Auto postamble" 'auto) + (const :tag "Auto postamble" auto) (const :tag "Default formatting string" t) (string :tag "Custom formatting string") (function :tag "Function (must return a string)"))) @@ -1035,7 +1085,7 @@ precedence over this variable." '(("en" "<p class=\"author\">Author: %a (%e)</p> <p class=\"date\">Date: %d</p> <p class=\"creator\">%c</p> -<p class=\"xhtml-validation\">%v</p>")) +<p class=\"validation\">%v</p>")) "Alist of languages and format strings for the HTML postamble. The first element of each list is the language code, as used for @@ -1056,11 +1106,12 @@ postamble itself. This format string can contain these elements: If you need to use a \"%\" character, you need to escape it like that: \"%%\"." :group 'org-export-html - :type '(alist :key-type (string :tag "Language") - :value-type (string :tag "Format string"))) + :type '(repeat + (list (string :tag "Language") + (string :tag "Format string")))) (defcustom org-html-validation-link - "<a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a>" + "<a href=\"http://validator.w3.org/check?uri=referer\">Validate</a>" "Link to HTML validation service." :group 'org-export-html :type 'string) @@ -1120,8 +1171,9 @@ like that: \"%%\". See the default value of `org-html-postamble-format' for an example." :group 'org-export-html - :type '(alist :key-type (string :tag "Language") - :value-type (string :tag "Format string"))) + :type '(repeat + (list (string :tag "Language") + (string :tag "Format string")))) (defcustom org-html-link-up "" "Where should the \"UP\" link of exported HTML pages lead?" @@ -1133,6 +1185,13 @@ example." :group 'org-export-html :type '(string :tag "File or URL")) +(defcustom org-html-link-use-abs-url nil + "Should we prepend relative links with HTML_LINK_HOME?" + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.1") + :type 'boolean) + (defcustom org-html-home/up-format "<div id=\"org-div-home-and-up\"> <a accesskey=\"h\" href=\"%s\"> UP </a> @@ -1240,6 +1299,26 @@ CSS classes, then this prefix can be very useful." ;;; Internal Functions +(defun org-html-xhtml-p (info) + (let ((dt (downcase (plist-get info :html-doctype)))) + (string-match-p "xhtml" dt))) + +(defun org-html-html5-p (info) + (let ((dt (downcase (plist-get info :html-doctype)))) + (member dt '("html5" "xhtml5" "<!doctype html>")))) + +(defun org-html-close-tag (tag attr info) + (concat "<" tag " " attr + (if (org-html-xhtml-p info) " />" ">"))) + +(defun org-html-doctype (info) + "Return correct html doctype tag from `org-html-doctype-alist', +or the literal value of :html-doctype from INFO if :html-doctype +is not found in the alist. +INFO is a plist used as a communication channel." + (let ((dt (plist-get info :html-doctype))) + (or (cdr (assoc dt org-html-doctype-alist)) dt))) + (defun org-html--make-attribute-string (attributes) "Return a list of attributes, as a string. ATTRIBUTES is a plist where values are either strings or nil. An @@ -1253,32 +1332,43 @@ attributes with a nil value will be omitted from the result." "\"" """ (org-html-encode-plain-text item)))) (setcar output (format "%s=\"%s\"" key value)))))))) -(defun org-html-format-inline-image (src &optional - caption label attr standalone-p) - "Format an inline image from SRC. -CAPTION, LABEL and ATTR are optional arguments providing the -caption, the label and the attribute of the image. -When STANDALONE-P is t, wrap the <img.../> into a <div>...</div>." - (let* ((id (if (not label) "" - (format " id=\"%s\"" (org-export-solidify-link-text label)))) - (attr (concat attr - (cond - ((string-match "\\<alt=" (or attr "")) "") - ((string-match "^ltxpng/" src) - (format " alt=\"%s\"" - (org-html-encode-plain-text - (org-find-text-property-in-string - 'org-latex-src src)))) - (t (format " alt=\"%s\"" - (file-name-nondirectory src))))))) - (cond - (standalone-p - (let ((img (format "<img src=\"%s\" %s/>" src attr))) - (format "\n<div%s class=\"figure\">%s%s\n</div>" - id (format "\n<p>%s</p>" img) - (if (and caption (not (string= caption ""))) - (format "\n<p>%s</p>" caption) "")))) - (t (format "<img src=\"%s\" %s/>" src (concat attr id)))))) +(defun org-html--wrap-image (contents info &optional caption label) + "Wrap CONTENTS string within an appropriate environment for images. +INFO is a plist used as a communication channel. When optional +arguments CAPTION and LABEL are given, use them for caption and +\"id\" attribute." + (let ((html5-fancy (and (org-html-html5-p info) + (plist-get info :html-html5-fancy)))) + (format (if html5-fancy "\n<figure%s>%s%s\n</figure>" + "\n<div%s class=\"figure\">%s%s\n</div>") + ;; ID. + (if (not (org-string-nw-p label)) "" + (format " id=\"%s\"" (org-export-solidify-link-text label))) + ;; Contents. + (format "\n<p>%s</p>" contents) + ;; Caption. + (if (not (org-string-nw-p caption)) "" + (format (if html5-fancy "\n<figcaption>%s</figcaption>" + "\n<p>%s</p>") + caption))))) + +(defun org-html--format-image (source attributes info) + "Return \"img\" tag with given SOURCE and ATTRIBUTES. +SOURCE is a string specifying the location of the image. +ATTRIBUTES is a plist, as returned by +`org-export-read-attribute'. INFO is a plist used as +a communication channel." + (org-html-close-tag + "img" + (org-html--make-attribute-string + (org-combine-plists + (list :src source + :alt (if (string-match-p "^ltxpng/" source) + (org-html-encode-plain-text + (org-find-text-property-in-string 'org-latex-src source)) + (file-name-nondirectory source))) + attributes)) + info)) (defun org-html--textarea-block (element) "Transcode ELEMENT into a textarea block. @@ -1290,6 +1380,13 @@ ELEMENT is either a src block or an example block." (or (plist-get attr :height) (org-count-lines code)) code))) +(defun org-html--has-caption-p (element &optional info) + "Non-nil when ELEMENT has a caption affiliated keyword. +INFO is a plist used as a communication channel. This function +is meant to be used as a predicate for `org-export-get-ordinal' or +a value to `org-html-standalone-image-predicate'." + (org-element-property :caption element)) + ;;;; Table (defun org-html-htmlize-region-for-paste (beg end) @@ -1417,28 +1514,47 @@ INFO is a plist used as a communication channel." (cons 'plain-text org-element-all-objects) 'identity info)))))) (description (plist-get info :description)) - (keywords (plist-get info :keywords))) + (keywords (plist-get info :keywords)) + (charset (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system + 'mime-charset)) + "iso-8859-1"))) (concat (format "<title>%s</title>\n" title) (when (plist-get info :time-stamp-file) (format-time-string (concat "<!-- " org-html-metadata-timestamp-format " -->\n"))) (format - "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>\n" - (or (and org-html-coding-system - (fboundp 'coding-system-get) - (coding-system-get org-html-coding-system 'mime-charset)) - "iso-8859-1")) - (format "<meta name=\"generator\" content=\"Org-mode\"/>\n") + (if (org-html-html5-p info) + (org-html-close-tag "meta" " charset=\"%s\"" info) + (org-html-close-tag + "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"" + info)) + charset) "\n" + (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info) + "\n" (and (org-string-nw-p author) - (format "<meta name=\"author\" content=\"%s\"/>\n" - (funcall protect-string author))) + (concat + (org-html-close-tag "meta" + (format " name=\"author\" content=\"%s\"" + (funcall protect-string author)) + info) + "\n")) (and (org-string-nw-p description) - (format "<meta name=\"description\" content=\"%s\"/>\n" - (funcall protect-string description))) + (concat + (org-html-close-tag "meta" + (format " name=\"description\" content=\"%s\"\n" + (funcall protect-string description)) + info) + "\n")) (and (org-string-nw-p keywords) - (format "<meta name=\"keywords\" content=\"%s\"/>\n" - (funcall protect-string keywords)))))) + (concat + (org-html-close-tag "meta" + (format " name=\"keywords\" content=\"%s\"" + (funcall protect-string keywords)) + info) + "\n"))))) (defun org-html--build-head (info) "Return information for the <head>..</head> of the HTML output. @@ -1451,8 +1567,10 @@ INFO is a plist used as a communication channel." (org-element-normalize-string (plist-get info :html-head-extra)) (when (and (plist-get info :html-htmlized-css-url) (eq org-html-htmlize-output-type 'css)) - (format "<link rel=\"stylesheet\" href=\"%s\" type=\"text/css\" />\n" - (plist-get info :html-htmlized-css-url))) + (org-html-close-tag "link" + (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\"" + (plist-get info :html-htmlized-css-url)) + info)) (when (plist-get info :html-head-include-scripts) org-html-scripts)))) (defun org-html--build-mathjax-config (info) @@ -1549,7 +1667,7 @@ communication channel." (format-time-string org-html-metadata-timestamp-format))) (when (plist-get info :with-creator) (format "<p class=\"creator\">%s</p>\n" creator)) - (format "<p class=\"xhtml-validation\">%s</p>\n" + (format "<p class=\"validation\">%s</p>\n" validation-link)))) (t (format-spec (or (cadr (assoc @@ -1589,23 +1707,29 @@ holding export options." CONTENTS is the transcoded contents string. INFO is a plist holding export options." (concat - (format - (or (and (stringp org-html-xml-declaration) - org-html-xml-declaration) - (cdr (assoc (plist-get info :html-extension) - org-html-xml-declaration)) - (cdr (assoc "html" org-html-xml-declaration)) - - "") - (or (and org-html-coding-system - (fboundp 'coding-system-get) - (coding-system-get org-html-coding-system 'mime-charset)) - "iso-8859-1")) - "\n" - (plist-get info :html-doctype) + (when (and (not (org-html-html5-p info)) (org-html-xhtml-p info)) + (let ((decl (or (and (stringp org-html-xml-declaration) + org-html-xml-declaration) + (cdr (assoc (plist-get info :html-extension) + org-html-xml-declaration)) + (cdr (assoc "html" org-html-xml-declaration)) + + ""))) + (when (not (or (eq nil decl) (string= "" decl))) + (format "%s\n" + (format decl + (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system 'mime-charset)) + "iso-8859-1")))))) + (org-html-doctype info) "\n" - (format "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\">\n" - (plist-get info :language) (plist-get info :language)) + (concat "<html" + (when (org-html-xhtml-p info) + (format + " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\"" + (plist-get info :language) (plist-get info :language))) + ">\n") "<head>\n" (org-html--build-meta-info info) (org-html--build-head info) @@ -1807,9 +1931,13 @@ contents as a string, or nil if it is empty." (mapcar (lambda (headline) (cons (org-html--format-toc-headline headline info) (org-export-get-relative-level headline info))) - (org-export-collect-headlines info depth)))) + (org-export-collect-headlines info depth))) + (outer-tag (if (and (org-html-html5-p info) + (plist-get info :html-html5-fancy)) + "nav" + "div"))) (when toc-entries - (concat "<div id=\"table-of-contents\">\n" + (concat (format "<%s id=\"table-of-contents\">\n" outer-tag) (format "<h%d>%s</h%d>\n" org-html-toplevel-hlevel (org-html--translate "Table of Contents" info) @@ -1817,7 +1945,7 @@ contents as a string, or nil if it is empty." "<div id=\"text-table-of-contents\">" (org-html--toc-text toc-entries) "</div>\n" - "</div>\n")))) + (format "</%s>\n" outer-tag))))) (defun org-html--toc-text (toc-entries) "Return innards of a table of contents, as a string. @@ -1862,16 +1990,17 @@ INFO is a plist used as a communication channel." headline-number "-")))) ;; Body. (concat section-number - (org-export-data-with-translations + (org-export-data-with-backend (org-export-get-alt-title headline info) - ;; Ignore any footnote-reference, link, - ;; radio-target and target in table of contents. - (append - '((footnote-reference . ignore) - (link . (lambda (link desc i) desc)) - (radio-target . (lambda (radio desc i) desc)) - (target . ignore)) - (org-export-backend-translate-table 'html)) + ;; Create an anonymous back-end that will ignore + ;; any footnote-reference, link, radio-target and + ;; target in table of contents. + (org-export-create-backend + :parent 'html + :transcoders '((footnote-reference . ignore) + (link . (lambda (object c i) c)) + (radio-target . (lambda (object c i) c)) + (target . ignore))) info) (and tags "   ") (org-html--tags tags))))) @@ -1888,7 +2017,8 @@ of listings as a string, or nil if it is empty." org-html-toplevel-hlevel) "<div id=\"text-list-of-listings\">\n<ul>\n" (let ((count 0) - (initial-fmt (org-html--translate "Listing %d:" info))) + (initial-fmt (format "<span class=\"listing-number\">%s</span>" + (org-html--translate "Listing %d:" info)))) (mapconcat (lambda (entry) (let ((label (org-element-property :name entry)) @@ -1922,7 +2052,8 @@ of tables as a string, or nil if it is empty." org-html-toplevel-hlevel) "<div id=\"text-list-of-tables\">\n<ul>\n" (let ((count 0) - (initial-fmt (org-html--translate "Table %d:" info))) + (initial-fmt (format "<span class=\"table-number\">%s</span>" + (org-html--translate "Table %d:" info)))) (mapconcat (lambda (entry) (let ((label (org-element-property :name entry)) @@ -2154,7 +2285,7 @@ holding contextual information." ;; Build the real contents of the sub-tree. (let* ((type (if numberedp 'ordered 'unordered)) (itemized-body (org-html-format-list-item - contents type nil nil full-text))) + contents type nil info nil full-text))) (concat (and (org-export-first-sibling-p headline info) (org-html-begin-plain-list type)) @@ -2214,7 +2345,7 @@ holding contextual information." (defun org-html-horizontal-rule (horizontal-rule contents info) "Transcode an HORIZONTAL-RULE object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." - "<hr/>") + (org-html-close-tag "hr" nil info)) ;;;; Inline Src Block @@ -2250,8 +2381,9 @@ holding contextual information." (org-html-format-headline--wrap inlinetask info format-function :contents contents))) ;; Otherwise, use a default template. - (t (format "<div class=\"inlinetask\">\n<b>%s</b><br/>\n%s</div>" + (t (format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>" (org-html-format-headline--wrap inlinetask info) + (org-html-close-tag "br" nil info) contents)))) ;;;; Italic @@ -2271,11 +2403,12 @@ contextual information." (trans "<code>[-]</code>") (t ""))) -(defun org-html-format-list-item (contents type checkbox +(defun org-html-format-list-item (contents type checkbox info &optional term-counter-id headline) "Format a list item into HTML." - (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " ")))) + (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " "))) + (br (org-html-close-tag "br" nil info))) (concat (case type (ordered @@ -2283,13 +2416,13 @@ contextual information." (extra (if counter (format " value=\"%s\"" counter) ""))) (concat (format "<li%s>" extra) - (when headline (concat headline "<br/>"))))) + (when headline (concat headline br))))) (unordered (let* ((id term-counter-id) (extra (if id (format " id=\"%s\"" id) ""))) (concat (format "<li%s>" extra) - (when headline (concat headline "<br/>"))))) + (when headline (concat headline br))))) (descriptive (let* ((term term-counter-id)) (setq term (or term "(no term)")) @@ -2315,7 +2448,7 @@ contextual information." (tag (let ((tag (org-element-property :tag item))) (and tag (org-export-data tag info))))) (org-html-format-list-item - contents type checkbox (or tag counter)))) + contents type checkbox info (or tag counter)))) ;;;; Keyword @@ -2363,21 +2496,19 @@ CONTENTS is nil. INFO is a plist holding contextual information." (let ((processing-type (plist-get info :with-latex)) (latex-frag (org-remove-indentation (org-element-property :value latex-environment))) - (caption (org-export-data - (org-export-get-caption latex-environment) info)) - (attr nil) ; FIXME - (label (org-element-property :name latex-environment))) - (cond - ((memq processing-type '(t mathjax)) - (org-html-format-latex latex-frag 'mathjax)) - ((eq processing-type 'dvipng) - (let* ((formula-link (org-html-format-latex - latex-frag processing-type))) - (when (and formula-link - (string-match "file:\\([^]]*\\)" formula-link)) - (org-html-format-inline-image - (match-string 1 formula-link) caption label attr t)))) - (t latex-frag)))) + (attributes (org-export-read-attribute :attr_html latex-environment))) + (case processing-type + ((t mathjax) + (org-html-format-latex latex-frag 'mathjax)) + ((dvipng imagemagick) + (let ((formula-link (org-html-format-latex latex-frag processing-type))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + ;; Do not provide a caption or a name to be consistent with + ;; `mathjax' handling. + (org-html--wrap-image + (org-html--format-image + (match-string 1 formula-link) attributes info) info)))) + (t latex-frag)))) ;;;; Latex Fragment @@ -2389,13 +2520,10 @@ CONTENTS is nil. INFO is a plist holding contextual information." (case processing-type ((t mathjax) (org-html-format-latex latex-frag 'mathjax)) - (dvipng - (let* ((formula-link (org-html-format-latex - latex-frag processing-type))) - (when (and formula-link - (string-match "file:\\([^]]*\\)" formula-link)) - (org-html-format-inline-image - (match-string 1 formula-link))))) + ((dvipng imagemagick) + (let ((formula-link (org-html-format-latex latex-frag processing-type))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + (org-html--format-image (match-string 1 formula-link) nil info)))) (t latex-frag)))) ;;;; Line Break @@ -2403,79 +2531,69 @@ CONTENTS is nil. INFO is a plist holding contextual information." (defun org-html-line-break (line-break contents info) "Transcode a LINE-BREAK object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." - "<br/>\n") + (concat (org-html-close-tag "br" nil info) "\n")) ;;;; Link -(defun org-html-link--inline-image (link desc info) - "Return HTML code for an inline image. - -LINK is the link pointing to the inline image. INFO is a plist -used as a communication channel. - -Inline images can have these attributes: - -#+ATTR_HTML: :width 100px :height 100px :alt \"Alt description\"." - (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - (path (cond ((member type '("http" "https")) - (concat type ":" raw-path)) - ((file-name-absolute-p raw-path) - (expand-file-name raw-path)) - (t raw-path))) - (parent (org-export-get-parent-element link)) - (caption (org-export-data (org-export-get-caption parent) info)) - (label (org-element-property :name parent))) - ;; Return proper string, depending on DISPOSITION. - (org-html-format-inline-image - path caption label - (org-html--make-attribute-string - (org-export-read-attribute :attr_html parent)) - (org-html-standalone-image-p link info)))) +(defun org-html-inline-image-p (link info) + "Non-nil when LINK is meant to appear as an image. +INFO is a plist used as a communication channel. LINK is an +inline image when it has no description and targets an image +file (see `org-html-inline-image-rules' for more information), or +if its description is a single link targeting an image file." + (if (not (org-element-contents link)) + (org-export-inline-image-p link org-html-inline-image-rules) + (not + (let ((link-count 0)) + (org-element-map (org-element-contents link) + (cons 'plain-text org-element-all-objects) + (lambda (obj) + (case (org-element-type obj) + (plain-text (org-string-nw-p obj)) + (link (if (= link-count 1) t + (incf link-count) + (not (org-export-inline-image-p + obj org-html-inline-image-rules)))) + (otherwise t))) + info t))))) (defvar org-html-standalone-image-predicate) -(defun org-html-standalone-image-p (element info &optional predicate) - "Test if ELEMENT is a standalone image for the purpose HTML export. +(defun org-html-standalone-image-p (element info) + "Test if ELEMENT is a standalone image. + INFO is a plist holding contextual information. -Return non-nil, if ELEMENT is of type paragraph and it's sole -content, save for whitespaces, is a link that qualifies as an +Return non-nil, if ELEMENT is of type paragraph and its sole +content, save for white spaces, is a link that qualifies as an inline image. -Return non-nil, if ELEMENT is of type link and it's containing -paragraph has no other content save for leading and trailing -whitespaces. +Return non-nil, if ELEMENT is of type link and its containing +paragraph has no other content save white spaces. Return nil, otherwise. -Bind `org-html-standalone-image-predicate' to constrain -paragraph further. For example, to check for only captioned -standalone images, do the following. +Bind `org-html-standalone-image-predicate' to constrain paragraph +further. For example, to check for only captioned standalone +images, set it to: - \(setq org-html-standalone-image-predicate - \(lambda \(paragraph\) - \(org-element-property :caption paragraph\)\)\)" + \(lambda (paragraph) (org-element-property :caption paragraph))" (let ((paragraph (case (org-element-type element) (paragraph element) - (link (and (org-export-inline-image-p - element org-html-inline-image-rules) - (org-export-get-parent element))) - (t nil)))) - (when (eq (org-element-type paragraph) 'paragraph) - (when (or (not (and (boundp 'org-html-standalone-image-predicate) - (functionp org-html-standalone-image-predicate))) - (funcall org-html-standalone-image-predicate paragraph)) - (let ((contents (org-element-contents paragraph))) - (loop for x in contents - with inline-image-count = 0 - always (cond - ((eq (org-element-type x) 'plain-text) - (not (org-string-nw-p x))) - ((eq (org-element-type x) 'link) - (when (org-export-inline-image-p - x org-html-inline-image-rules) - (= (incf inline-image-count) 1))) - (t nil)))))))) + (link (org-export-get-parent element))))) + (and (eq (org-element-type paragraph) 'paragraph) + (or (not (and (boundp 'org-html-standalone-image-predicate) + (functionp org-html-standalone-image-predicate))) + (funcall org-html-standalone-image-predicate paragraph)) + (not (let ((link-count 0)) + (org-element-map (org-element-contents paragraph) + (cons 'plain-text org-element-all-objects) + (lambda (obj) (case (org-element-type obj) + (plain-text (org-string-nw-p obj)) + (link + (or (> (incf link-count) 1) + (not (org-html-inline-image-p obj info)))) + (otherwise t))) + info 'first-match 'link)))))) (defun org-html-link (link desc info) "Transcode a LINK object from Org to HTML. @@ -2483,7 +2601,10 @@ standalone images, do the following. DESC is the description part of the link, or the empty string. INFO is a plist holding contextual information. See `org-export-data'." - (let* ((link-org-files-as-html-maybe + (let* ((home (when (plist-get info :html-link-home) + (org-trim (plist-get info :html-link-home)))) + (use-abs-url (plist-get info :html-link-use-abs-url)) + (link-org-files-as-html-maybe (function (lambda (raw-path info) "Treat links to `file.org' as links to `file.html', if needed. @@ -2509,9 +2630,12 @@ INFO is a plist holding contextual information. See (funcall link-org-files-as-html-maybe raw-path info)) ;; If file path is absolute, prepend it with protocol ;; component - "file://". - (when (file-name-absolute-p raw-path) - (setq raw-path - (concat "file://" (expand-file-name raw-path)))) + (cond ((file-name-absolute-p raw-path) + (setq raw-path + (concat "file://" (expand-file-name + raw-path)))) + ((and home use-abs-url) + (setq raw-path (concat (file-name-as-directory home) raw-path)))) ;; Add search option, if any. A search option can be ;; relative to a custom-id or a headline title. Any other ;; option is ignored. @@ -2531,25 +2655,28 @@ INFO is a plist holding contextual information. See numbers "-")))))) (t raw-path)))) (t raw-path))) - ;; Extract attributes from parent's paragraph. HACK: Only do - ;; this for the first link in parent. This is needed as long - ;; as attributes cannot be set on a per link basis. + ;; Extract attributes from parent's paragraph. HACK: Only do + ;; this for the first link in parent (inner image link for + ;; inline images). This is needed as long as attributes + ;; cannot be set on a per link basis. + (attributes-plist + (let* ((parent (org-export-get-parent-element link)) + (link (let ((container (org-export-get-parent link))) + (if (and (eq (org-element-type container) 'link) + (org-html-inline-image-p link info)) + container + link)))) + (and (eq (org-element-map parent 'link 'identity info t) link) + (org-export-read-attribute :attr_html parent)))) (attributes - (let ((parent (org-export-get-parent-element link))) - (if (not (eq (org-element-map parent 'link 'identity info t) link)) - "" - (let ((att (org-html--make-attribute-string - (org-export-read-attribute :attr_html parent)))) - (cond ((not (org-string-nw-p att)) "") - ((and desc (string-match (regexp-quote att) desc)) "") - (t (concat " " att))))))) + (let ((attr (org-html--make-attribute-string attributes-plist))) + (if (org-string-nw-p attr) (concat " " attr) ""))) protocol) (cond ;; Image file. - ((and (or (eq t org-html-inline-images) - (and org-html-inline-images (not desc))) + ((and org-html-inline-images (org-export-inline-image-p link org-html-inline-image-rules)) - (org-html-link--inline-image link desc info)) + (org-html--format-image path attributes-plist info)) ;; Radio target: Transcode target's contents and use them as ;; link's description. ((string= type "radio") @@ -2580,8 +2707,6 @@ INFO is a plist holding contextual information. See (or desc (org-export-data (org-element-property :raw-link link) info)))) - ;; Fuzzy link points to an invisible target. - (keyword nil) ;; Link points to a headline. (headline (let ((href @@ -2615,21 +2740,24 @@ INFO is a plist holding contextual information. See :title destination) info))))) (format "<a href=\"#%s\"%s>%s</a>" (org-export-solidify-link-text href) attributes desc))) - ;; Fuzzy link points to a target. Do as above. + ;; Fuzzy link points to a target or an element. (t - (let ((path (org-export-solidify-link-text path)) number) - (unless desc - (setq number (cond - ((org-html-standalone-image-p destination info) - (org-export-get-ordinal - (assoc 'link (org-element-contents destination)) - info 'link 'org-html-standalone-image-p)) - (t (org-export-get-ordinal destination info)))) - (setq desc (when number - (if (atom number) (number-to-string number) - (mapconcat 'number-to-string number "."))))) - (format "<a href=\"#%s\"%s>%s</a>" - path attributes (or desc "No description for this link"))))))) + (let* ((path (org-export-solidify-link-text path)) + (org-html-standalone-image-predicate 'org-html--has-caption-p) + (number (cond + (desc nil) + ((org-html-standalone-image-p destination info) + (org-export-get-ordinal + (org-element-map destination 'link + 'identity info t) + info 'link 'org-html-standalone-image-p)) + (t (org-export-get-ordinal + destination info nil 'org-html--has-caption-p)))) + (desc (cond (desc) + ((not number) "No description for this link") + ((numberp number) (number-to-string number)) + (t (mapconcat 'number-to-string number "."))))) + (format "<a href=\"#%s\"%s>%s</a>" path attributes desc)))))) ;; Coderef: replace link with the reference name or the ;; equivalent line number. ((string= type "coderef") @@ -2668,11 +2796,27 @@ the plist used as a communication channel." ((and (eq (org-element-type parent) 'item) (= (org-element-property :begin paragraph) (org-element-property :contents-begin parent))) - ;; leading paragraph in a list item have no tags + ;; Leading paragraph in a list item have no tags. contents) ((org-html-standalone-image-p paragraph info) - ;; standalone image - contents) + ;; Standalone image. + (let ((caption + (let ((raw (org-export-data + (org-export-get-caption paragraph) info)) + (org-html-standalone-image-predicate + 'org-html--has-caption-p)) + (if (not (org-string-nw-p raw)) raw + (concat + "<span class=\"figure-number\">" + (format (org-html--translate "Figure %d:" info) + (org-export-get-ordinal + (org-element-map paragraph 'link + 'identity info t) + info nil 'org-html-standalone-image-p)) + "</span> " raw)))) + (label (org-element-property :name paragraph))) + (org-html--wrap-image contents info caption label))) + ;; Regular paragraph. (t (format "<p%s>\n%s</p>" extra contents))))) ;;;; Plain List @@ -2746,7 +2890,8 @@ contextual information." (when (plist-get info :preserve-breaks) (setq output (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" "<br/>\n" output))) + "\\(\\\\\\\\\\)?[ \t]*\n" + (concat (org-html-close-tag "br" nil info) "\n") output))) ;; Return value. output)) @@ -2846,9 +2991,25 @@ contextual information." "Transcode a SPECIAL-BLOCK element from Org to HTML. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (format "<div class=\"%s\">\n%s\n</div>" - (downcase (org-element-property :type special-block)) - contents)) + (let* ((block-type (downcase + (org-element-property :type special-block))) + (contents (or contents "")) + (html5-fancy (and (org-html-html5-p info) + (plist-get info :html-html5-fancy) + (member block-type org-html-html5-elements))) + (attributes (org-export-read-attribute :attr_html special-block))) + (unless html5-fancy + (let ((class (plist-get attributes :class))) + (setq attributes (plist-put attributes :class + (if class (concat class " " block-type) + block-type))))) + (setq attributes (org-html--make-attribute-string attributes)) + (when (not (equal attributes "")) + (setq attributes (concat " " attributes))) + (if html5-fancy + (format "<%s%s>\n%s</%s>" block-type attributes + contents block-type) + (format "<div%s>\n%s\n</div>" attributes contents)))) ;;;; Src Block @@ -3020,11 +3181,14 @@ contextual information." (t (let* ((label (org-element-property :name table)) (caption (org-export-get-caption table)) + (number (org-export-get-ordinal + table info nil 'org-html--has-caption-p)) (attributes (org-html--make-attribute-string (org-combine-plists (and label (list :id (org-export-solidify-link-text label))) - (plist-get info :html-table-attributes) + (and (not (org-html-html5-p info)) + (plist-get info :html-table-attributes)) (org-export-read-attribute :attr_html table)))) (alignspec (if (and (boundp 'org-html-format-table-no-css) @@ -3043,7 +3207,9 @@ contextual information." table-cell info) "\n<colgroup>") ;; Add a column. Also specify it's alignment. - (format "\n<col %s/>" (format alignspec alignment)) + (format "\n%s" + (org-html-close-tag + "col" (concat " " (format alignspec alignment)) info)) ;; End a colgroup? (when (org-export-table-cell-ends-colgroup-p table-cell info) @@ -3052,8 +3218,13 @@ contextual information." (format "<table%s>\n%s\n%s\n%s</table>" (if (equal attributes "") "" (concat " " attributes)) (if (not caption) "" - (format "<caption>%s</caption>" - (org-export-data caption info))) + (format (if org-html-table-caption-above + "<caption align=\"above\">%s</caption>" + "<caption align=\"bottom\">%s</caption>") + (concat + "<span class=\"table-number\">" + (format (org-html--translate "Table %d:" info) number) + "</span> " (org-export-data caption info)))) (funcall table-column-specs table info) contents))))) @@ -3105,9 +3276,10 @@ contextual information." ;; Replace each newline character with line break. Also replace ;; each blank line with a line break. (setq contents (replace-regexp-in-string - "^ *\\\\\\\\$" "<br/>\n" + "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info)) (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" " <br/>\n" contents))) + "\\(\\\\\\\\\\)?[ \t]*\n" + (format "%s\n" (org-html-close-tag "br" nil info)) contents))) ;; Replace each white space at beginning of a line with a ;; non-breaking space. (while (string-match "^[ \t]+" contents) @@ -3167,23 +3339,9 @@ Export is done in a buffer named \"*Org HTML Export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) - (if async - (org-export-async-start - (lambda (output) - (with-current-buffer (get-buffer-create "*Org HTML Export*") - (erase-buffer) - (insert output) - (goto-char (point-min)) - (set-auto-mode t) - (org-export-add-to-stack (current-buffer) 'html))) - `(org-export-as 'html ,subtreep ,visible-only ,body-only ',ext-plist)) - (let ((outbuf (org-export-to-buffer - 'html "*Org HTML Export*" - subtreep visible-only body-only ext-plist))) - ;; Set major mode. - (with-current-buffer outbuf (set-auto-mode t)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf))))) + (org-export-to-buffer 'html "*Org HTML Export*" + async subtreep visible-only body-only ext-plist + (lambda () (set-auto-mode t)))) ;;;###autoload (defun org-html-convert-region-to-html () @@ -3227,16 +3385,8 @@ Return output file's name." (let* ((extension (concat "." org-html-extension)) (file (org-export-output-file-name extension subtreep)) (org-export-coding-system org-html-coding-system)) - (if async - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'html)) - (let ((org-export-coding-system org-html-coding-system)) - `(expand-file-name - (org-export-to-file - 'html ,file ,subtreep ,visible-only ,body-only ',ext-plist)))) - (let ((org-export-coding-system org-html-coding-system)) - (org-export-to-file - 'html file subtreep visible-only body-only ext-plist))))) + (org-export-to-file 'html file + async subtreep visible-only body-only ext-plist))) ;;;###autoload (defun org-html-publish-to-html (plist filename pub-dir) @@ -3260,7 +3410,6 @@ Return output file name." ;;;; org-format-table-table-html ;;;; org-table-number-fraction ;;;; org-table-number-regexp -;;;; org-html-table-caption-above ;;;; org-html-inline-image-extensions ;;;; org-export-preferred-target-alist ;;;; class for anchors diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el index c6ab295..612fd79 100644 --- a/lisp/ox-icalendar.el +++ b/lisp/ox-icalendar.el @@ -826,21 +826,10 @@ Return ICS file name." ;; Export part. Since this back-end is backed up by `ascii', ensure ;; links will not be collected at the end of sections. (let ((outfile (org-export-output-file-name ".ics" subtreep))) - (if async - (org-export-async-start - (lambda (f) - (org-export-add-to-stack f 'icalendar) - (run-hook-with-args 'org-icalendar-after-save-hook f)) - `(let ((org-ascii-links-to-notes nil)) - (expand-file-name - (org-export-to-file - 'icalendar ,outfile ,subtreep ,visible-only ,body-only - '(:ascii-charset utf-8))))) - (let ((org-ascii-links-to-notes nil)) - (org-export-to-file 'icalendar outfile subtreep visible-only body-only - '(:ascii-charset utf-8))) - (run-hook-with-args 'org-icalendar-after-save-hook outfile) - outfile))) + (org-export-to-file 'icalendar outfile + async subtreep visible-only body-only '(:ascii-charset utf-8) + (lambda (file) + (run-hook-with-args 'org-icalendar-after-save-hook file) nil)))) ;;;###autoload (defun org-icalendar-export-agenda-files (&optional async) diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 0fffd82..e1173ef 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -143,7 +143,9 @@ ("la" . "latin") ("ms" . "malay") ("nl" . "dutch") - ("no-no" . "nynorsk") + ("nb" . "norsk") + ("nn" . "nynorsk") + ("no" . "norsk") ("pl" . "polish") ("pt" . "portuguese") ("ro" . "romanian") @@ -255,12 +257,17 @@ to \\providecommand, and then place \\usepackage commands based on the content of `org-latex-packages-alist'. If your header, `org-latex-default-packages-alist' or -`org-latex-packages-alist' inserts -\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be -replaced with a coding system derived from -`buffer-file-coding-system'. See also the variable +`org-latex-packages-alist' inserts \"\\usepackage[AUTO]{inputenc}\", +AUTO will automatically be replaced with a coding system derived +from `buffer-file-coding-system'. See also the variable `org-latex-inputenc-alist' for a way to influence this mechanism. +Likewise, if your header contains \"\\usepackage[AUTO]{babel}\", +AUTO will be replaced with the language related to the language +code specified by `org-export-default-language', which see. Note +that constructions such as \"\\usepackage[french,AUTO,english]{babel}\" +are permitted. + The sectioning structure ------------------------ @@ -337,7 +344,6 @@ the toc:nil option, not to those generated with #+TOC keyword." :group 'org-export-latex :type 'boolean) - ;;;; Headline (defcustom org-latex-format-headline-function @@ -420,7 +426,7 @@ environment." :type 'string) (defcustom org-latex-inline-image-rules - '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\)\\'")) + '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'")) "Rules characterizing image files that can be inlined into LaTeX. A rule consists in an association whose key is the type of link @@ -658,7 +664,7 @@ into previewing problems, please consult (fortran "fortran") (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") (html "HTML") (xml "XML") - (tex "TeX") (latex "TeX") + (tex "TeX") (latex "[LaTeX]TeX") (shell-script "bash") (gnuplot "Gnuplot") (ocaml "Caml") (caml "Caml") @@ -745,20 +751,6 @@ options will be applied to blocks of all languages." (string :tag "Minted option name ") (string :tag "Minted option value")))) -(defcustom org-latex-long-listings nil - "When non-nil no listing will be wrapped within a float. - -Removing floats may break some functionalities. For example, it -will be impossible to use cross-references to listings when using -`minted' set-up when this variable is non-nil. - -This value can be locally ignored with \":long-listing t\" and -\":long-listing nil\" LaTeX attributes." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - (defvar org-latex-custom-lang-environments nil "Alist mapping languages to language-specific LaTeX environments. @@ -800,8 +792,12 @@ the infamous egrep/locale bug: http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html -then `texi2dvi' is the superior choice. Org does offer it as one -of the customize options. +then `texi2dvi' is the superior choice as it automates the LaTeX +build process by calling the \"correct\" combinations of +auxiliary programs. Org does offer `texi2dvi' as one of the +customize options. Alternatively, `rubber' and `latexmk' also +provide similar functionality. The latter supports `biber' out +of the box. Alternatively, this may be a Lisp function that does the processing, so you could use this to apply the machinery of @@ -839,6 +835,8 @@ file name as its single argument." ("texi2dvi -p -b -V %f")) (const :tag "rubber" ("rubber -d --into %o %f")) + (const :tag "latexmk" + ("latexmk -g -pdf %f")) (function))) (defcustom org-latex-logfiles-extensions @@ -891,8 +889,11 @@ For non-floats, see `org-latex--wrap-label'." (format "\\label{%s}" (org-export-solidify-link-text label)))) (main (org-export-get-caption element)) - (short (org-export-get-caption element t))) + (short (org-export-get-caption element t)) + (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption))) (cond + ((org-string-nw-p caption-from-attr-latex) + (concat caption-from-attr-latex "\n")) ((and (not main) (equal label-str "")) "") ((not main) (concat label-str "\n")) ;; Option caption format with short name. @@ -931,6 +932,10 @@ Insertion of guessed language only happens when Babel package has explicitly been loaded. Then it is added to the rest of package's options. +The argument to Babel may be \"AUTO\" which is then replaced with +the language of the document or `org-export-default-language' +unless language in question is already loaded. + Return the new header." (let ((language-code (plist-get info :language))) ;; If no language is set or Babel package is not loaded, return @@ -939,16 +944,19 @@ Return the new header." (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header))) header (let ((options (save-match-data - (org-split-string (match-string 1 header) ","))) + (org-split-string (match-string 1 header) ",[ \t]*"))) (language (cdr (assoc language-code org-latex-babel-language-alist)))) - ;; If LANGUAGE is already loaded, return header. Otherwise, - ;; append LANGUAGE to other options. - (if (member language options) header - (replace-match (mapconcat 'identity - (append options (list language)) - ",") - nil nil header 1)))))) + ;; If LANGUAGE is already loaded, return header without AUTO. + ;; Otherwise, replace AUTO with language or append language if + ;; AUTO is not present. + (replace-match + (mapconcat (lambda (option) (if (equal "AUTO" option) language option)) + (cond ((member language options) (delete "AUTO" options)) + ((member "AUTO" options) options) + (t (append options (list language)))) + ", ") + t nil header 1))))) (defun org-latex--find-verb-separator (s) "Return a character not used in string S. @@ -1553,7 +1561,7 @@ contextual information." (1- count))))) (checkbox (case (org-element-property :checkbox item) (on "$\\boxtimes$ ") - (off "$\\Box$ ") + (off "$\\square$ ") (trans "$\\boxminus$ "))) (tag (let ((tag (org-element-property :tag item))) ;; Check-boxes must belong to the tag. @@ -1656,10 +1664,12 @@ used as a communication channel." ;; Retrieve latex attributes from the element around. (attr (org-export-read-attribute :attr_latex parent)) (float (let ((float (plist-get attr :float))) - (cond ((string= float "wrap") 'wrap) + (cond ((and (not float) (plist-member attr :float)) nil) + ((string= float "wrap") 'wrap) ((string= float "multicolumn") 'multicolumn) - ((or (string= float "figure") - (org-element-property :caption parent)) + ((or float + (org-element-property :caption parent) + (org-string-nw-p (plist-get attr :caption))) 'figure)))) (placement (let ((place (plist-get attr :placement))) @@ -1684,7 +1694,7 @@ used as a communication channel." (if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt (match-string 1 opt)))) image-code) - (if (equal filetype "tikz") + (if (member filetype '("tikz" "pgf")) ;; For tikz images: ;; - use \input to read in image file. ;; - if options are present, wrap in a tikzpicture environment. @@ -1715,7 +1725,16 @@ used as a communication channel." ((= (aref options 0) ?,) (format "[%s]"(substring options 1))) (t (format "[%s]" options))) - path))) + path)) + (when (equal filetype "svg") + (setq image-code (replace-regexp-in-string "^\\\\includegraphics" + "\\includesvg" + image-code + nil t)) + (setq image-code (replace-regexp-in-string "\\.svg}" + "}" + image-code + nil t)))) ;; Return proper string, depending on FLOAT. (case float (wrap (format "\\begin{wrapfigure}%s @@ -2018,21 +2037,24 @@ contextual information." (continued (org-export-get-loc src-block info)) (new 0))) (retain-labels (org-element-property :retain-labels src-block)) - (long-listing - (let ((attr (org-export-read-attribute :attr_latex src-block))) - (if (plist-member attr :long-listing) - (plist-get attr :long-listing) - org-latex-long-listings)))) + (attributes (org-export-read-attribute :attr_latex src-block)) + (float (plist-get attributes :float))) (cond ;; Case 1. No source fontification. ((not org-latex-listings) (let* ((caption-str (org-latex--caption/label-string src-block info)) - (float-env (and (not long-listing) - (or label caption) - (format "\\begin{figure}[H]\n%s%%s\n\\end{figure}" - caption-str)))) + (float-env + (cond ((and (not float) (plist-member attributes :float)) "%s") + ((string= "multicolumn" float) + (format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}" + org-latex-default-figure-position + caption-str)) + ((or caption float) + (format "\\begin{figure}[H]\n%%s%s\n\\end{figure}" + caption-str)) + (t "%s")))) (format - (or float-env "%s") + float-env (concat (format "\\begin{verbatim}\n%s\\end{verbatim}" (org-export-format-code-default src-block info)))))) ;; Case 2. Custom environment. @@ -2042,46 +2064,52 @@ contextual information." custom-env)) ;; Case 3. Use minted package. ((eq org-latex-listings 'minted) - (let ((float-env - (and (not long-listing) - (or label caption) - (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" - (org-latex--caption/label-string src-block info)))) - (body - (format - "\\begin{minted}[%s]{%s}\n%s\\end{minted}" - ;; Options. - (org-latex--make-option-string - (if (or (not num-start) - (assoc "linenos" org-latex-minted-options)) - org-latex-minted-options - (append `(("linenos") - ("firstnumber" ,(number-to-string (1+ num-start)))) - org-latex-minted-options))) - ;; Language. - (or (cadr (assq (intern lang) org-latex-minted-langs)) lang) - ;; Source code. - (let* ((code-info (org-export-unravel-code src-block)) - (max-width - (apply 'max - (mapcar 'length - (org-split-string (car code-info) - "\n"))))) - (org-export-format-code - (car code-info) - (lambda (loc num ref) - (concat - loc - (when ref - ;; Ensure references are flushed to the right, - ;; separated with 6 spaces from the widest line - ;; of code. - (concat (make-string (+ (- max-width (length loc)) 6) - ?\s) - (format "(%s)" ref))))) - nil (and retain-labels (cdr code-info))))))) + (let* ((caption-str (org-latex--caption/label-string src-block info)) + (float-env + (cond ((and (not float) (plist-member attributes :float)) "%s") + ((string= "multicolumn" float) + (format "\\begin{listing*}\n%%s\n%s\\end{listing*}" + caption-str)) + ((or caption float) + (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" + caption-str)) + (t "%s"))) + (body + (format + "\\begin{minted}[%s]{%s}\n%s\\end{minted}" + ;; Options. + (org-latex--make-option-string + (if (or (not num-start) + (assoc "linenos" org-latex-minted-options)) + org-latex-minted-options + (append + `(("linenos") + ("firstnumber" ,(number-to-string (1+ num-start)))) + org-latex-minted-options))) + ;; Language. + (or (cadr (assq (intern lang) org-latex-minted-langs)) lang) + ;; Source code. + (let* ((code-info (org-export-unravel-code src-block)) + (max-width + (apply 'max + (mapcar 'length + (org-split-string (car code-info) + "\n"))))) + (org-export-format-code + (car code-info) + (lambda (loc num ref) + (concat + loc + (when ref + ;; Ensure references are flushed to the right, + ;; separated with 6 spaces from the widest line + ;; of code. + (concat (make-string (+ (- max-width (length loc)) 6) + ?\s) + (format "(%s)" ref))))) + nil (and retain-labels (cdr code-info))))))) ;; Return value. - (if float-env (format float-env body) body))) + (format float-env body))) ;; Case 4. Use listings package. (t (let ((lst-lang @@ -2097,19 +2125,25 @@ contextual information." (org-export-data main info))))))) (concat ;; Options. - (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))) - (cond ((assoc "numbers" org-latex-listings-options) nil) - ((not num-start) '(("numbers" "none"))) - ((zerop num-start) '(("numbers" "left"))) - (t `(("numbers" "left") - ("firstnumber" - ,(number-to-string (1+ num-start))))))))) + (format + "\\lstset{%s}\n" + (org-latex--make-option-string + (append + org-latex-listings-options + (cond + ((and (not float) (plist-member attributes :float)) nil) + ((string= "multicolumn" float) '(("float" "*"))) + ((and float (not (assoc "float" org-latex-listings-options))) + `(("float" ,org-latex-default-figure-position)))) + `(("language" ,lst-lang)) + (when label `(("label" ,label))) + (when caption-str `(("caption" ,caption-str))) + (cond ((assoc "numbers" org-latex-listings-options) nil) + ((not num-start) '(("numbers" "none"))) + ((zerop num-start) '(("numbers" "left"))) + (t `(("numbers" "left") + ("firstnumber" + ,(number-to-string (1+ num-start))))))))) ;; Source code. (format "\\begin{lstlisting}\n%s\\end{lstlisting}" @@ -2319,10 +2353,12 @@ This function assumes TABLE has `org' as its `:type' property and (float-env (unless (member table-env '("longtable" "longtabu")) (let ((float (plist-get attr :float))) (cond + ((and (not float) (plist-member attr :float)) nil) ((string= float "sidewaystable") "sidewaystable") ((string= float "multicolumn") "table*") - ((or (string= float "table") - (org-element-property :caption table)) + ((or float + (org-element-property :caption table) + (org-string-nw-p (plist-get attr :caption))) "table"))))) ;; Extract others display options. (fontsize (let ((font (plist-get attr :font))) @@ -2683,23 +2719,8 @@ Export is done in a buffer named \"*Org LATEX Export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) - (if async - (org-export-async-start - (lambda (output) - (with-current-buffer (get-buffer-create "*Org LATEX Export*") - (erase-buffer) - (insert output) - (goto-char (point-min)) - (LaTeX-mode) - (org-export-add-to-stack (current-buffer) 'latex))) - `(org-export-as 'latex ,subtreep ,visible-only ,body-only - ',ext-plist)) - (let ((outbuf - (org-export-to-buffer 'latex "*Org LATEX Export*" - subtreep visible-only body-only ext-plist))) - (with-current-buffer outbuf (LaTeX-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf))))) + (org-export-to-buffer 'latex "*Org LATEX Export*" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) ;;;###autoload (defun org-latex-convert-region-to-latex () @@ -2736,19 +2757,11 @@ between \"\\begin{document}\" and \"\\end{document}\". EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name." +file-local settings." (interactive) (let ((outfile (org-export-output-file-name ".tex" subtreep))) - (if async - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'latex)) - `(expand-file-name - (org-export-to-file - 'latex ,outfile ,subtreep ,visible-only ,body-only ',ext-plist))) - (org-export-to-file - 'latex outfile subtreep visible-only body-only ext-plist)))) + (org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist))) ;;;###autoload (defun org-latex-export-to-pdf @@ -2780,18 +2793,10 @@ file-local settings. Return PDF file's name." (interactive) - (if async - (let ((outfile (org-export-output-file-name ".tex" subtreep))) - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'latex)) - `(expand-file-name - (org-latex-compile - (org-export-to-file - 'latex ,outfile ,subtreep ,visible-only ,body-only - ',ext-plist))))) - (org-latex-compile - (org-latex-export-to-latex - nil subtreep visible-only body-only ext-plist)))) + (let ((outfile (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))))) (defun org-latex-compile (texfile &optional snippet) "Compile a TeX file. diff --git a/lisp/ox-man.el b/lisp/ox-man.el index b99a464..a160e4c 100644 --- a/lisp/ox-man.el +++ b/lisp/ox-man.el @@ -1144,14 +1144,8 @@ file-local settings. Return output file's name." (interactive) (let ((outfile (org-export-output-file-name ".man" subtreep))) - (if async - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'man)) - `(expand-file-name - (org-export-to-file - 'man ,outfile ,subtreep ,visible-only ,body-only ',ext-plist))) - (org-export-to-file - 'man outfile subtreep visible-only body-only ext-plist)))) + (org-export-to-file 'man outfile + async subtreep visible-only body-only ext-plist))) (defun org-man-export-to-pdf (&optional async subtreep visible-only body-only ext-plist) @@ -1182,17 +1176,10 @@ file-local settings. Return PDF file's name." (interactive) - (if async - (let ((outfile (org-export-output-file-name ".man" subtreep))) - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'man)) - `(expand-file-name - (org-man-compile - (org-export-to-file - 'man ,outfile ,subtreep ,visible-only ,body-only - ',ext-plist))))) - (org-man-compile - (org-man-export-to-man nil subtreep visible-only body-only ext-plist)))) + (let ((outfile (org-export-output-file-name ".man" subtreep))) + (org-export-to-file 'man outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))))) (defun org-man-compile (file) "Compile a Groff file. diff --git a/lisp/ox-md.el b/lisp/ox-md.el index 52ed42b..f7e4875 100644 --- a/lisp/ox-md.el +++ b/lisp/ox-md.el @@ -438,21 +438,8 @@ Export is done in a buffer named \"*Org MD Export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) - (if async - (org-export-async-start - (lambda (output) - (with-current-buffer (get-buffer-create "*Org MD Export*") - (erase-buffer) - (insert output) - (goto-char (point-min)) - (text-mode) - (org-export-add-to-stack (current-buffer) 'md))) - `(org-export-as 'md ,subtreep ,visible-only)) - (let ((outbuf (org-export-to-buffer - 'md "*Org MD Export*" subtreep visible-only))) - (with-current-buffer outbuf (text-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf))))) + (org-export-to-buffer 'md "*Org MD Export*" + async subtreep visible-only nil nil (lambda () (text-mode)))) ;;;###autoload (defun org-md-convert-region-to-md () @@ -487,12 +474,7 @@ contents of hidden elements. Return output file's name." (interactive) (let ((outfile (org-export-output-file-name ".md" subtreep))) - (if async - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'md)) - `(expand-file-name - (org-export-to-file 'md ,outfile ,subtreep ,visible-only))) - (org-export-to-file 'md outfile subtreep visible-only)))) + (org-export-to-file 'md outfile async subtreep visible-only))) (provide 'ox-md) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 768af3c..ae9e473 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -27,7 +27,7 @@ (eval-when-compile (require 'cl) - (require 'table)) + (require 'table nil 'noerror)) (require 'format-spec) (require 'ox) (require 'org-compat) @@ -288,38 +288,37 @@ according to the default face identified by the `htmlfontify'.") ("category-and-value" "%e %n: %c" "category-and-value" "%e %n") ("value" "%e %n: %c" "value" "%n")) "Specify how labels are applied and referenced. -This is an alist where each element is of the -form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE -LABEL-REF-FMT). -LABEL-ATTACH-FMT controls how labels and captions are attached to -an entity. It may contain following specifiers - %e, %n and %c. -%e is replaced with the CATEGORY-NAME. %n is replaced with +This is an alist where each element is of the form: + + \(STYLE-NAME ATTACH-FMT REF-MODE REF-FMT) + +ATTACH-FMT controls how labels and captions are attached to an +entity. It may contain following specifiers - %e and %c. %e is +replaced with the CATEGORY-NAME. %n is replaced with \"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced -with CAPTION. See `org-odt-format-label-definition'. +with CAPTION. -LABEL-REF-MODE and LABEL-REF-FMT controls how label references -are generated. The following XML is generated for a label -reference - \"<text:sequence-ref -text:reference-format=\"LABEL-REF-MODE\" ...> LABEL-REF-FMT -</text:sequence-ref>\". LABEL-REF-FMT may contain following +REF-MODE and REF-FMT controls how label references are generated. +The following XML is generated for a label reference - +\"<text:sequence-ref text:reference-format=\"REF-MODE\" ...> +REF-FMT </text:sequence-ref>\". REF-FMT may contain following specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. -%n is replaced with SEQNO. See -`org-odt-format-label-reference'.") +%n is replaced with SEQNO. + +See also `org-odt-format-label'.") (defvar org-odt-category-map-alist '(("__Table__" "Table" "value" "Table" org-odt--enumerable-p) ("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p) ("__MathFormula__" "Text" "math-formula" "Equation" org-odt--enumerable-formula-p) ("__DvipngImage__" "Equation" "value" "Equation" org-odt--enumerable-latex-image-p) - ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p) - ;; ("__Table__" "Table" "category-and-value") - ;; ("__Figure__" "Figure" "category-and-value") - ;; ("__DvipngImage__" "Equation" "category-and-value") - ) + ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p)) "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE. -This is a list where each entry is of the form \\(CATEGORY-HANDLE -OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE\\). + +This is a list where each entry is of the form: + + \(CATEGORY-HANDLE OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE) CATEGORY_HANDLE identifies the captionable entity in question. @@ -331,15 +330,7 @@ the entity. These counters are declared within LABEL-STYLE is a key into `org-odt-label-styles' and specifies how a given entity should be captioned and referenced. -CATEGORY-NAME is used for qualifying captions on export. You can -modify the CATEGORY-NAME used in the exported document by -modifying `org-export-dictionary'. For example, an embedded -image in an English document is captioned as \"Figure 1: Orgmode -Logo\", by default. If you want the image to be captioned as -\"Illustration 1: Orgmode Logo\" instead, install an entry in -`org-export-dictionary' which translates \"Figure\" to -\"Illustration\" when the language is \"en\" and encoding is -`:utf-8'. +CATEGORY-NAME is used for qualifying captions on export. ENUMERATOR-PREDICATE is used for assigning a sequence number to the entity. See `org-odt--enumerate'.") @@ -455,7 +446,8 @@ The exporter embeds the exported content just before If unspecified, the file named \"OrgOdtContentTemplate.xml\" under `org-odt-styles-dir' is used." - :type 'file + :type '(choice (const nil) + (file)) :group 'org-export-odt :version "24.1") @@ -1046,20 +1038,6 @@ See `org-odt--build-date-styles' for implementation details." (error "Extraction failed")))) members)) -(defun org-odt--suppress-some-translators (info types) - ;; See comments in `org-odt-format-label' and `org-odt-toc'. - (org-combine-plists - info (list - ;; Override translators. - :translate-alist - (nconc (mapcar (lambda (type) (cons type (lambda (data contents info) - contents))) types) - (plist-get info :translate-alist)) - ;; Reset data translation cache. FIXME. - ;; :exported-data nil - ))) - - ;;;; Target (defun org-odt--target (text id) @@ -1175,20 +1153,19 @@ See `org-odt--build-date-styles' for implementation details." (let* ((title (org-export-translate "Table of Contents" :utf-8 info)) (headlines (org-export-collect-headlines info (and (wholenump depth) depth))) - (translations (nconc (mapcar - (lambda (type) - (cons type (lambda (data contents info) - contents))) - (list 'radio-target)) - (plist-get info :translate-alist)))) + (backend (org-export-create-backend + :parent (org-export-backend-name + (plist-get info :back-end)) + :transcoders (mapcar + (lambda (type) (cons type (lambda (d c i) c))) + (list 'radio-target))))) (when headlines (concat (org-odt-begin-toc title depth) (mapconcat (lambda (headline) (let* ((entry (org-odt-format-headline--wrap - headline translations info - 'org-odt-format-toc-headline)) + headline backend info 'org-odt-format-toc-headline)) (level (org-export-get-relative-level headline info)) (style (format "Contents_20_%d" level))) (format "\n<text:p text:style-name=\"%s\">%s</text:p>" @@ -1754,18 +1731,22 @@ CONTENTS is nil. INFO is a plist holding contextual information." (t (let* ((raw (org-export-get-footnote-definition footnote-reference info)) - (translations - (cons (cons 'paragraph - (lambda (p c i) - (org-odt--format-paragraph - p c "Footnote" "OrgFootnoteCenter" - "OrgFootnoteQuotations"))) - (org-export-backend-translate-table 'odt))) - (def (let ((def (org-trim (org-export-data-with-translations - raw translations info)))) - (if (eq (org-element-type raw) 'org-data) def - (format "\n<text:p text:style-name=\"%s\">%s</text:p>" - "Footnote" def))))) + (def + (let ((def (org-trim + (org-export-data-with-backend + raw + (org-export-create-backend + :parent 'odt + :transcoders + '((paragraph . (lambda (p c i) + (org-odt--format-paragraph + p c "Footnote" + "OrgFootnoteCenter" + "OrgFootnoteQuotations"))))) + info)))) + (if (eq (org-element-type raw) 'org-data) def + (format "\n<text:p text:style-name=\"%s\">%s</text:p>" + "Footnote" def))))) (funcall --format-footnote-definition n def)))))))) @@ -1798,13 +1779,12 @@ CONTENTS is nil. INFO is a plist holding contextual information." "<text:span text:style-name=\"%s\">%s</text:span>" "OrgTag" tag)) tags " : ")))))) -(defun org-odt-format-headline--wrap (headline translations info - &optional format-function - &rest extra-keys) - "Transcode a HEADLINE element from Org to ODT. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (setq translations (or translations (plist-get info :translate-alist))) +(defun org-odt-format-headline--wrap (headline backend info + &optional format-function + &rest extra-keys) + "Transcode a HEADLINE element using BACKEND. +INFO is a plist holding contextual information." + (setq backend (or backend (plist-get info :back-end))) (let* ((level (+ (org-export-get-relative-level headline info))) (headline-number (org-export-get-headline-number headline info)) (section-number (and (org-export-numbered-headline-p headline info) @@ -1812,13 +1792,13 @@ holding contextual information." headline-number "."))) (todo (and (plist-get info :with-todo-keywords) (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data-with-translations - todo translations info))))) + (and todo + (org-export-data-with-backend todo backend info))))) (todo-type (and todo (org-element-property :todo-type headline))) (priority (and (plist-get info :with-priority) (org-element-property :priority headline))) - (text (org-export-data-with-translations - (org-element-property :title headline) translations info)) + (text (org-export-data-with-backend + (org-element-property :title headline) backend info)) (tags (and (plist-get info :with-tags) (org-export-get-tags headline info))) (headline-label (concat "sec-" (mapconcat 'number-to-string @@ -1828,7 +1808,7 @@ holding contextual information." ((functionp org-odt-format-headline-function) (function* (lambda (todo todo-type priority text tags - &allow-other-keys) + &allow-other-keys) (funcall org-odt-format-headline-function todo todo-type priority text tags)))) (t 'org-odt-format-headline)))) @@ -1957,7 +1937,7 @@ holding contextual information." (let ((format-function (function* (lambda (todo todo-type priority text tags - &key contents &allow-other-keys) + &key contents &allow-other-keys) (funcall org-odt-format-inlinetask-function todo todo-type priority text tags contents))))) (org-odt-format-headline--wrap @@ -2123,6 +2103,16 @@ CONTENTS is nil. INFO is a plist holding contextual information." tag)) (defun org-odt-format-label (element info op) + "Return a label for ELEMENT. + +ELEMENT is a `link', `table', `src-block' or `paragraph' type +element. INFO is a plist used as a communication channel. OP is +either `definition' or `reference', depending on the purpose of +the generated string. + +Return value is a string if OP is set to `reference' or a cons +cell like CAPTION . SHORT-CAPTION) where CAPTION and +SHORT-CAPTION are strings." (assert (memq (org-element-type element) '(link table src-block paragraph))) (let* ((caption-from (case (org-element-type element) @@ -2162,15 +2152,14 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;; will do. (short-caption (let ((short-caption (or short-caption caption)) - (translations (nconc (mapcar - (lambda (type) - (cons type (lambda (data contents info) - contents))) - org-element-all-objects) - (plist-get info :translate-alist)))) + (backend (org-export-create-backend + :parent (org-export-backend-name + (plist-get info :back-end)) + :transcoders + (mapcar (lambda (type) (cons type (lambda (o c i) c))) + org-element-all-objects)))) (when short-caption - (org-export-data-with-translations short-caption - translations info))))) + (org-export-data-with-backend short-caption backend info))))) (when (or label caption) (let* ((default-category (case (org-element-type element) @@ -2200,8 +2189,8 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;; Case 1: Handle Label definition. (definition ;; Assign an internal label, if user has not provided one - (setq label (or label (format "%s-%s" default-category seqno))) - (setq label (org-export-solidify-link-text label)) + (setq label (org-export-solidify-link-text + (or label (format "%s-%s" default-category seqno)))) (cons (concat ;; Sneak in a bookmark. The bookmark is used when the @@ -2210,8 +2199,11 @@ CONTENTS is nil. INFO is a plist holding contextual information." (format "\n<text:bookmark text:name=\"%s\"/>" label) ;; Label definition: Typically formatted as below: ;; CATEGORY SEQ-NO: LONG CAPTION + ;; with translation for correct punctuation. (format-spec - (cadr (assoc-string label-style org-odt-label-styles t)) + (org-export-translate + (cadr (assoc-string label-style org-odt-label-styles t)) + :utf-8 info) `((?e . ,category) (?n . ,(format "<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">%s</text:sequence>" @@ -3780,9 +3772,10 @@ contextual information." (setq processing-type 'mathml) (message "LaTeX to MathML converter not available.") (setq processing-type 'verbatim))) - (dvipng + ((dvipng imagemagick) (unless (and (org-check-external-command "latex" "" t) - (org-check-external-command "dvipng" "" t)) + (org-check-external-command + (if (eq processing-type 'dvipng) "dvipng" "convert") "" t)) (message "LaTeX to PNG converter not available.") (setq processing-type 'verbatim))) (otherwise @@ -3795,7 +3788,7 @@ contextual information." (message "Formatting LaTeX using %s" processing-type) ;; Convert `latex-fragment's and `latex-environment's. - (when (memq processing-type '(mathml dvipng)) + (when (memq processing-type '(mathml dvipng imagemagick)) (org-element-map tree '(latex-fragment latex-environment) (lambda (latex-*) (incf count) @@ -3804,13 +3797,13 @@ contextual information." (cache-dir (file-name-directory input-file)) (cache-subdir (concat (case processing-type - (dvipng "ltxpng/") + ((dvipng imagemagick) "ltxpng/") (mathml "ltxmathml/")) (file-name-sans-extension (file-name-nondirectory input-file)))) (display-msg (case processing-type - (dvipng (format "Creating LaTeX Image %d..." count)) + ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count)) (mathml (format "Creating MathML snippet %d..." count)))) ;; Get an Org-style link to PNG image or the MathML ;; file. @@ -4262,9 +4255,12 @@ Return output file's name." (require 'nxml-mode) (let ((nxml-auto-insert-xml-declaration-flag nil)) (find-file-noselect - (concat org-odt-zip-dir "content.xml") t))))) - (org-export-to-buffer - 'odt out-buf ,subtreep ,visible-only nil ',ext-plist)))))) + (concat org-odt-zip-dir "content.xml") t)))) + (output (org-export-as + 'odt ,subtreep ,visible-only nil ,ext-plist))) + (with-current-buffer out-buf + (erase-buffer) + (insert output))))))) (org-odt--export-wrap outfile (let* ((org-odt-embedded-images-count 0) @@ -4275,13 +4271,13 @@ Return output file's name." ;; styles. (hfy-user-sheet-assoc nil)) ;; Initialize content.xml and kick-off the export process. - (let ((out-buf (progn + (let ((output (org-export-as 'odt subtreep visible-only nil ext-plist)) + (out-buf (progn (require 'nxml-mode) (let ((nxml-auto-insert-xml-declaration-flag nil)) (find-file-noselect (concat org-odt-zip-dir "content.xml") t))))) - (org-export-to-buffer - 'odt out-buf subtreep visible-only nil ext-plist))))))) + (with-current-buffer out-buf (erase-buffer) (insert output)))))))) ;;;; Convert between OpenDocument and other formats diff --git a/lisp/ox-org.el b/lisp/ox-org.el index 7539317..644cc0d 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -172,22 +172,8 @@ Export is done in a buffer named \"*Org ORG Export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) - (if async - (org-export-async-start - (lambda (output) - (with-current-buffer (get-buffer-create "*Org ORG Export*") - (erase-buffer) - (insert output) - (goto-char (point-min)) - (org-mode) - (org-export-add-to-stack (current-buffer) 'org))) - `(org-export-as 'org ,subtreep ,visible-only nil ',ext-plist)) - (let ((outbuf - (org-export-to-buffer - 'org "*Org ORG Export*" subtreep visible-only nil ext-plist))) - (with-current-buffer outbuf (org-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf))))) + (org-export-to-buffer 'org "*Org ORG Export*" + async subtreep visible-only nil ext-plist (lambda () (org-mode)))) ;;;###autoload (defun org-org-export-to-org (&optional async subtreep visible-only ext-plist) @@ -216,13 +202,8 @@ file-local settings. Return output file name." (interactive) (let ((outfile (org-export-output-file-name ".org" subtreep))) - (if async - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'org)) - `(expand-file-name - (org-export-to-file - 'org ,outfile ,subtreep ,visible-only nil ',ext-plist))) - (org-export-to-file 'org outfile subtreep visible-only nil ext-plist)))) + (org-export-to-file 'org outfile + async subtreep visible-only nil ext-plist))) ;;;###autoload (defun org-org-publish-to-org (plist filename pub-dir) diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el index d5f4dfe..906c819 100644 --- a/lisp/ox-publish.el +++ b/lisp/ox-publish.el @@ -383,19 +383,19 @@ This splices all the components into the list." (push p rtn))) (nreverse (delete-dups (delq nil rtn))))) -(defvar org-sitemap-sort-files) -(defvar org-sitemap-sort-folders) -(defvar org-sitemap-ignore-case) -(defvar org-sitemap-requested) -(defvar org-sitemap-date-format) -(defvar org-sitemap-file-entry-format) +(defvar org-publish-sitemap-sort-files) +(defvar org-publish-sitemap-sort-folders) +(defvar org-publish-sitemap-ignore-case) +(defvar org-publish-sitemap-requested) +(defvar org-publish-sitemap-date-format) +(defvar org-publish-sitemap-file-entry-format) (defun org-publish-compare-directory-files (a b) "Predicate for `sort', that sorts folders and files for sitemap." (let ((retval t)) - (when (or org-sitemap-sort-files org-sitemap-sort-folders) + (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) ;; First we sort files: - (when org-sitemap-sort-files - (case org-sitemap-sort-files + (when org-publish-sitemap-sort-files + (case org-publish-sitemap-sort-files (alphabetically (let* ((adir (file-directory-p a)) (aorg (and (string-match "\\.org$" a) (not adir))) @@ -405,7 +405,7 @@ This splices all the components into the list." (org-publish-find-title a)) a)) (B (if borg (concat (file-name-directory b) (org-publish-find-title b)) b))) - (setq retval (if org-sitemap-ignore-case + (setq retval (if org-publish-sitemap-ignore-case (not (string-lessp (upcase B) (upcase A))) (not (string-lessp B A)))))) ((anti-chronologically chronologically) @@ -414,17 +414,17 @@ This splices all the components into the list." (A (+ (lsh (car adate) 16) (cadr adate))) (B (+ (lsh (car bdate) 16) (cadr bdate)))) (setq retval - (if (eq org-sitemap-sort-files 'chronologically) (<= A B) + (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B) (>= A B))))))) ;; Directory-wise wins: - (when org-sitemap-sort-folders + (when org-publish-sitemap-sort-folders ;; a is directory, b not: (cond ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (equal org-sitemap-sort-folders 'first))) + (setq retval (equal org-publish-sitemap-sort-folders 'first))) ;; a is not a directory, but b is: ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (equal org-sitemap-sort-folders 'last)))))) + (setq retval (equal org-publish-sitemap-sort-folders 'last)))))) retval)) (defun org-publish-get-base-files-1 @@ -457,7 +457,7 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR." (or (file-directory-p file) (and match (string-match match file)))) (directory-files base-dir t))))) - (if (not org-sitemap-requested) all-files + (if (not org-publish-sitemap-requested) all-files (sort all-files 'org-publish-compare-directory-files))))) (defun org-publish-get-base-files (project &optional exclude-regexp) @@ -472,15 +472,15 @@ matching filenames." (extension (or (plist-get project-plist :base-extension) "org")) ;; sitemap-... variables are dynamically scoped for ;; org-publish-compare-directory-files: - (org-sitemap-requested + (org-publish-sitemap-requested (plist-get project-plist :auto-sitemap)) (sitemap-filename (or (plist-get project-plist :sitemap-filename) "sitemap.org")) - (org-sitemap-sort-folders + (org-publish-sitemap-sort-folders (if (plist-member project-plist :sitemap-sort-folders) (plist-get project-plist :sitemap-sort-folders) org-publish-sitemap-sort-folders)) - (org-sitemap-sort-files + (org-publish-sitemap-sort-files (cond ((plist-member project-plist :sitemap-sort-files) (plist-get project-plist :sitemap-sort-files)) ;; For backward compatibility: @@ -488,18 +488,19 @@ matching filenames." (if (plist-get project-plist :sitemap-alphabetically) 'alphabetically nil)) (t org-publish-sitemap-sort-files))) - (org-sitemap-ignore-case + (org-publish-sitemap-ignore-case (if (plist-member project-plist :sitemap-ignore-case) (plist-get project-plist :sitemap-ignore-case) org-publish-sitemap-sort-ignore-case)) (match (if (eq extension 'any) "^[^\\.]" (concat "^[^\\.].*\\.\\(" extension "\\)$")))) - ;; Make sure `org-sitemap-sort-folders' has an accepted value - (unless (memq org-sitemap-sort-folders '(first last)) - (setq org-sitemap-sort-folders nil)) + ;; Make sure `org-publish-sitemap-sort-folders' has an accepted + ;; value. + (unless (memq org-publish-sitemap-sort-folders '(first last)) + (setq org-publish-sitemap-sort-folders nil)) (setq org-publish-temp-files nil) - (if org-sitemap-requested + (if org-publish-sitemap-requested (pushnew (expand-file-name (concat base-dir sitemap-filename)) org-publish-temp-files)) (org-publish-get-base-files-1 base-dir recurse match @@ -572,24 +573,22 @@ Return output file name." (let ((output-file (org-export-output-file-name extension nil pub-dir)) (body-p (plist-get plist :body-only))) - (org-export-to-file - backend output-file nil nil body-p - ;; Add `org-publish-collect-numbering' and - ;; `org-publish-collect-index' to final output - ;; filters. The latter isn't dependent on - ;; `:makeindex', since we want to keep it up-to-date - ;; in cache anyway. - (org-combine-plists - plist - `(:filter-final-output - ,(cons 'org-publish-collect-numbering - (cons 'org-publish-collect-index - (plist-get plist :filter-final-output)))))))) + (org-export-to-file backend output-file + nil nil nil body-p + ;; Add `org-publish-collect-numbering' and + ;; `org-publish-collect-index' to final output + ;; filters. The latter isn't dependent on + ;; `:makeindex', since we want to keep it up-to-date + ;; in cache anyway. + (org-combine-plists + plist + `(:filter-final-output + ,(cons 'org-publish-collect-numbering + (cons 'org-publish-collect-index + (plist-get plist :filter-final-output)))))))) ;; Remove opened buffer in the process. (unless visitingp (kill-buffer work-buffer))))) -(defvar project-plist) - (defun org-publish-attachment (plist filename pub-dir) "Publish a file with no transformation of any kind. @@ -678,10 +677,10 @@ If `:auto-sitemap' is set, publish the sitemap too. If "sitemap.org")) (sitemap-function (or (plist-get project-plist :sitemap-function) 'org-publish-org-sitemap)) - (org-sitemap-date-format + (org-publish-sitemap-date-format (or (plist-get project-plist :sitemap-date-format) org-publish-sitemap-date-format)) - (org-sitemap-file-entry-format + (org-publish-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) org-publish-sitemap-file-entry-format)) (preparation-function @@ -775,7 +774,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." ;; This is common to 'flat and 'tree (let ((entry (org-publish-format-file-entry - org-sitemap-file-entry-format file project-plist)) + org-publish-sitemap-file-entry-format file project-plist)) (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) (cond ((string-match-p regexp entry) (string-match regexp entry) @@ -791,11 +790,12 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (or visiting (kill-buffer sitemap-buffer)))) (defun org-publish-format-file-entry (fmt file project-plist) - (format-spec fmt - `((?t . ,(org-publish-find-title file t)) - (?d . ,(format-time-string org-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) + (format-spec + fmt + `((?t . ,(org-publish-find-title file t)) + (?d . ,(format-time-string org-publish-sitemap-date-format + (org-publish-find-date file))) + (?a . ,(or (plist-get project-plist :author) user-full-name))))) (defun org-publish-find-title (file &optional reset) "Find the title of FILE in project." @@ -803,17 +803,16 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (and (not reset) (org-publish-cache-get-file-property file :title nil t)) (let* ((org-inhibit-startup t) (visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file))) - title) + (buffer (or visiting (find-file-noselect file)))) (with-current-buffer buffer (org-mode) - (setq title - (or (org-element-interpret-data - (plist-get (org-export-get-environment) :title)) - (file-name-nondirectory (file-name-sans-extension file))))) - (unless visiting (kill-buffer buffer)) - (org-publish-cache-set-file-property file :title title) - title))) + (let ((title + (let ((property (plist-get (org-export-get-environment) :title))) + (if property (org-element-interpret-data property) + (file-name-nondirectory (file-name-sans-extension file)))))) + (unless visiting (kill-buffer buffer)) + (org-publish-cache-set-file-property file :title title) + title))))) (defun org-publish-find-date (file) "Find the date of FILE in project. diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index e7ec635..29fbc07 100644 --- a/lisp/ox-texinfo.el +++ b/lisp/ox-texinfo.el @@ -149,7 +149,9 @@ :type '(string :tag "Export Filename")) (defcustom org-texinfo-coding-system nil - "Default document encoding for Texinfo output." + "Default document encoding for Texinfo output. + +If `nil' it will default to `buffer-file-coding-system'." :group 'org-export-texinfo :type 'coding-system) @@ -693,7 +695,9 @@ holding export options." ;; `.' in text. (dirspacing (- 29 (length dirtitle))) (menu (org-texinfo-make-menu info 'main)) - (detail-menu (org-texinfo-make-menu info 'detailed))) + (detail-menu (org-texinfo-make-menu info 'detailed)) + (coding-system (or org-texinfo-coding-system + buffer-file-coding-system))) (concat ;; Header header "\n" @@ -701,9 +705,8 @@ holding export options." ;; Filename and Title "@setfilename " info-filename "\n" "@settitle " title "\n" - (if org-texinfo-coding-system - (format "@documentencoding %s\n" - (upcase (symbol-name org-texinfo-coding-system))) "\n") + (format "@documentencoding %s\n" + (upcase (symbol-name coding-system))) "\n" (format "@documentlanguage %s\n" lang) "\n\n" "@c Version and Contact Info\n" @@ -1547,7 +1550,7 @@ a communication channel." (nth count item))) counts) (mapconcat (lambda (size) (make-string size ?a)) (mapcar (lambda (ref) - (apply 'max `,@ref)) (car counts)) + (apply 'max `(,@ref))) (car counts)) "} {"))) (defun org-texinfo-table--org-table (table contents info) @@ -1707,18 +1710,9 @@ file-local settings. Return output file's name." (interactive) (let ((outfile (org-export-output-file-name ".texi" subtreep)) - (org-export-coding-system org-texinfo-coding-system)) - (if async - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'texinfo)) - (let ((org-export-coding-system org-texinfo-coding-system)) - `(expand-file-name - (org-export-to-file - 'texinfo ,outfile ,subtreep ,visible-only ,body-only - ',ext-plist)))) - (let ((org-export-coding-system org-texinfo-coding-system)) - (org-export-to-file - 'texinfo outfile subtreep visible-only body-only ext-plist))))) + (org-export-coding-system `,org-texinfo-coding-system)) + (org-export-to-file 'texinfo outfile + async subtreep visible-only body-only ext-plist))) (defun org-texinfo-export-to-info (&optional async subtreep visible-only body-only ext-plist) @@ -1752,21 +1746,11 @@ directory. Return INFO file's name." (interactive) - (if async - (let ((outfile (org-export-output-file-name ".texi" subtreep)) - (org-export-coding-system org-texinfo-coding-system)) - (org-export-async-start - (lambda (f) (org-export-add-to-stack f 'texinfo)) - (let ((org-export-coding-system org-texinfo-coding-system)) - `(expand-file-name - (org-texinfo-compile - (org-export-to-file - 'texinfo ,outfile ,subtreep ,visible-only ,body-only - ',ext-plist)))))) - (org-texinfo-compile - (let ((org-export-coding-system org-texinfo-coding-system)) - (org-texinfo-export-to-texinfo - nil subtreep visible-only body-only ext-plist))))) + (let ((outfile (org-export-output-file-name ".texi" subtreep)) + (org-export-coding-system `,org-texinfo-coding-system)) + (org-export-to-file 'texinfo outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-texinfo-compile file))))) ;;;###autoload (defun org-texinfo-publish-to-texinfo (plist filename pub-dir) @@ -47,15 +47,10 @@ ;; The core function is `org-export-as'. It returns the transcoded ;; buffer as a string. ;; -;; An export back-end is defined with `org-export-define-backend', -;; which defines one mandatory information: his translation table. -;; Its value is an alist whose keys are elements and objects types and -;; values translator functions. See function's docstring for more -;; information about translators. -;; -;; Optionally, `org-export-define-backend' can also support specific -;; buffer keywords, OPTION keyword's items and filters. Also refer to -;; function documentation for more information. +;; An export back-end is defined with `org-export-define-backend'. +;; This function can also support specific buffer keywords, OPTION +;; keyword's items and filters. Refer to function's documentation for +;; more information. ;; ;; If the new back-end shares most properties with another one, ;; `org-export-define-derived-backend' can be used to simplify the @@ -117,7 +112,7 @@ (:section-numbers nil "num" org-export-with-section-numbers) (:select-tags "SELECT_TAGS" nil org-export-select-tags split) (:time-stamp-file nil "timestamp" org-export-time-stamp-file) - (:title "TITLE" nil org-export--default-title space) + (:title "TITLE" nil nil space) (:with-archived-trees nil "arch" org-export-with-archived-trees) (:with-author nil "author" org-export-with-author) (:with-clocks nil "c" org-export-with-clocks) @@ -280,14 +275,8 @@ containing the back-end used, as a symbol, and either a process or the time at which it finished. It is used to build the menu from `org-export-stack'.") -(defvar org-export-registered-backends nil +(defvar org-export--registered-backends nil "List of backends currently available in the exporter. - -A backend is stored as a list where CAR is its name, as a symbol, -and CDR is a plist with the following properties: -`:filters-alist', `:menu-entry', `:options-alist' and -`:translate-alist'. - This variable is set with `org-export-define-backend' and `org-export-define-derived-backend' functions.") @@ -301,6 +290,17 @@ and its CDR is a list of export options.") This marker will be used with `C-u C-c C-e' to make sure export repetition uses the same subtree if the previous command was restricted to a subtree.") +;; For compatibility with Org < 8 +(defvar org-export-current-backend nil + "Name, if any, of the back-end used during an export process. + +Its value is a symbol such as `html', `latex', `ascii', or nil if +the back-end is anonymous (see `org-export-create-backend') or if +there is no export process in progress. + +It can be used to teach Babel blocks how to act differently +according to the back-end used.") + ;;; User-configurable Variables ;; @@ -333,7 +333,7 @@ e.g. \"arch:nil\"." :group 'org-export-general :type '(choice (const :tag "Not at all" nil) - (const :tag "Headline only" 'headline) + (const :tag "Headline only" headline) (const :tag "Entirely" t))) (defcustom org-export-with-author t @@ -501,8 +501,9 @@ e.g. \"H:2\"." (defcustom org-export-default-language "en" "The default language for export and clocktable translations, as a string. This may have an association in -`org-clock-clocktable-language-setup'. This option can also be -set with the LANGUAGE keyword." +`org-clock-clocktable-language-setup', +`org-export-smart-quotes-alist' and `org-export-dictionary'. +This option can also be set with the LANGUAGE keyword." :group 'org-export-general :type '(string :tag "Language")) @@ -797,8 +798,8 @@ HTML code while every other back-end will ignore it." This variable can be either set to `buffer' or `subtree'." :group 'org-export-general :type '(choice - (const :tag "Export current buffer" 'buffer) - (const :tag "Export current subtree" 'subtree))) + (const :tag "Export current buffer" buffer) + (const :tag "Export current subtree" subtree))) (defcustom org-export-show-temporary-export-buffer t "Non-nil means show buffer after exporting to temp buffer. @@ -829,20 +830,6 @@ process faster and the export more portable." :package-version '(Org . "8.0") :type '(file :must-match t)) -(defcustom org-export-invisible-backends nil - "List of back-ends that shouldn't appear in the dispatcher. - -Any back-end belonging to this list or derived from a back-end -belonging to it will not appear in the dispatcher menu. - -Indeed, Org may require some export back-ends without notice. If -these modules are never to be used interactively, adding them -here will avoid cluttering the dispatcher menu." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type '(repeat (symbol :tag "Back-End"))) - (defcustom org-export-dispatch-use-expert-ui nil "Non-nil means using a non-intrusive `org-export-dispatch'. In that case, no help buffer is displayed. Though, an indicator @@ -862,25 +849,147 @@ mode." ;;; Defining Back-ends ;; -;; `org-export-define-backend' is the standard way to define an export -;; back-end. It allows to specify translators, filters, buffer -;; options and a menu entry. If the new back-end shares translators -;; with another back-end, `org-export-define-derived-backend' may be -;; used instead. +;; An export back-end is a structure with `org-export-backend' type +;; and `name', `parent', `transcoders', `options', `filters', `blocks' +;; and `menu' slots. +;; +;; At the lowest level, a back-end is created with +;; `org-export-create-backend' function. +;; +;; A named back-end can be registered with +;; `org-export-register-backend' function. A registered back-end can +;; later be referred to by its name, with `org-export-get-backend' +;; function. Also, such a back-end can become the parent of a derived +;; back-end from which slot values will be inherited by default. +;; `org-export-derived-backend-p' can check if a given back-end is +;; derived from a list of back-end names. +;; +;; `org-export-get-all-transcoders', `org-export-get-all-options' and +;; `org-export-get-all-filters' return the full alist of transcoders, +;; options and filters, including those inherited from ancestors. ;; -;; Internally, a back-end is stored as a list, of which CAR is the -;; name of the back-end, as a symbol, and CDR a plist. Accessors to -;; properties of a given back-end are: `org-export-backend-filters', -;; `org-export-backend-menu', `org-export-backend-options' and -;; `org-export-backend-translate-table'. +;; At a higher level, `org-export-define-backend' is the standard way +;; to define an export back-end. If the new back-end is similar to +;; a registered back-end, `org-export-define-derived-backend' may be +;; used instead. ;; ;; Eventually `org-export-barf-if-invalid-backend' returns an error ;; when a given back-end hasn't been registered yet. -(defun org-export-define-backend (backend translators &rest body) +(defstruct (org-export-backend (:constructor org-export-create-backend) + (:copier nil)) + name parent transcoders options filters blocks menu) + +(defun org-export-get-backend (name) + "Return export back-end named after NAME. +NAME is a symbol. Return nil if no such back-end is found." + (catch 'found + (dolist (b org-export--registered-backends) + (when (eq (org-export-backend-name b) name) + (throw 'found b))))) + +(defun org-export-register-backend (backend) + "Register BACKEND as a known export back-end. +BACKEND is a structure with `org-export-backend' type." + ;; Refuse to register an unnamed back-end. + (unless (org-export-backend-name backend) + (error "Cannot register a unnamed export back-end")) + ;; Refuse to register a back-end with an unknown parent. + (let ((parent (org-export-backend-parent backend))) + (when (and parent (not (org-export-get-backend parent))) + (error "Cannot use unknown \"%s\" back-end as a parent" parent))) + ;; Register dedicated export blocks in the parser. + (dolist (name (org-export-backend-blocks backend)) + (add-to-list 'org-element-block-name-alist + (cons name 'org-element-export-block-parser))) + ;; If a back-end with the same name as BACKEND is already + ;; registered, replace it with BACKEND. Otherwise, simply add + ;; BACKEND to the list of registered back-ends. + (let ((old (org-export-get-backend (org-export-backend-name backend)))) + (if old (setcar (memq old org-export--registered-backends) backend) + (push backend org-export--registered-backends)))) + +(defun org-export-barf-if-invalid-backend (backend) + "Signal an error if BACKEND isn't defined." + (unless (org-export-backend-p backend) + (error "Unknown \"%s\" back-end: Aborting export" backend))) + +(defun org-export-derived-backend-p (backend &rest backends) + "Non-nil if BACKEND is derived from one of BACKENDS. +BACKEND is an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. BACKENDS is constituted of symbols." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (catch 'exit + (while (org-export-backend-parent backend) + (when (memq (org-export-backend-name backend) backends) + (throw 'exit t)) + (setq backend + (org-export-get-backend (org-export-backend-parent backend)))) + (memq (org-export-backend-name backend) backends)))) + +(defun org-export-get-all-transcoders (backend) + "Return full translation table for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are element or object types, as symbols, and values are +transcoders. + +Unlike to `org-export-backend-transcoders', this function +also returns transcoders inherited from parent back-ends, +if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((transcoders (org-export-backend-transcoders backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq transcoders + (append transcoders (org-export-backend-transcoders backend)))) + transcoders))) + +(defun org-export-get-all-options (backend) + "Return export options for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. See `org-export-options-alist' +for the shape of the return value. + +Unlike to `org-export-backend-options', this function also +returns options inherited from parent back-ends, if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((options (org-export-backend-options backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq options (append options (org-export-backend-options backend)))) + options))) + +(defun org-export-get-all-filters (backend) + "Return complete list of filters for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are symbols and values lists of functions. + +Unlike to `org-export-backend-filters', this function also +returns filters inherited from parent back-ends, if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((filters (org-export-backend-filters backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq filters (append filters (org-export-backend-filters backend)))) + filters))) + +(defun org-export-define-backend (backend transcoders &rest body) "Define a new back-end BACKEND. -TRANSLATORS is an alist between object or element types and +TRANSCODERS is an alist between object or element types and functions handling them. These functions should return a string without any trailing @@ -996,32 +1105,23 @@ keywords are understood: `org-export-options-alist' for more information about structure of the values." (declare (indent 1)) - (let (export-block filters menu-entry options contents) + (let (blocks filters menu-entry options contents) (while (keywordp (car body)) (case (pop body) (:export-block (let ((names (pop body))) - (setq export-block - (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) + (setq blocks (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) (:filters-alist (setq filters (pop body))) (:menu-entry (setq menu-entry (pop body))) (:options-alist (setq options (pop body))) (t (pop body)))) - (setq contents (append (list :translate-alist translators) - (and filters (list :filters-alist filters)) - (and options (list :options-alist options)) - (and menu-entry (list :menu-entry menu-entry)))) - ;; Register back-end. - (let ((registeredp (assq backend org-export-registered-backends))) - (if registeredp (setcdr registeredp contents) - (push (cons backend contents) org-export-registered-backends))) - ;; Tell parser to not parse EXPORT-BLOCK blocks. - (when export-block - (mapc - (lambda (name) - (add-to-list 'org-element-block-name-alist - `(,name . org-element-export-block-parser))) - export-block)))) + (org-export-register-backend + (org-export-create-backend :name backend + :transcoders transcoders + :options options + :filters filters + :blocks blocks + :menu menu-entry)))) (defun org-export-define-derived-backend (child parent &rest body) "Create a new back-end as a variant of an existing one. @@ -1076,75 +1176,25 @@ The back-end could then be called with, for example: \(org-export-to-buffer 'my-latex \"*Test my-latex*\")" (declare (indent 2)) - (let (export-block filters menu-entry options translators contents) + (let (blocks filters menu-entry options transcoders contents) (while (keywordp (car body)) (case (pop body) (:export-block (let ((names (pop body))) - (setq export-block - (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) + (setq blocks (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) (:filters-alist (setq filters (pop body))) (:menu-entry (setq menu-entry (pop body))) (:options-alist (setq options (pop body))) - (:translate-alist (setq translators (pop body))) + (:translate-alist (setq transcoders (pop body))) (t (pop body)))) - (setq contents (append - (list :parent parent) - (let ((p-table (org-export-backend-translate-table parent))) - (list :translate-alist (append translators p-table))) - (let ((p-filters (org-export-backend-filters parent))) - (list :filters-alist (append filters p-filters))) - (let ((p-options (org-export-backend-options parent))) - (list :options-alist (append options p-options))) - (and menu-entry (list :menu-entry menu-entry)))) - (org-export-barf-if-invalid-backend parent) - ;; Register back-end. - (let ((registeredp (assq child org-export-registered-backends))) - (if registeredp (setcdr registeredp contents) - (push (cons child contents) org-export-registered-backends))) - ;; Tell parser to not parse EXPORT-BLOCK blocks. - (when export-block - (mapc - (lambda (name) - (add-to-list 'org-element-block-name-alist - `(,name . org-element-export-block-parser))) - export-block)))) - -(defun org-export-backend-parent (backend) - "Return back-end from which BACKEND is derived, or nil." - (plist-get (cdr (assq backend org-export-registered-backends)) :parent)) - -(defun org-export-backend-filters (backend) - "Return filters for BACKEND." - (plist-get (cdr (assq backend org-export-registered-backends)) - :filters-alist)) - -(defun org-export-backend-menu (backend) - "Return menu entry for BACKEND." - (plist-get (cdr (assq backend org-export-registered-backends)) - :menu-entry)) - -(defun org-export-backend-options (backend) - "Return export options for BACKEND." - (plist-get (cdr (assq backend org-export-registered-backends)) - :options-alist)) - -(defun org-export-backend-translate-table (backend) - "Return translate table for BACKEND." - (plist-get (cdr (assq backend org-export-registered-backends)) - :translate-alist)) - -(defun org-export-barf-if-invalid-backend (backend) - "Signal an error if BACKEND isn't defined." - (unless (org-export-backend-translate-table backend) - (error "Unknown \"%s\" back-end: Aborting export" backend))) - -(defun org-export-derived-backend-p (backend &rest backends) - "Non-nil if BACKEND is derived from one of BACKENDS." - (let ((parent backend)) - (while (and (not (memq parent backends)) - (setq parent (org-export-backend-parent parent)))) - parent)) + (org-export-register-backend + (org-export-create-backend :name child + :parent parent + :transcoders transcoders + :options options + :filters filters + :blocks blocks + :menu menu-entry)))) @@ -1447,14 +1497,15 @@ The back-end could then be called with, for example: ;; `org-export--get-subtree-options' and ;; `org-export--get-inbuffer-options' ;; -;; Also, `org-export--install-letbind-maybe' takes care of the part -;; relative to "#+BIND:" keywords. +;; Also, `org-export--list-bound-variables' collects bound variables +;; along with their value in order to set them as buffer local +;; variables later in the process. (defun org-export-get-environment (&optional backend subtreep ext-plist) "Collect export options from the current buffer. -Optional argument BACKEND is a symbol specifying which back-end -specific options to read, if any. +Optional argument BACKEND is an export back-end, as returned by +`org-export-create-backend'. When optional argument SUBTREEP is non-nil, assume the export is done against the current sub-tree. @@ -1480,8 +1531,7 @@ inferior to file-local settings." (list :back-end backend - :translate-alist - (org-export-backend-translate-table backend) + :translate-alist (org-export-get-all-transcoders backend) :footnote-definition-alist ;; Footnotes definitions must be collected in the original ;; buffer, as there's no insurance that they will still be in @@ -1517,11 +1567,12 @@ inferior to file-local settings." (defun org-export--parse-option-keyword (options &optional backend) "Parse an OPTIONS line and return values as a plist. -Optional argument BACKEND is a symbol specifying which back-end +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies which back-end specific items to read, if any." (let* ((all ;; Priority is given to back-end specific options. - (append (and backend (org-export-backend-options backend)) + (append (and backend (org-export-get-all-options backend)) org-export-options-alist)) plist) (dolist (option all) @@ -1541,7 +1592,8 @@ specific items to read, if any." (defun org-export--get-subtree-options (&optional backend) "Get export options in subtree at point. -Optional argument BACKEND is a symbol specifying back-end used +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies back-end used for export. Return options as a plist." ;; For each buffer keyword, create a headline property setting the ;; same property in communication channel. The name for the property @@ -1593,7 +1645,7 @@ for export. Return options as a plist." (t value))))))))) ;; Look for both general keywords and back-end specific ;; options, with priority given to the latter. - (append (and backend (org-export-backend-options backend)) + (append (and backend (org-export-get-all-options backend)) org-export-options-alist))) ;; Return value. plist))) @@ -1601,7 +1653,8 @@ for export. Return options as a plist." (defun org-export--get-inbuffer-options (&optional backend) "Return current buffer export options, as a plist. -Optional argument BACKEND, when non-nil, is a symbol specifying +Optional argument BACKEND, when non-nil, is an export back-end, +as returned by, e.g., `org-export-create-backend'. It specifies which back-end specific options should also be read in the process. @@ -1611,19 +1664,18 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." (case-fold-search t) (options (append ;; Priority is given to back-end specific options. - (and backend (org-export-backend-options backend)) + (and backend (org-export-get-all-options backend)) org-export-options-alist)) (regexp (format "^[ \t]*#\\+%s:" (regexp-opt (nconc (delq nil (mapcar 'cadr options)) org-export-special-keywords)))) - (find-opt + (find-properties (lambda (keyword) - ;; Return property name associated to KEYWORD. - (catch 'exit - (mapc (lambda (option) - (when (equal (nth 1 option) keyword) - (throw 'exit (car option)))) - options)))) + ;; Return all properties associated to KEYWORD. + (let (properties) + (dolist (option options properties) + (when (equal (nth 1 option) keyword) + (pushnew (car option) properties)))))) (get-options (lambda (&optional files plist) ;; Recursively read keywords in buffer. FILES is a list @@ -1663,77 +1715,70 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." (plist-get plist :filetags))))))) (t ;; Options in `org-export-options-alist'. - (let* ((prop (funcall find-opt key)) - (behaviour (nth 4 (assq prop options)))) - (setq plist - (plist-put - plist prop - ;; Handle value depending on specified - ;; BEHAVIOUR. - (case behaviour - (space - (if (not (plist-get plist prop)) - (org-trim val) - (concat (plist-get plist prop) - " " - (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 - (if (not (plist-member plist prop)) val - (plist-get plist prop))))))))))))) + (dolist (property (funcall find-properties key)) + (let ((behaviour (nth 4 (assq property options)))) + (setq plist + (plist-put + plist property + ;; Handle value depending on specified + ;; BEHAVIOUR. + (case behaviour + (space + (if (not (plist-get plist property)) + (org-trim val) + (concat (plist-get plist property) + " " + (org-trim val)))) + (newline + (org-trim + (concat (plist-get plist property) + "\n" + (org-trim val)))) + (split `(,@(plist-get plist property) + ,@(org-split-string val))) + ('t val) + (otherwise + (if (not (plist-member plist property)) val + (plist-get plist property)))))))))))))) ;; Return final value. plist)))) ;; Read options in the current buffer. - (setq plist (funcall get-options buffer-file-name nil)) - ;; Parse keywords specified in `org-element-document-properties'. - (mapc (lambda (keyword) - ;; Find the property associated to the keyword. - (let* ((prop (funcall find-opt keyword)) - (value (and prop (plist-get plist prop)))) - (when (stringp value) - (setq plist - (plist-put plist prop - (org-element-parse-secondary-string - value (org-element-restriction 'keyword))))))) - org-element-document-properties) - ;; Return value. - plist)) + (setq plist (funcall get-options + (and buffer-file-name (list buffer-file-name)) nil)) + ;; Parse keywords specified in `org-element-document-properties' + ;; and return PLIST. + (dolist (keyword org-element-document-properties plist) + (dolist (property (funcall find-properties keyword)) + (let ((value (plist-get plist property))) + (when (stringp value) + (setq plist + (plist-put plist property + (org-element-parse-secondary-string + value (org-element-restriction 'keyword)))))))))) (defun org-export--get-buffer-attributes () "Return properties related to buffer attributes, as a plist." ;; Store full path of input file name, or nil. For internal use. - (list :input-file (buffer-file-name (buffer-base-buffer)))) - -(defvar org-export--default-title nil) ; Dynamically scoped. -(defun org-export-store-default-title () - "Return default title for current document, as a string. -Title is extracted from associated file name, if any, or buffer's -name." - (setq org-export--default-title - (or (let ((visited-file (buffer-file-name (buffer-base-buffer)))) - (and visited-file + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (list :input-file visited-file + :title (if (not visited-file) (buffer-name (buffer-base-buffer)) (file-name-sans-extension - (file-name-nondirectory visited-file)))) - (buffer-name (buffer-base-buffer))))) + (file-name-nondirectory visited-file)))))) (defun org-export--get-global-options (&optional backend) "Return global export options as a plist. -Optional argument BACKEND, if non-nil, is a symbol specifying +Optional argument BACKEND, if non-nil, is an export back-end, as +returned by, e.g., `org-export-create-backend'. It specifies which back-end specific export options should also be read in the process." (let (plist ;; Priority is given to back-end specific options. - (all (append (and backend (org-export-backend-options backend)) + (all (append (and backend (org-export-get-all-options backend)) org-export-options-alist))) (dolist (cell all plist) - (let ((prop (car cell))) - (unless (plist-member plist prop) + (let ((prop (car cell)) + (default-value (nth 3 cell))) + (unless (or (not default-value) (plist-member plist prop)) (setq plist (plist-put plist @@ -2057,11 +2102,10 @@ a tree with a select tag." ;; back-end output. It takes care of filtering out elements or ;; objects according to export options and organizing the output blank ;; lines and white space are preserved. The function memoizes its -;; results, so it is cheap to call it within translators. +;; results, so it is cheap to call it within transcoders. ;; ;; It is possible to modify locally the back-end used by ;; `org-export-data' or even use a temporary back-end by using -;; `org-export-data-with-translations' and ;; `org-export-data-with-backend'. ;; ;; Internally, three functions handle the filtering of objects and @@ -2189,24 +2233,6 @@ Return transcoded string." results))) (plist-get info :exported-data)))))) -(defun org-export-data-with-translations (data translations info) - "Convert DATA into another format using a given translation table. -DATA is an element, an object, a secondary string or a string. -TRANSLATIONS is an alist between element or object types and -a functions handling them. See `org-export-define-backend' for -more information. INFO is a plist used as a communication -channel." - (org-export-data - data - ;; Set-up a new communication channel with TRANSLATIONS as the - ;; translate table and a new hash table for memoization. - (org-combine-plists - info - (list :translate-alist translations - ;; Size of the hash table is reduced since this function - ;; will probably be used on short trees. - :exported-data (make-hash-table :test 'eq :size 401))))) - (defun org-export-data-with-backend (data backend info) "Convert DATA into BACKEND format. @@ -2216,9 +2242,19 @@ channel. Unlike to `org-export-with-backend', this function will recursively convert DATA using BACKEND translation table." - (org-export-barf-if-invalid-backend backend) - (org-export-data-with-translations - data (org-export-backend-translate-table backend) info)) + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-data + data + ;; Set-up a new communication channel with translations defined in + ;; BACKEND as the translate table and a new hash table for + ;; memoization. + (org-combine-plists + info + (list :back-end backend + :translate-alist (org-export-get-all-transcoders backend) + ;; Size of the hash table is reduced since this function + ;; will probably be used on small trees. + :exported-data (make-hash-table :test 'eq :size 401))))) (defun org-export--interpret-p (blob info) "Non-nil if element or object BLOB should be interpreted during export. @@ -2712,18 +2748,20 @@ channel, as a plist. It must return a string or nil.") "Call every function in FILTERS. Functions are called with arguments VALUE, current export -back-end and INFO. A function returning a nil value will be -skipped. If it returns the empty string, the process ends and +back-end's name and INFO. A function returning a nil value will +be skipped. If it returns the empty string, the process ends and VALUE is ignored. Call is done in a LIFO fashion, to be sure that developer specified filters, if any, are called first." (catch 'exit - (dolist (filter filters value) - (let ((result (funcall filter value (plist-get info :back-end) info))) - (cond ((not result) value) - ((equal value "") (throw 'exit nil)) - (t (setq value result))))))) + (let* ((backend (plist-get info :back-end)) + (backend-name (and backend (org-export-backend-name backend)))) + (dolist (filter filters value) + (let ((result (funcall filter value backend-name info))) + (cond ((not result) value) + ((equal value "") (throw 'exit nil)) + (t (setq value result)))))))) (defun org-export-install-filters (info) "Install filters properties in communication channel. @@ -2754,7 +2792,7 @@ Return the updated communication channel." plist key (if (atom value) (cons value (plist-get plist key)) (append value (plist-get plist key)))))))) - (org-export-backend-filters (plist-get info :back-end))) + (org-export-get-all-filters (plist-get info :back-end))) ;; Return new communication channel. (org-combine-plists info plist))) @@ -2763,15 +2801,9 @@ Return the updated communication channel." ;;; Core functions ;; ;; This is the room for the main function, `org-export-as', along with -;; its derivatives, `org-export-to-buffer', `org-export-to-file' and -;; `org-export-string-as'. They differ either by the way they output -;; the resulting code (for the first two) or by the input type (for -;; the latter). `org-export--copy-to-kill-ring-p' determines if -;; output of these function should be added to kill ring. -;; -;; `org-export-output-file-name' is an auxiliary function meant to be -;; used with `org-export-to-file'. With a given extension, it tries -;; to provide a canonical file name to write export output to. +;; its derivative, `org-export-string-as'. +;; `org-export--copy-to-kill-ring-p' determines if output of these +;; function should be added to kill ring. ;; ;; Note that `org-export-as' doesn't really parse the current buffer, ;; but a copy of it (with the same buffer-local variables and @@ -2890,6 +2922,10 @@ The function assumes BUFFER's major mode is `org-mode'." (backend &optional subtreep visible-only body-only ext-plist) "Transcode current Org buffer into BACKEND code. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + If narrowing is active in the current buffer, only transcode its narrowed part. @@ -2910,6 +2946,7 @@ with external parameters overriding Org default settings, but still inferior to file-local settings. Return code as a string." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) (org-export-barf-if-invalid-backend backend) (save-excursion (save-restriction @@ -2925,7 +2962,8 @@ Return code as a string." (narrow-to-region (point) (point-max)))) ;; Initialize communication channel with original buffer ;; attributes, unavailable in its copy. - (let* ((info (org-combine-plists + (let* ((org-export-current-backend (org-export-backend-name backend)) + (info (org-combine-plists (list :export-options (delq nil (list (and subtreep 'subtree) @@ -2933,17 +2971,14 @@ Return code as a string." (and body-only 'body-only)))) (org-export--get-buffer-attributes))) tree) - ;; Store default title in `org-export--default-title' so that - ;; `org-export-get-environment' can access it from buffer's - ;; copy and then add it properly to communication channel. - (org-export-store-default-title) ;; Update communication channel and get parse tree. Buffer ;; isn't parsed directly. Instead, a temporary copy is ;; created, where include keywords, macros are expanded and ;; code blocks are evaluated. (org-export-with-buffer-copy - ;; Run first hook with current back-end as argument. - (run-hook-with-args 'org-export-before-processing-hook backend) + ;; Run first hook with current back-end's name as argument. + (run-hook-with-args 'org-export-before-processing-hook + (org-export-backend-name backend)) (org-export-expand-include-keyword) ;; Update macro templates since #+INCLUDE keywords might have ;; added some new ones. @@ -2953,10 +2988,11 @@ Return code as a string." ;; Update radio targets since keyword inclusion might have ;; added some more. (org-update-radio-target-regexp) - ;; Run last hook with current back-end as argument. + ;; Run last hook with current back-end's name as argument. (goto-char (point-min)) (save-excursion - (run-hook-with-args 'org-export-before-parsing-hook backend)) + (run-hook-with-args 'org-export-before-parsing-hook + (org-export-backend-name backend))) ;; Update communication channel with environment. Also ;; install user's and developer's filters. (setq info @@ -2979,9 +3015,10 @@ Return code as a string." ;; Call options filters and update export options. We do not ;; use `org-export-filter-apply-functions' here since the ;; arity of such filters is different. - (dolist (filter (plist-get info :filter-options)) - (let ((result (funcall filter info backend))) - (when result (setq info result)))) + (let ((backend-name (org-export-backend-name backend))) + (dolist (filter (plist-get info :filter-options)) + (let ((result (funcall filter info backend-name))) + (when result (setq info result))))) ;; Parse buffer and call parse-tree filter on it. (setq tree (org-export-filter-apply-functions @@ -3013,67 +3050,13 @@ Return code as a string." info)))))))) ;;;###autoload -(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. - -BACKEND is the back-end used for transcoding, as a symbol. - -BUFFER is the output buffer. If it already exists, it will be -erased first, otherwise, it will be created. - -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and -EXT-PLIST are similar to those used in `org-export-as', which -see. - -Depending on `org-export-copy-to-kill-ring', add buffer contents -to kill ring. Return buffer." - (let ((out (org-export-as backend subtreep visible-only body-only ext-plist)) - (buffer (get-buffer-create buffer))) - (with-current-buffer buffer - (erase-buffer) - (insert out) - (goto-char (point-min))) - ;; Maybe add buffer contents to kill ring. - (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out)) - (org-kill-new out)) - ;; Return buffer. - buffer)) - -;;;###autoload -(defun org-export-to-file - (backend file &optional subtreep visible-only body-only ext-plist) - "Call `org-export-as' with output to a specified file. - -BACKEND is the back-end used for transcoding, as a symbol. FILE -is the name of the output file, as a string. - -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and -EXT-PLIST are similar to those used in `org-export-as', which -see. - -Depending on `org-export-copy-to-kill-ring', add file contents -to kill ring. Return output file's name." - ;; Checks for FILE permissions. `write-file' would do the same, but - ;; we'd rather avoid needless transcoding of parse tree. - (unless (file-writable-p file) (error "Output file not writable")) - ;; Insert contents to a temporary buffer and write it to FILE. - (let ((coding buffer-file-coding-system) - (out (org-export-as backend subtreep visible-only body-only ext-plist))) - (with-temp-buffer - (insert out) - (let ((coding-system-for-write (or org-export-coding-system coding))) - (write-file file))) - ;; Maybe add file contents to kill ring. - (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out)) - (org-kill-new out))) - ;; Return full path. - file) - -;;;###autoload (defun org-export-string-as (string backend &optional body-only ext-plist) "Transcode STRING into BACKEND code. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + When optional argument BODY-ONLY is non-nil, only return body code, without preamble nor postamble. @@ -3089,7 +3072,10 @@ Return code as a string." ;;;###autoload (defun org-export-replace-region-by (backend) - "Replace the active region by its export to BACKEND." + "Replace the active region by its export to BACKEND. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end." (if (not (org-region-active-p)) (user-error "No active region to replace") (let* ((beg (region-beginning)) @@ -3103,10 +3089,10 @@ Return code as a string." (defun org-export-insert-default-template (&optional backend subtreep) "Insert all export keywords with default values at beginning of line. -BACKEND is a symbol representing the export back-end for which -specific export options should be added to the template, or -`default' for default template. When it is nil, the user will be -prompted for a category. +BACKEND is a symbol referring to the name of a registered export +back-end, for which specific export options should be added to +the template, or `default' for default template. When it is nil, +the user will be prompted for a category. If SUBTREEP is non-nil, export configuration will be set up locally for the subtree through node properties." @@ -3115,17 +3101,22 @@ locally for the subtree through node properties." (when (and subtreep (org-before-first-heading-p)) (user-error "No subtree to set export options for")) (let ((node (and subtreep (save-excursion (org-back-to-heading t) (point)))) - (backend (or backend - (intern - (org-completing-read - "Options category: " - (cons "default" - (mapcar (lambda (b) (symbol-name (car b))) - org-export-registered-backends)))))) + (backend + (or backend + (intern + (org-completing-read + "Options category: " + (cons "default" + (mapcar (lambda (b) + (symbol-name (org-export-backend-name b))) + org-export--registered-backends)))))) options keywords) ;; Populate OPTIONS and KEYWORDS. - (dolist (entry (if (eq backend 'default) org-export-options-alist - (org-export-backend-options backend))) + (dolist (entry (cond ((eq backend 'default) org-export-options-alist) + ((org-export-backend-p backend) + (org-export-get-all-options backend)) + (t (org-export-get-all-options + (org-export-get-backend backend))))) (let ((keyword (nth 1 entry)) (option (nth 2 entry))) (cond @@ -3197,61 +3188,6 @@ locally for the subtree through node properties." (car key) (if (org-string-nw-p val) (format " %s" val) ""))))))))) -(defun org-export-output-file-name (extension &optional subtreep pub-dir) - "Return output file's name according to buffer specifications. - -EXTENSION is a string representing the output file extension, -with the leading dot. - -With a non-nil optional argument SUBTREEP, try to determine -output file's name by looking for \"EXPORT_FILE_NAME\" property -of subtree at point. - -When optional argument PUB-DIR is set, use it as the publishing -directory. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Return file name as a string." - (let* ((visited-file (buffer-file-name (buffer-base-buffer))) - (base-name - ;; File name may come from EXPORT_FILE_NAME subtree - ;; property, assuming point is at beginning of said - ;; sub-tree. - (file-name-sans-extension - (or (and subtreep - (org-entry-get - (save-excursion - (ignore-errors (org-back-to-heading) (point))) - "EXPORT_FILE_NAME" t)) - ;; File name may be extracted from buffer's associated - ;; file, if any. - (and visited-file (file-name-nondirectory visited-file)) - ;; Can't determine file name on our own: Ask user. - (let ((read-file-name-function - (and org-completion-use-ido 'ido-read-file-name))) - (read-file-name - "Output file: " pub-dir nil nil nil - (lambda (name) - (string= (file-name-extension name t) extension))))))) - (output-file - ;; Build file name. Enforce EXTENSION over whatever user - ;; may have come up with. PUB-DIR, if defined, always has - ;; precedence over any provided path. - (cond - (pub-dir - (concat (file-name-as-directory pub-dir) - (file-name-nondirectory base-name) - extension)) - ((file-name-absolute-p base-name) (concat base-name extension)) - (t (concat (file-name-as-directory ".") base-name extension))))) - ;; If writing to OUTPUT-FILE would overwrite original file, append - ;; EXTENSION another time to final name. - (if (and visited-file (org-file-equal-p visited-file output-file)) - (concat output-file extension) - output-file))) - (defun org-export-expand-include-keyword (&optional included dir) "Expand every include keyword in buffer. Optional argument INCLUDED is a list of included file names along @@ -3502,16 +3438,20 @@ Caption lines are separated by a white space." ;; back-end, it may be used as a fall-back function once all specific ;; cases have been treated. -(defun org-export-with-backend (back-end data &optional contents info) - "Call a transcoder from BACK-END on DATA. -CONTENTS, when non-nil, is the transcoded contents of DATA -element, as a string. INFO, when non-nil, is the communication -channel used for export, as a plist.." - (org-export-barf-if-invalid-backend back-end) +(defun org-export-with-backend (backend data &optional contents info) + "Call a transcoder from BACKEND on DATA. +BACKEND is an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. DATA is an Org element, object, secondary +string or string. CONTENTS, when non-nil, is the transcoded +contents of DATA element, as a string. INFO, when non-nil, is +the communication channel used for export, as a plist." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-barf-if-invalid-backend backend) (let ((type (org-element-type data))) (if (memq type '(nil org-data)) (error "No foreign transcoder available") (let ((transcoder - (cdr (assq type (org-export-backend-translate-table back-end))))) + (cdr (assq type (org-export-get-all-transcoders backend))))) (if (functionp transcoder) (funcall transcoder data contents info) (error "No foreign transcoder available")))))) @@ -4472,19 +4412,21 @@ Return value is the width given by the last width cookie in the same column as TABLE-CELL, or nil." (let* ((row (org-export-get-parent table-cell)) (table (org-export-get-parent row)) - (column (let ((cells (org-element-contents row))) - (- (length cells) (length (memq table-cell cells))))) + (cells (org-element-contents row)) + (columns (length cells)) + (column (- columns (length (memq table-cell cells)))) (cache (or (plist-get info :table-cell-width-cache) (plist-get (setq info (plist-put info :table-cell-width-cache - (make-hash-table :test 'equal))) + (make-hash-table :test 'eq))) :table-cell-width-cache))) - (key (cons table column)) - (value (gethash key cache 'no-result))) - (if (not (eq value 'no-result)) value + (width-vector (or (gethash table cache) + (puthash table (make-vector columns 'empty) cache))) + (value (aref width-vector column))) + (if (not (eq value 'empty)) value (let (cookie-width) (dolist (row (org-element-contents table) - (puthash key cookie-width cache)) + (aset width-vector column cookie-width)) (when (org-export-table-row-is-special-p row info) ;; In a special row, try to find a width cookie at COLUMN. (let* ((value (org-element-contents @@ -4510,16 +4452,21 @@ same column as TABLE-CELL. If no such cookie is found, a default alignment value will be deduced from fraction of numbers in the column (see `org-table-number-fraction' for more information). Possible values are `left', `right' and `center'." + ;; Load `org-table-number-fraction' and `org-table-number-regexp'. + (require 'org-table) (let* ((row (org-export-get-parent table-cell)) (table (org-export-get-parent row)) - (column (let ((cells (org-element-contents row))) - (- (length cells) (length (memq table-cell cells))))) + (cells (org-element-contents row)) + (columns (length cells)) + (column (- columns (length (memq table-cell cells)))) (cache (or (plist-get info :table-cell-alignment-cache) (plist-get (setq info (plist-put info :table-cell-alignment-cache - (make-hash-table :test 'equal))) - :table-cell-alignment-cache)))) - (or (gethash (cons table column) cache) + (make-hash-table :test 'eq))) + :table-cell-alignment-cache))) + (align-vector (or (gethash table cache) + (puthash table (make-vector columns nil) cache)))) + (or (aref align-vector column) (let ((number-cells 0) (total-cells 0) cookie-align @@ -4562,15 +4509,15 @@ Possible values are `left', `right' and `center'." (incf number-cells)))))) ;; Return value. Alignment specified by cookies has ;; precedence over alignment deduced from cell's contents. - (puthash (cons table column) - (cond ((equal cookie-align "l") 'left) - ((equal cookie-align "r") 'right) - ((equal cookie-align "c") 'center) - ((>= (/ (float number-cells) total-cells) - org-table-number-fraction) - 'right) - (t 'left)) - cache))))) + (aset align-vector + column + (cond ((equal cookie-align "l") 'left) + ((equal cookie-align "r") 'right) + ((equal cookie-align "c") 'center) + ((>= (/ (float number-cells) total-cells) + org-table-number-fraction) + 'right) + (t 'left))))))) (defun org-export-table-cell-borders (table-cell info) "Return TABLE-CELL borders. @@ -4819,14 +4766,14 @@ information. Return a list of all exportable headlines as parsed elements. Footnote sections, if any, will be ignored." - (unless (wholenump n) (setq n (plist-get info :headline-levels))) - (org-element-map (plist-get info :parse-tree) 'headline - (lambda (headline) - (unless (org-element-property :footnote-section-p headline) - ;; Strip contents from HEADLINE. - (let ((relative-level (org-export-get-relative-level headline info))) - (unless (> relative-level n) headline)))) - info)) + (let ((limit (plist-get info :headline-levels))) + (setq n (if (wholenump n) (min n limit) limit)) + (org-element-map (plist-get info :parse-tree) 'headline + #'(lambda (headline) + (unless (org-element-property :footnote-section-p headline) + (let ((level (org-export-get-relative-level headline info))) + (and (<= level n) headline)))) + info))) (defun org-export-collect-elements (type info &optional predicate) "Collect referenceable elements of a determined type. @@ -4893,7 +4840,20 @@ Return a list of src-block elements with a caption." ;; `org-export-smart-quotes-regexps'. (defconst org-export-smart-quotes-alist - '(("de" + '(("da" + ;; one may use: »...«, "...", ›...‹, or '...'. + ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ + ;; LaTeX quotes require Babel! + (opening-double-quote :utf-8 "»" :html "»" :latex ">>" + :texinfo "@guillemetright{}") + (closing-double-quote :utf-8 "«" :html "«" :latex "<<" + :texinfo "@guillemetleft{}") + (opening-single-quote :utf-8 "›" :html "›" :latex "\\frq{}" + :texinfo "@guilsinglright{}") + (closing-single-quote :utf-8 "‹" :html "‹" :latex "\\flq{}" + :texinfo "@guilsingleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("de" (opening-double-quote :utf-8 "„" :html "„" :latex "\"`" :texinfo "@quotedblbase{}") (closing-double-quote :utf-8 "“" :html "“" :latex "\"'" @@ -4926,7 +4886,42 @@ Return a list of src-block elements with a caption." :texinfo "@guillemetleft{}@tie{}") (closing-single-quote :utf-8 " »" :html " »" :latex "\\fg{}" :texinfo "@tie{}@guillemetright{}") - (apostrophe :utf-8 "’" :html "’"))) + (apostrophe :utf-8 "’" :html "’")) + ("no" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nb" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nn" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("sv" + ;; based on https://sv.wikipedia.org/wiki/Citattecken + (opening-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (closing-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (opening-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ) "Smart quotes translations. Alist whose CAR is a language string and CDR is an alist with @@ -5214,10 +5209,12 @@ them." ;; the dictionary used for the translation. (defconst org-export-dictionary - '(("Author" + '(("%e %n: %c" + ("fr" :default "%e %n : %c" :html "%e %n : %c")) + ("Author" ("ca" :default "Autor") ("cs" :default "Autor") - ("da" :default "Ophavsmand") + ("da" :default "Forfatter") ("de" :default "Autor") ("eo" :html "Aŭtoro") ("es" :default "Autor") @@ -5260,12 +5257,36 @@ them." ("zh-CN" :html "日期" :utf-8 "日期") ("zh-TW" :html "日期" :utf-8 "日期")) ("Equation" + ("da" :default "Ligning") ("de" :default "Gleichung") ("es" :html "Ecuación" :default "Ecuación") - ("fr" :ascii "Equation" :default "Équation")) + ("fr" :ascii "Equation" :default "Équation") + ("no" :default "Ligning") + ("nb" :default "Ligning") + ("nn" :default "Likning") + ("sv" :default "Ekvation") + ("zh-CN" :html "方程" :utf-8 "方程")) ("Figure" + ("da" :default "Figur") ("de" :default "Abbildung") - ("es" :default "Figura")) + ("es" :default "Figura") + ("ja" :html "図" :utf-8 "図") + ("no" :default "Illustrasjon") + ("nb" :default "Illustrasjon") + ("nn" :default "Illustrasjon") + ("sv" :default "Illustration") + ("zh-CN" :html "图" :utf-8 "图")) + ("Figure %d:" + ("da" :default "Figur %d") + ("de" :default "Abbildung %d:") + ("es" :default "Figura %d:") + ("fr" :default "Figure %d :" :html "Figure %d :") + ("ja" :html "図%d: " :utf-8 "図%d: ") + ("no" :default "Illustrasjon %d") + ("nb" :default "Illustrasjon %d") + ("nn" :default "Illustrasjon %d") + ("sv" :default "Illustration %d") + ("zh-CN" :html "图%d " :utf-8 "图%d ")) ("Footnotes" ("ca" :html "Peus de pàgina") ("cs" :default "Pozn\xe1mky pod carou") @@ -5291,28 +5312,54 @@ them." ("zh-CN" :html "脚注" :utf-8 "脚注") ("zh-TW" :html "腳註" :utf-8 "腳註")) ("List of Listings" + ("da" :default "Programmer") ("de" :default "Programmauflistungsverzeichnis") ("es" :default "Indice de Listados de programas") - ("fr" :default "Liste des programmes")) + ("fr" :default "Liste des programmes") + ("no" :default "Dataprogrammer") + ("nb" :default "Dataprogrammer") + ("zh-CN" :html "代码目录" :utf-8 "代码目录")) ("List of Tables" + ("da" :default "Tabeller") ("de" :default "Tabellenverzeichnis") ("es" :default "Indice de tablas") - ("fr" :default "Liste des tableaux")) + ("fr" :default "Liste des tableaux") + ("no" :default "Tabeller") + ("nb" :default "Tabeller") + ("nn" :default "Tabeller") + ("sv" :default "Tabeller") + ("zh-CN" :html "表格目录" :utf-8 "表格目录")) ("Listing %d:" + ("da" :default "Program %d") ("de" :default "Programmlisting %d") ("es" :default "Listado de programa %d") - ("fr" - :ascii "Programme %d :" :default "Programme nº %d :" - :latin1 "Programme %d :")) + ("fr" :default "Programme %d :" :html "Programme %d :") + ("no" :default "Dataprogram") + ("nb" :default "Dataprogram") + ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) ("See section %s" + ("da" :default "jævnfør afsnit %s") ("de" :default "siehe Abschnitt %s") ("es" :default "vea seccion %s") - ("fr" :default "cf. section %s")) + ("fr" :default "cf. section %s") + ("zh-CN" :html "参见第%d节" :utf-8 "参见第%s节")) + ("Table" + ("de" :default "Tabelle") + ("es" :default "Tabla") + ("fr" :default "Tableau") + ("ja" :html "表" :utf-8 "表") + ("zh-CN" :html "表" :utf-8 "表")) ("Table %d:" + ("da" :default "Tabel %d") ("de" :default "Tabelle %d") ("es" :default "Tabla %d") - ("fr" - :ascii "Tableau %d :" :default "Tableau nº %d :" :latin1 "Tableau %d :")) + ("fr" :default "Tableau %d :") + ("ja" :html "表%d:" :utf-8 "表%d:") + ("no" :default "Tabell %d") + ("nb" :default "Tabell %d") + ("nn" :default "Tabell %d") + ("sv" :default "Tabell %d") + ("zh-CN" :html "表%d " :utf-8 "表%d ")) ("Table of Contents" ("ca" :html "Índex") ("cs" :default "Obsah") @@ -5338,9 +5385,11 @@ them." ("zh-CN" :html "目录" :utf-8 "目录") ("zh-TW" :html "目錄" :utf-8 "目錄")) ("Unknown reference" + ("da" :default "ukendt reference") ("de" :default "Unbekannter Verweis") ("es" :default "referencia desconocida") - ("fr" :ascii "Destination inconnue" :default "Référence inconnue"))) + ("fr" :ascii "Destination inconnue" :default "Référence inconnue") + ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) "Dictionary for export engine. Alist whose CAR is the string to translate and CDR is an alist @@ -5378,6 +5427,13 @@ to `:default' encoding. If it fails, return S." ;; evaluates a command there. It then applies a function on the ;; returned results in the current process. ;; +;; At a higher level, `org-export-to-buffer' and `org-export-to-file' +;; allow to export to a buffer or a file, asynchronously or not. +;; +;; `org-export-output-file-name' is an auxiliary function meant to be +;; used with `org-export-to-file'. With a given extension, it tries +;; to provide a canonical file name to write export output to. +;; ;; Asynchronously generated results are never displayed directly. ;; Instead, they are stored in `org-export-stack-contents'. They can ;; then be retrieved by calling `org-export-stack'. @@ -5388,7 +5444,7 @@ to `:default' encoding. If it fails, return S." ;;`org-export-stack-clear'. ;; ;; For back-ends, `org-export-add-to-stack' add a new source to stack. -;; It should used whenever `org-export-async-start' is called. +;; It should be used whenever `org-export-async-start' is called. (defmacro org-export-async-start (fun &rest body) "Call function FUN on the results returned by BODY evaluation. @@ -5397,93 +5453,260 @@ BODY evaluation happens in an asynchronous process, from a buffer which is an exact copy of the current one. Use `org-export-add-to-stack' in FUN in order to register results -in the stack. Examples for, respectively a temporary buffer and -a file are: - - \(org-export-async-start - \(lambda (output) - \(with-current-buffer (get-buffer-create \"*Org BACKEND Export*\") - \(erase-buffer) - \(insert output) - \(goto-char (point-min)) - \(org-export-add-to-stack (current-buffer) 'backend))) - `(org-export-as 'backend ,subtreep ,visible-only ,body-only ',ext-plist)) - -and - - \(org-export-async-start - \(lambda (f) (org-export-add-to-stack f 'backend)) - `(expand-file-name - \(org-export-to-file - 'backend ,outfile ,subtreep ,visible-only ,body-only ',ext-plist)))" +in the stack. + +This is a low level function. See also `org-export-to-buffer' +and `org-export-to-file' for more specialized functions." (declare (indent 1) (debug t)) - (org-with-gensyms (process temp-file copy-fun proc-buffer handler coding) + (org-with-gensyms (process temp-file copy-fun proc-buffer coding) ;; Write the full sexp evaluating BODY in a copy of the current ;; buffer to a temporary file, as it may be too long for program ;; args in `start-process'. `(with-temp-message "Initializing asynchronous export process" (let ((,copy-fun (org-export--generate-copy-script (current-buffer))) - (,temp-file (make-temp-file "org-export-process")) - (,coding buffer-file-coding-system)) - (with-temp-file ,temp-file - (insert - ;; Null characters (from variable values) are inserted - ;; within the file. As a consequence, coding system for - ;; buffer contents will not be recognized properly. So, - ;; we make sure it is the same as the one used to display - ;; the original buffer. - (format ";; -*- coding: %s; -*-\n%S" - ,coding - `(with-temp-buffer - ,(when org-export-async-debug '(setq debug-on-error t)) - ;; Ignore `kill-emacs-hook' and code evaluation - ;; queries from Babel as we need a truly - ;; non-interactive process. - (setq kill-emacs-hook nil - org-babel-confirm-evaluate-answer-no t) - ;; Initialize export framework. - (require 'ox) - ;; Re-create current buffer there. - (funcall ,,copy-fun) - (restore-buffer-modified-p nil) - ;; Sexp to evaluate in the buffer. - (print (progn ,,@body)))))) - ;; Start external process. - (let* ((process-connection-type nil) - (,proc-buffer (generate-new-buffer-name "*Org Export Process*")) - (,process - (start-process - "org-export-process" ,proc-buffer - (expand-file-name invocation-name invocation-directory) - "-Q" "--batch" - "-l" org-export-async-init-file - "-l" ,temp-file))) - ;; Register running process in stack. - (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process) - ;; Set-up sentinel in order to catch results. - (set-process-sentinel - ,process - (let ((handler ',fun)) - `(lambda (p status) - (let ((proc-buffer (process-buffer p))) - (when (eq (process-status p) 'exit) - (unwind-protect - (if (zerop (process-exit-status p)) - (unwind-protect - (let ((results - (with-current-buffer proc-buffer - (goto-char (point-max)) - (backward-sexp) - (read (current-buffer))))) - (funcall ,handler results)) - (unless org-export-async-debug - (and (get-buffer proc-buffer) - (kill-buffer proc-buffer)))) - (org-export-add-to-stack proc-buffer nil p) - (ding) - (message "Process '%s' exited abnormally" p)) - (unless org-export-async-debug - (delete-file ,,temp-file))))))))))))) + (,temp-file (make-temp-file "org-export-process")) + (,coding buffer-file-coding-system)) + (with-temp-file ,temp-file + (insert + ;; Null characters (from variable values) are inserted + ;; within the file. As a consequence, coding system for + ;; buffer contents will not be recognized properly. So, + ;; we make sure it is the same as the one used to display + ;; the original buffer. + (format ";; -*- coding: %s; -*-\n%S" + ,coding + `(with-temp-buffer + (when org-export-async-debug '(setq debug-on-error t)) + ;; Ignore `kill-emacs-hook' and code evaluation + ;; queries from Babel as we need a truly + ;; non-interactive process. + (setq kill-emacs-hook nil + org-babel-confirm-evaluate-answer-no t) + ;; Initialize export framework. + (require 'ox) + ;; Re-create current buffer there. + (funcall ,,copy-fun) + (restore-buffer-modified-p nil) + ;; Sexp to evaluate in the buffer. + (print (progn ,,@body)))))) + ;; Start external process. + (let* ((process-connection-type nil) + (,proc-buffer (generate-new-buffer-name "*Org Export Process*")) + (,process + (start-process + "org-export-process" ,proc-buffer + (expand-file-name invocation-name invocation-directory) + "-Q" "--batch" + "-l" org-export-async-init-file + "-l" ,temp-file))) + ;; Register running process in stack. + (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process) + ;; Set-up sentinel in order to catch results. + (let ((handler ,fun)) + (set-process-sentinel + ,process + `(lambda (p status) + (let ((proc-buffer (process-buffer p))) + (when (eq (process-status p) 'exit) + (unwind-protect + (if (zerop (process-exit-status p)) + (unwind-protect + (let ((results + (with-current-buffer proc-buffer + (goto-char (point-max)) + (backward-sexp) + (read (current-buffer))))) + (funcall ,handler results)) + (unless org-export-async-debug + (and (get-buffer proc-buffer) + (kill-buffer proc-buffer)))) + (org-export-add-to-stack proc-buffer nil p) + (ding) + (message "Process '%s' exited abnormally" p)) + (unless org-export-async-debug + (delete-file ,,temp-file))))))))))))) + +;;;###autoload +(defun org-export-to-buffer + (backend buffer + &optional async subtreep visible-only body-only ext-plist + post-process) + "Call `org-export-as' with output to a specified buffer. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +BUFFER is the name of the output buffer. If it already exists, +it will be erased first, otherwise, it will be created. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should then be accessible +through the `org-export-stack' interface. When ASYNC is nil, the +buffer is displayed if `org-export-show-temporary-export-buffer' +is non-nil. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is a function which should accept +no argument. It is always called within the current process, +from BUFFER, with point at its beginning. Export back-ends can +use it to set a major mode there, e.g, + + \(defun org-latex-export-as-latex + \(&optional async subtreep visible-only body-only ext-plist) + \(interactive) + \(org-export-to-buffer 'latex \"*Org LATEX Export*\" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +This function returns BUFFER." + (declare (indent 2)) + (if async + (org-export-async-start + `(lambda (output) + (with-current-buffer (get-buffer-create ,buffer) + (erase-buffer) + (setq buffer-file-coding-system ',buffer-file-coding-system) + (insert output) + (goto-char (point-min)) + (org-export-add-to-stack (current-buffer) ',backend) + (ignore-errors (funcall ,post-process)))) + `(org-export-as + ',backend ,subtreep ,visible-only ,body-only ',ext-plist)) + (let ((output + (org-export-as backend subtreep visible-only body-only ext-plist)) + (buffer (get-buffer-create buffer)) + (encoding buffer-file-coding-system)) + (when (and (org-string-nw-p output) (org-export--copy-to-kill-ring-p)) + (org-kill-new output)) + (with-current-buffer buffer + (erase-buffer) + (setq buffer-file-coding-system encoding) + (insert output) + (goto-char (point-min)) + (and (functionp post-process) (funcall post-process))) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window buffer)) + buffer))) + +;;;###autoload +(defun org-export-to-file + (backend file &optional async subtreep visible-only body-only ext-plist + post-process) + "Call `org-export-as' with output to a specified file. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. FILE is the name of the output file, as +a string. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer file then be accessible +through the `org-export-stack' interface. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is called with FILE as its +argument and happens asynchronously when ASYNC is non-nil. It +has to return a file name, or nil. Export back-ends can use this +to send the output file through additional processing, e.g, + + \(defun org-latex-export-to-latex + \(&optional async subtreep visible-only body-only ext-plist) + \(interactive) + \(let ((outfile (org-export-output-file-name \".tex\" subtreep))) + \(org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist + \(lambda (file) (org-latex-compile file))) + +The function returns either a file name returned by POST-PROCESS, +or FILE." + (declare (indent 2)) + (if (not (file-writable-p file)) (error "Output file not writable") + (let ((encoding (or org-export-coding-system buffer-file-coding-system))) + (if async + (org-export-async-start + `(lambda (file) + (org-export-add-to-stack (expand-file-name file) ',backend)) + `(let ((output + (org-export-as + ',backend ,subtreep ,visible-only ,body-only + ',ext-plist))) + (with-temp-buffer + (insert output) + (let ((coding-system-for-write ',encoding)) + (write-file ,file))) + (or (ignore-errors (funcall ',post-process ,file)) ,file))) + (let ((output (org-export-as + backend subtreep visible-only body-only ext-plist))) + (with-temp-buffer + (insert output) + (let ((coding-system-for-write encoding)) + (write-file file))) + (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output)) + (org-kill-new output)) + ;; Get proper return value. + (or (and (functionp post-process) (funcall post-process file)) + file)))))) + +(defun org-export-output-file-name (extension &optional subtreep pub-dir) + "Return output file's name according to buffer specifications. + +EXTENSION is a string representing the output file extension, +with the leading dot. + +With a non-nil optional argument SUBTREEP, try to determine +output file's name by looking for \"EXPORT_FILE_NAME\" property +of subtree at point. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Return file name as a string." + (let* ((visited-file (buffer-file-name (buffer-base-buffer))) + (base-name + ;; File name may come from EXPORT_FILE_NAME subtree + ;; property, assuming point is at beginning of said + ;; sub-tree. + (file-name-sans-extension + (or (and subtreep + (org-entry-get + (save-excursion + (ignore-errors (org-back-to-heading) (point))) + "EXPORT_FILE_NAME" t)) + ;; File name may be extracted from buffer's associated + ;; file, if any. + (and visited-file (file-name-nondirectory visited-file)) + ;; Can't determine file name on our own: Ask user. + (let ((read-file-name-function + (and org-completion-use-ido 'ido-read-file-name))) + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (name) + (string= (file-name-extension name t) extension))))))) + (output-file + ;; Build file name. Enforce EXTENSION over whatever user + ;; may have come up with. PUB-DIR, if defined, always has + ;; precedence over any provided path. + (cond + (pub-dir + (concat (file-name-as-directory pub-dir) + (file-name-nondirectory base-name) + extension)) + ((file-name-absolute-p base-name) (concat base-name extension)) + (t (concat (file-name-as-directory ".") base-name extension))))) + ;; If writing to OUTPUT-FILE would overwrite original file, append + ;; EXTENSION another time to final name. + (if (and visited-file (org-file-equal-p visited-file output-file)) + (concat output-file extension) + output-file))) (defun org-export-add-to-stack (source backend &optional process) "Add a new result to export stack if not present already. @@ -5746,43 +5969,31 @@ back to standard interface." (lambda (value) ;; Fontify VALUE string. (org-propertize value 'face 'font-lock-variable-name-face))) - ;; Prepare menu entries by extracting them from - ;; `org-export-registered-backends', and sorting them by - ;; access key and by ordinal, if any. - (backends - (sort - (sort - (delq nil - (mapcar - (lambda (b) - (let ((name (car b))) - (catch 'ignored - ;; Ignore any back-end belonging to - ;; `org-export-invisible-backends' or derived - ;; from one of them. - (dolist (ignored org-export-invisible-backends) - (when (org-export-derived-backend-p name ignored) - (throw 'ignored nil))) - (org-export-backend-menu name)))) - org-export-registered-backends)) - (lambda (a b) - (let ((key-a (nth 1 a)) - (key-b (nth 1 b))) - (cond ((and (numberp key-a) (numberp key-b)) - (< key-a key-b)) - ((numberp key-b) t))))) - (lambda (a b) (< (car a) (car b))))) + ;; Prepare menu entries by extracting them from registered + ;; back-ends and sorting them by access key and by ordinal, + ;; if any. + (entries + (sort (sort (delq nil + (mapcar 'org-export-backend-menu + org-export--registered-backends)) + (lambda (a b) + (let ((key-a (nth 1 a)) + (key-b (nth 1 b))) + (cond ((and (numberp key-a) (numberp key-b)) + (< key-a key-b)) + ((numberp key-b) t))))) + 'car-less-than-car)) ;; Compute a list of allowed keys based on the first key ;; pressed, if any. Some keys ;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always ;; available. (allowed-keys (nconc (list 2 22 19 6 1) - (if (not first-key) (org-uniquify (mapcar 'car backends)) + (if (not first-key) (org-uniquify (mapcar 'car entries)) (let (sub-menu) - (dolist (backend backends (sort (mapcar 'car sub-menu) '<)) - (when (eq (car backend) first-key) - (setq sub-menu (append (nth 2 backend) sub-menu)))))) + (dolist (entry entries (sort (mapcar 'car sub-menu) '<)) + (when (eq (car entry) first-key) + (setq sub-menu (append (nth 2 entry) sub-menu)))))) (cond ((eq first-key ?P) (list ?f ?p ?x ?a)) ((not first-key) (list ?P))) (list ?& ?#) @@ -5841,7 +6052,7 @@ back to standard interface." (nth 1 sub-entry))) sub-menu "") (when (zerop (mod index 2)) "\n")))))))) - backends "")) + entries "")) ;; Publishing menu is hard-coded. (format "\n[%s] Publish [%s] Current file [%s] Current project @@ -5876,7 +6087,7 @@ back to standard interface." ;; UI, display an intrusive help buffer. (if expertp (org-export--dispatch-action - expert-prompt allowed-keys backends options first-key expertp) + expert-prompt allowed-keys entries options first-key expertp) ;; At first call, create frame layout in order to display menu. (unless (get-buffer "*Org Export Dispatcher*") (delete-other-windows) @@ -5899,15 +6110,15 @@ back to standard interface." (set-window-start nil pos))) (org-fit-window-to-buffer) (org-export--dispatch-action - standard-prompt allowed-keys backends options first-key expertp)))) + standard-prompt allowed-keys entries options first-key expertp)))) (defun org-export--dispatch-action - (prompt allowed-keys backends options first-key expertp) + (prompt allowed-keys entries options first-key expertp) "Read a character from command input and act accordingly. PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is a list of characters available at a given step in the process. -BACKENDS is a list of menu entries. OPTIONS, FIRST-KEY and +ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and EXPERTP are the same as defined in `org-export--dispatch-ui', which see. @@ -5964,9 +6175,9 @@ options as CDR." first-key expertp)) ;; Action selected: Send key and options back to ;; `org-export-dispatch'. - ((or first-key (functionp (nth 2 (assq key backends)))) + ((or first-key (functionp (nth 2 (assq key entries)))) (cons (cond - ((not first-key) (nth 2 (assq key backends))) + ((not first-key) (nth 2 (assq key entries))) ;; Publishing actions are hard-coded. Send a special ;; signal to `org-export-dispatch'. ((eq first-key ?P) @@ -5979,10 +6190,10 @@ options as CDR." ;; path. Indeed, derived backends can share the same ;; FIRST-KEY. (t (catch 'found - (mapc (lambda (backend) - (let ((match (assq key (nth 2 backend)))) + (mapc (lambda (entry) + (let ((match (assq key (nth 2 entry)))) (when match (throw 'found (nth 2 match))))) - (member (assq first-key backends) backends))))) + (member (assq first-key entries) entries))))) options)) ;; Otherwise, enter sub-menu. (t (org-export--dispatch-ui options key expertp))))) |