diff options
35 files changed, 2037 insertions, 682 deletions
diff --git a/contrib/lisp/org-link-edit.el b/contrib/lisp/org-link-edit.el new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/contrib/lisp/org-link-edit.el diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el index a7820f1..bfc4d6c 100644 --- a/contrib/lisp/org-velocity.el +++ b/contrib/lisp/org-velocity.el @@ -4,7 +4,7 @@ ;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com> ;; Created: 2010-05-05 -;; Version: 4.0 +;; Version: 4.1 ;; This file is not part of GNU Emacs. @@ -78,12 +78,6 @@ :group 'org-velocity :type 'file) -(defcustom org-velocity-search-is-incremental t - "Show results incrementally when possible?" - :group 'org-velocity - :type 'boolean - :safe 'booleanp) - (defcustom org-velocity-show-previews t "Show previews of the text of each heading?" :group 'velocity @@ -168,20 +162,27 @@ See the documentation for `org-capture-templates'." The length of the preview is determined by `window-width'. Replace all contiguous whitespace with single spaces." - (let ((start (progn - (forward-line 1) - (if (looking-at org-property-start-re) - (re-search-forward org-property-end-re) - (1- (point)))))) - (mapconcat - #'identity - (split-string - (buffer-substring-no-properties - start - (min - (+ start (window-width)) - (point-max)))) - " "))) + (let* ((start (progn + (forward-line 1) + (if (looking-at org-property-start-re) + (re-search-forward org-property-end-re) + (1- (point))))) + (string+props (buffer-substring + start + (min + (+ start (window-width)) + (point-max))))) + ;; We want to preserve the text properties so that, for example, + ;; we don't end up with the raw text of links in the preview. + (with-temp-buffer + (insert string+props) + (goto-char (point-min)) + (save-match-data + (while (re-search-forward split-string-default-separators + (point-max) + t) + (replace-match " "))) + (buffer-string)))) (cl-defstruct org-velocity-heading buffer position name level preview) @@ -233,9 +234,16 @@ of the base buffer; in the latter, return the file name of (defun org-velocity-minibuffer-contents () "Return the contents of the minibuffer when it is active." - (if (active-minibuffer-window) - (with-current-buffer (window-buffer (active-minibuffer-window)) - (minibuffer-contents)))) + (when (active-minibuffer-window) + (with-current-buffer (window-buffer (active-minibuffer-window)) + (minibuffer-contents)))) + +(defun org-velocity-nix-minibuffer () + "Return the contents of the minibuffer and clear it." + (when (active-minibuffer-window) + (with-current-buffer (window-buffer (active-minibuffer-window)) + (prog1 (minibuffer-contents) + (delete-minibuffer-contents))))) (defun org-velocity-bucket-file () "Return the proper file for Org-Velocity to search. @@ -259,6 +267,7 @@ use it." (error "No bucket and not an Org file")))))) (defvar org-velocity-bucket-buffer nil) +(defvar org-velocity-navigating nil) (defsubst org-velocity-bucket-buffer () (or org-velocity-bucket-buffer @@ -271,9 +280,6 @@ use it." (defsubst org-velocity-match-window () (get-buffer-window (org-velocity-match-buffer))) -(defsubst org-velocity-match-staging-buffer () - (get-buffer-create " Velocity matches")) - (defun org-velocity-beginning-of-headings () "Goto the start of the first heading." (goto-char (point-min)) @@ -310,29 +316,47 @@ use it." (make-variable-buffer-local 'org-velocity-saved-winconf) (defun org-velocity-edit-entry (heading) + (if org-velocity-navigating + (org-velocity-edit-entry/inline heading) + (org-velocity-edit-entry/indirect heading))) + +(cl-defun org-velocity-goto-entry (heading &key narrow) + (goto-char (org-velocity-heading-position heading)) + (save-excursion + (when narrow + (org-narrow-to-subtree)) + (outline-show-all))) + +(defun org-velocity-edit-entry/inline (heading) + "Edit entry at HEADING in the original buffer." + (let ((buffer (org-velocity-heading-buffer heading))) + (pop-to-buffer buffer) + (with-current-buffer buffer + (org-velocity-goto-entry heading)))) + +(defun org-velocity-format-header-line (control-string &rest args) + (set (make-local-variable 'header-line-format) + (apply #'format control-string args))) + +(defun org-velocity-edit-entry/indirect (heading) "Edit entry at HEADING in an indirect buffer." (let ((winconf (current-window-configuration)) + (dd default-directory) (buffer (org-velocity-make-indirect-buffer heading)) (inhibit-point-motion-hooks t) (inhibit-field-text-motion t)) (with-current-buffer buffer + (setq default-directory dd) ;Inherit default directory. (setq org-velocity-saved-winconf winconf) - (goto-char (org-velocity-heading-position heading)) - (let ((start (point)) - (end (save-excursion - (org-end-of-subtree t) - (point)))) - ;; Outline view and narrow-to-region interact poorly. - (outline-flag-region start end nil) - (narrow-to-region start end)) + (org-velocity-goto-entry heading :narrow t) (goto-char (point-max)) (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t)) (pop-to-buffer buffer) - (set (make-local-variable 'header-line-format) - (format "%s Use C-c C-c to finish." - (abbreviate-file-name - (buffer-file-name - (org-velocity-heading-buffer heading))))))) + (org-velocity-format-header-line + "%s Use C-c C-c to finish." + (abbreviate-file-name + (buffer-file-name + (org-velocity-heading-buffer heading)))))) (defun org-velocity-dismiss () "Save current entry and close indirect buffer." @@ -350,9 +374,7 @@ use it." (button-get button 'search) search-ring-max)) (let ((match (button-get button 'match))) - (throw 'org-velocity-done - (lambda () - (org-velocity-edit-entry match))))) + (throw 'org-velocity-done match))) (define-button-type 'org-velocity-button 'action #'org-velocity-visit-button @@ -374,57 +396,113 @@ use it." (org-velocity-heading-preview heading) 'face 'shadow)))) +(defvar org-velocity-recursive-headings nil) +(defvar org-velocity-recursive-search nil) + +(cl-defun org-velocity-search-with (fun style search + &key (headings org-velocity-recursive-headings)) + (if headings + (save-restriction + (dolist (heading headings) + (widen) + (let ((start (org-velocity-heading-position heading))) + (goto-char start) + (let ((end (save-excursion + (org-end-of-subtree) + (point)))) + (narrow-to-region start end) + (org-velocity-search-with fun style search + :headings nil))))) + (cl-ecase style + ((phrase any regexp) + (cl-block nil + (while (re-search-forward search nil t) + (let ((match (org-velocity-nearest-heading (point)))) + (funcall fun match)) + ;; Skip to the next heading. + (unless (re-search-forward (org-velocity-heading-regexp) nil t) + (cl-return))))) + ((all) + (let ((keywords + (cl-loop for word in (split-string search) + collect (concat "\\<" (regexp-quote word) "\\>")))) + (org-map-entries + (lambda () + ;; Only search the subtree once. + (setq org-map-continue-from + (save-excursion + (org-end-of-subtree) + (point))) + (when (cl-loop for word in keywords + always (save-excursion + (re-search-forward word org-map-continue-from t))) + (let ((match (org-velocity-nearest-heading (match-end 0)))) + (funcall fun match)))))))))) + +(defun org-velocity-all-results (style search) + (with-current-buffer (org-velocity-bucket-buffer) + (save-excursion + (goto-char (point-min)) + (let (matches) + (org-velocity-search-with (lambda (match) + (push match matches)) + style + search) + (nreverse matches))))) + (defsubst org-velocity-present-match (hint match) - (with-current-buffer (org-velocity-match-staging-buffer) + (with-current-buffer (org-velocity-match-buffer) (when hint (insert "#" hint " ")) (org-velocity-buttonize match) (org-velocity-insert-preview match) (newline))) -(defun org-velocity-generic-search (search &optional hide-hints) - "Display any entry containing SEARCH." +(defun org-velocity-present-search (style search hide-hints) (let ((hints org-velocity-index) matches) (cl-block nil - (while (and hints (re-search-forward search nil t)) - (let ((match (org-velocity-nearest-heading (point)))) - (org-velocity-present-match - (unless hide-hints (car hints)) - match) - (push match matches)) - (setq hints (cdr hints)) - (unless (re-search-forward (org-velocity-heading-regexp) nil t) - (return)))) + (org-velocity-search-with (lambda (match) + (unless hints + (cl-return)) + (let ((hint (if hide-hints + nil + (car hints)))) + (org-velocity-present-match hint match)) + (pop hints) + (push match matches)) + style + search)) (nreverse matches))) -(cl-defun org-velocity-all-search (search &optional hide-hints) - "Display only entries containing every word in SEARCH." - (let ((keywords (mapcar 'regexp-quote (split-string search))) - (hints org-velocity-index) - matches) - (org-map-entries - (lambda () - ;; Return if we've run out of hints. - (when (null hints) - (return-from org-velocity-all-search (nreverse matches))) - ;; Only search the subtree once. - (setq org-map-continue-from - (save-excursion - (goto-char (line-end-position)) - (if (re-search-forward (org-velocity-heading-regexp) nil t) - (line-end-position) - (point-max)))) - (when (cl-loop for word in keywords - always (save-excursion - (re-search-forward - (concat "\\<" word "\\>") - org-map-continue-from t))) - (let ((match (org-velocity-nearest-heading (match-end 0)))) - (org-velocity-present-match - (unless hide-hints (car hints)) - match) - (push match matches) - (setq hints (cdr hints)))))) - (nreverse matches))) +(defun org-velocity-restrict-search () + (interactive) + (let ((search (org-velocity-nix-minibuffer))) + (when (equal search "") + (error "No search to restrict to")) + (push search org-velocity-recursive-search) + (setq org-velocity-recursive-headings + (org-velocity-all-results + org-velocity-search-method + search)) + ;; TODO We could extend the current search instead of starting + ;; over. + (org-velocity-update-match-header) + (minibuffer-message "Restricting search to %s" search))) + +(cl-defun org-velocity-update-match-header (&key (match-buffer (org-velocity-match-buffer)) + (bucket-buffer (org-velocity-bucket-buffer)) + (search-method org-velocity-search-method)) + (let ((navigating? org-velocity-navigating) + (recursive? org-velocity-recursive-search)) + (with-current-buffer match-buffer + (org-velocity-format-header-line + "%s search in %s%s (%s mode)" + (capitalize (symbol-name search-method)) + (abbreviate-file-name (buffer-file-name bucket-buffer)) + (if (not recursive?) + "" + (let ((sep " > ")) + (concat sep (string-join (reverse recursive?) sep)))) + (if navigating? "nav" "notes"))))) (cl-defun org-velocity-present (search &key hide-hints) "Buttonize matches for SEARCH in `org-velocity-match-buffer'. @@ -432,40 +510,49 @@ If HIDE-HINTS is non-nil, display entries without indices. SEARCH binds `org-velocity-search'. Return matches." - (if (and (stringp search) (not (string= "" search))) - ;; Fold case when the search string is all lowercase. - (let ((case-fold-search (equal search (downcase search))) - (truncate-partial-width-windows t)) - (with-current-buffer (org-velocity-match-buffer) - (erase-buffer) - ;; Permanent locals. - (setq cursor-type nil - truncate-lines t)) - (prog1 - (with-current-buffer (org-velocity-bucket-buffer) - (let ((inhibit-point-motion-hooks t) - (inhibit-field-text-motion t)) - (save-excursion - (org-velocity-beginning-of-headings) - (cl-case org-velocity-search-method - (all (org-velocity-all-search search hide-hints)) - (phrase (org-velocity-generic-search - (concat "\\<" (regexp-quote search)) - hide-hints)) - (any (org-velocity-generic-search - (concat "\\<" - (regexp-opt (split-string search))) - hide-hints)) - (regexp (condition-case lossage - (org-velocity-generic-search - search hide-hints) - (invalid-regexp - (minibuffer-message "%s" lossage)))))))) - (with-current-buffer (org-velocity-match-buffer) - (buffer-swap-text (org-velocity-match-staging-buffer)) - (goto-char (point-min))))) - (with-current-buffer (org-velocity-match-buffer) - (erase-buffer)))) + (let ((match-buffer (org-velocity-match-buffer)) + (bucket-buffer (org-velocity-bucket-buffer)) + (search-method org-velocity-search-method)) + (if (and (stringp search) (not (string= "" search))) + ;; Fold case when the search string is all lowercase. + (let ((case-fold-search (equal search (downcase search))) + (truncate-partial-width-windows t)) + (with-current-buffer match-buffer + (erase-buffer) + ;; Permanent locals. + (setq cursor-type nil + truncate-lines t) + (org-velocity-update-match-header + :match-buffer match-buffer + :bucket-buffer bucket-buffer + :search-method search-method)) + (prog1 + (with-current-buffer bucket-buffer + (widen) + (let* ((inhibit-point-motion-hooks t) + (inhibit-field-text-motion t) + (anchored? (string-match-p "^\\s-" search)) + (search + (cl-ecase search-method + (all search) + (phrase + (if anchored? + (regexp-quote search) + ;; Anchor the search to the start of a word. + (concat "\\<" (regexp-quote search)))) + (any + (concat "\\<" (regexp-opt (split-string search)))) + (regexp search)))) + (save-excursion + (org-velocity-beginning-of-headings) + (condition-case lossage + (org-velocity-present-search search-method search hide-hints) + (invalid-regexp + (minibuffer-message "%s" lossage)))))) + (with-current-buffer match-buffer + (goto-char (point-min))))) + (with-current-buffer match-buffer + (erase-buffer))))) (defun org-velocity-store-link () "Function for `org-store-link-functions'." @@ -603,7 +690,7 @@ If ASK is non-nil, ask first." (matches (org-velocity-present search :hide-hints t))) (cond ((null matches) (select-window (active-minibuffer-window)) - (unless (or (null search) (string= "" search)) + (unless (or (null search) (= (length search) 0)) (minibuffer-message "No match; RET to create"))) ((and (null (cdr matches)) org-velocity-exit-on-match) @@ -625,7 +712,10 @@ If ASK is non-nil, ask first." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-completion-map) (define-key map " " 'self-insert-command) + (define-key map "?" 'self-insert-command) (define-key map [remap minibuffer-complete] 'minibuffer-complete-word) + (define-key map [(control ?@)] 'org-velocity-restrict-search) + (define-key map [(control ?\s)] 'org-velocity-restrict-search) map) "Keymap for completion with `completing-read'.") @@ -635,30 +725,9 @@ If ASK is non-nil, ask first." org-velocity-local-completion-map) (completion-no-auto-exit t) (crm-separator " ")) - (funcall - (cl-case org-velocity-search-method - (phrase #'completing-read) - (any #'completing-read-multiple) - (all #'completing-read-multiple)) - prompt - (completion-table-dynamic - 'org-velocity-dabbrev-completion-list)))) - -(defun org-velocity-read-string (prompt &optional initial-input) - "Read string with PROMPT followed by INITIAL-INPUT." - ;; The use of initial inputs to the minibuffer is deprecated (see - ;; `read-from-minibuffer'), but in this case it is the user-friendly - ;; thing to do. - (minibuffer-with-setup-hook - (let ((initial-input initial-input)) - (lambda () - (and initial-input (insert initial-input)) - (goto-char (point-max)))) - (if (eq org-velocity-search-method 'regexp) - (read-regexp prompt) - (if org-velocity-use-completion - (org-velocity-read-with-completion prompt) - (read-string prompt))))) + (completing-read prompt + (completion-table-dynamic + 'org-velocity-dabbrev-completion-list)))) (cl-defun org-velocity-adjust-index (&optional (match-window (org-velocity-match-window))) @@ -719,18 +788,28 @@ then the current file is used instead, and vice versa." arg))) ;; complain if inappropriate (cl-assert (org-velocity-bucket-file)) - (let ((org-velocity-bucket-buffer - (find-file-noselect (org-velocity-bucket-file)))) + (let* ((starting-buffer (current-buffer)) + (org-velocity-bucket-buffer + (find-file-noselect (org-velocity-bucket-file))) + (org-velocity-navigating + (eq starting-buffer org-velocity-bucket-buffer)) + (org-velocity-recursive-headings '()) + (org-velocity-recursive-search '()) + (org-velocity-heading-level + (if org-velocity-navigating + 0 + org-velocity-heading-level)) + (dabbrev-search-these-buffers-only + (list org-velocity-bucket-buffer))) (unwind-protect - (let ((dabbrev-search-these-buffers-only - (list (org-velocity-bucket-buffer)))) - (funcall - (catch 'org-velocity-done - (org-velocity-engine - (if org-velocity-search-is-incremental - (org-velocity-incremental-read "Velocity search: ") - (org-velocity-read-string "Velocity search: " search))) - #'ignore))) + (let ((match + (catch 'org-velocity-done + (org-velocity-engine + (or search + (org-velocity-incremental-read "Velocity search: "))) + nil))) + (when (org-velocity-heading-p match) + (org-velocity-edit-entry match))) (kill-buffer (org-velocity-match-buffer)))))) (defalias 'org-velocity-read 'org-velocity) diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index 68f748c..18a268a 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -43,8 +43,11 @@ (eval-when-compile (require 'cl)) +(declare-function cider-current-connection "ext:cider-client" (&optional type)) +(declare-function cider-current-session "ext:cider-client" ()) (declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) -(declare-function nrepl-sync-request:eval "ext:nrepl-client" (input &optional ns session)) +(declare-function nrepl-sync-request:eval "ext:nrepl-client" + (input connection session &optional ns)) (declare-function slime-eval "ext:slime" (sexp &optional package)) (defvar org-babel-tangle-lang-exts) @@ -91,7 +94,8 @@ (let ((result-params (cdr (assoc :result-params params)))) (setq result (nrepl-dict-get - (nrepl-sync-request:eval expanded) + (nrepl-sync-request:eval + expanded (cider-current-connection) (cider-current-session)) (if (or (member "output" result-params) (member "pp" result-params)) "out" @@ -99,7 +103,7 @@ (slime (require 'slime) (with-temp-buffer - (insert expanded) + (insert expanded) (setq result (slime-eval `(swank:eval-and-grab-output diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 9545871..617ef69 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -37,7 +37,7 @@ (defvar org-babel-call-process-region-original nil) (defvar org-src-lang-modes) (defvar org-babel-library-of-babel) -(declare-function show-all "outline" ()) +(declare-function outline-show-all "outline" ()) (declare-function org-every "org" (pred seq)) (declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) @@ -1492,7 +1492,7 @@ specified in the properties of the current outline entry." ALTS is a cons of two character options where each option may be either the numeric code of a single character or a list of character alternatives. For example to split on balanced -instances of \"[ \t]:\" set ALTS to '((32 9) . 58)." +instances of \"[ \t]:\" set ALTS to ((32 9) . 58)." (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))) (matched (lambda (ch last) (if (consp alts) @@ -1597,11 +1597,14 @@ shown below. (cons :result-type (cond ((member "output" result-params) 'output) ((member "value" result-params) 'value) (t 'value)))) - (org-babel-get-header params :var 'other)))) + (org-remove-if + (lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params + :result-type :var))) + params)))) ;; row and column names (defun org-babel-del-hlines (table) - "Remove all `hlines' from TABLE." + "Remove all `hline's from TABLE." (remq 'hline table)) (defun org-babel-get-colnames (table) @@ -2551,7 +2554,8 @@ parameters when merging lists." (setq params (cons pair (assq-delete-all (car pair) params))))) (:exports (setq exports (funcall e-merge exports-exclusive-groups - exports (split-string (cdr pair))))) + exports + (split-string (or (cdr pair) ""))))) (:tangle ;; take the latest -- always overwrite (setq tangle (or (list (cdr pair)) tangle))) (:noweb diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 38086df..fdfbf5f 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -384,7 +384,7 @@ replaced with its value." (nth 1 info)))) (org-fill-template (if (eq type 'inline) - org-babel-exp-inline-code-template + org-babel-exp-inline-code-template org-babel-exp-code-template) `(("lang" . ,(nth 0 info)) ("body" . ,(org-escape-code-in-string (nth 1 info))) diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el index eba8423..f1d732c 100644 --- a/lisp/ob-lilypond.el +++ b/lisp/ob-lilypond.el @@ -265,7 +265,7 @@ LINE is the erroneous line" (setq case-fold-search nil) (if (search-forward line nil t) (progn - (show-all) + (outline-show-all) (set-mark (point)) (goto-char (- (point) (length line)))) (goto-char temp)))) diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el index 9cd72b3..2831fcc 100644 --- a/lisp/ob-ocaml.el +++ b/lisp/ob-ocaml.el @@ -83,9 +83,9 @@ (mapcar #'org-babel-trim (reverse raw))))))) (raw (org-babel-trim clean)) (result-params (cdr (assoc :result-params params))) - (parsed - (string-match - "\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$" + (parsed + (string-match + "\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$" raw)) (output (match-string 1 raw)) (type (match-string 3 raw)) diff --git a/lisp/ob-stan.el b/lisp/ob-stan.el new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/lisp/ob-stan.el diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index f822e3f..e9af695 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -1,6 +1,6 @@ ;;; ob-tangle.el --- extract source code from org-mode files -;; Copyright (C) 2009-2015 Free Software Foundation, Inc. +;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research @@ -39,9 +39,10 @@ (declare-function org-link-escape "org" (text &optional table)) (declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) (declare-function org-store-link "org" (arg)) -(declare-function org-up-heading-safe "org" ()) (declare-function outline-previous-heading "outline" ()) +(defvar org-link-types-re) + (defcustom org-babel-tangle-lang-exts '(("emacs-lisp" . "el") ("elisp" . "el")) @@ -179,12 +180,14 @@ Return a list whose CAR is the tangled file name." (save-window-excursion (find-file file) (setq to-be-removed (current-buffer)) - (org-babel-tangle nil target-file lang)) + (mapcar #'expand-file-name (org-babel-tangle nil target-file lang))) (unless visited-p (kill-buffer to-be-removed))))) (defun org-babel-tangle-publish (_ filename pub-dir) "Tangle FILENAME and place the results in PUB-DIR." + (unless (file-exists-p pub-dir) + (make-directory pub-dir t)) (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) ;;;###autoload @@ -334,23 +337,25 @@ that the appropriate major-mode is set. SPEC has the form: (start-line file link source-name params body comment)" (let* ((start-line (nth 0 spec)) + (info (nth 4 spec)) (file (if org-babel-tangle-use-relative-file-links (file-relative-name (nth 1 spec)) (nth 1 spec))) (link (let ((link (nth 2 spec))) (if org-babel-tangle-use-relative-file-links - (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link) - (let* ((type (match-string 1 link)) - (path (match-string 2 link)) - (origpath path) - (case-fold-search nil)) - (setq path (file-relative-name path)) - (concat type path))) + (when (string-match org-link-types-re link) + (let ((type (match-string 0 link)) + (link (substring link (match-end 0)))) + (concat + type + (file-relative-name + link + (file-name-directory (cdr (assq :tangle info))))))) link))) (source-name (nth 3 spec)) (body (nth 5 spec)) (comment (nth 6 spec)) - (comments (cdr (assoc :comments (nth 4 spec)))) + (comments (cdr (assq :comments info))) (link-p (or (string= comments "both") (string= comments "link") (string= comments "yes") (string= comments "noweb"))) (link-data (mapcar (lambda (el) @@ -401,14 +406,14 @@ can be used to limit the collected code blocks by target file." (let ((current-heading-pos (org-with-wide-buffer (org-with-limited-levels (outline-previous-heading))))) - (cond ((eq last-heading-pos current-heading-pos) (incf counter)) - ((= counter 1)) - (t (setq counter 1)))) + (if (eq last-heading-pos current-heading-pos) (incf counter) + (setq counter 1) + (setq last-heading-pos current-heading-pos))) (unless (org-in-commented-heading-p) (let* ((info (org-babel-get-src-block-info 'light)) (src-lang (nth 0 info)) (src-tfile (cdr (assq :tangle (nth 2 info))))) - (unless (or (string= (cdr (assq :tangle (nth 2 info))) "no") + (unless (or (string= src-tfile "no") (and tangle-file (not (equal tangle-file src-tfile))) (and language (not (string= language src-lang)))) ;; Add the spec for this block to blocks under its diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 0725d9e..96e15d5 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -3349,7 +3349,7 @@ the agenda to write." (rename-buffer org-agenda-write-buffer-name t) (set-buffer-modified-p nil) (insert bs) - (org-agenda-remove-marked-text 'org-filtered) + (org-agenda-remove-marked-text 'invisible 'org-filtered) (run-hooks 'org-agenda-before-write-hook) (cond ((org-bound-and-true-p org-mobile-creating-agendas) @@ -7232,8 +7232,8 @@ agenda." (defun org-agenda--quit (&optional bury) (if org-agenda-columns-active (org-columns-quit) - (let ((buf (current-buffer)) - (wconf org-agenda-pre-window-conf) + (let ((wconf org-agenda-pre-window-conf) + (buf (current-buffer)) (org-agenda-last-indirect-window (and (eq org-indirect-buffer-display 'other-window) org-agenda-last-indirect-buffer @@ -7255,7 +7255,11 @@ agenda." (not (one-window-p)) (delete-window)))) (if bury - (bury-buffer buf) + ;; Set the agenda buffer as the current buffer instead of + ;; passing it as an argument to `bury-buffer' so that + ;; `bury-buffer' removes it from the window. + (with-current-buffer buf + (bury-buffer)) (kill-buffer buf) (setq org-agenda-archives-mode nil org-agenda-buffer nil))))) @@ -8408,7 +8412,7 @@ When called with a prefix argument, include all archive files as well." (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (when (outline-invisible-p) - (show-entry)) ; display invisible text + (outline-show-entry)) ; display invisible text (recenter (/ (window-height) 2)) (org-back-to-heading t) (if (re-search-forward org-complex-heading-regexp nil t) @@ -8665,7 +8669,7 @@ folded." (select-window org-agenda-show-window) (ignore-errors (scroll-up))) (org-agenda-goto t) - (if arg (org-show-entry) (show-subtree)) + (if arg (org-show-entry) (outline-show-subtree)) (setq org-agenda-show-window (selected-window))) (select-window win))) @@ -8697,7 +8701,7 @@ if it was hidden in the outline." (set-window-start (selected-window) (point-at-bol)) (cond ((= more 0) - (hide-subtree) + (outline-hide-subtree) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'folded)) @@ -8705,26 +8709,26 @@ if it was hidden in the outline." ((and (org-called-interactively-p 'any) (= more 1)) (message "Remote: show with default settings")) ((= more 2) - (show-entry) - (show-children) + (outline-show-entry) + (outline-show-children) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'children)) (message "Remote: CHILDREN")) ((= more 3) - (show-subtree) + (outline-show-subtree) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'subtree)) (message "Remote: SUBTREE")) ((= more 4) - (show-subtree) + (outline-show-subtree) (save-excursion (org-back-to-heading) (org-cycle-hide-drawers 'subtree '("LOGBOOK"))) (message "Remote: SUBTREE AND LOGBOOK")) ((> more 4) - (show-subtree) + (outline-show-subtree) (message "Remote: SUBTREE AND ALL DRAWERS"))) (select-window win))) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 2919fda..170bfd7 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -317,7 +317,7 @@ this heading." org-odd-levels-only tr-org-odd-levels-only))) (goto-char (point-min)) - (show-all) + (outline-show-all) (if (and heading (not (and datetree-date (not datetree-subheading-p)))) (progn (if (re-search-forward @@ -332,7 +332,7 @@ this heading." (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) ;; Make the subtree visible - (show-subtree) + (outline-show-subtree) (if org-archive-reversed-order (progn (org-back-to-heading t) @@ -454,7 +454,7 @@ sibling does not exist, it will be created at the end of the subtree." (format-time-string (substring (cdr org-time-stamp-formats) 1 -1))) (outline-up-heading 1 t) - (hide-subtree) + (outline-hide-subtree) (org-cycle-show-empty-lines 'folded) (goto-char pos))) (org-reveal) @@ -565,7 +565,7 @@ the children that do not contain any open TODO items." (save-excursion (org-back-to-heading t) (setq set (org-toggle-tag org-archive-tag)) - (when set (hide-subtree))) + (when set (outline-hide-subtree))) (and set (beginning-of-line 1)) (message "Subtree %s" (if set "archived" "unarchived")))))) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 67dc319..58b578b 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -792,7 +792,10 @@ already gone. Any prefix argument will be passed to the refile command." "Refiling from a capture buffer makes only sense for `entry'-type templates")) (let ((pos (point)) (base (buffer-base-buffer (current-buffer))) - (org-refile-for-capture t)) + (org-refile-for-capture t) + (kill-buffer (org-capture-get :kill-buffer 'local))) + (org-capture-put :kill-buffer nil) + (org-capture-finalize) (save-window-excursion (with-current-buffer (or base (current-buffer)) (save-excursion @@ -800,7 +803,7 @@ already gone. Any prefix argument will be passed to the refile command." (widen) (goto-char pos) (call-interactively 'org-refile))))) - (org-capture-finalize))) + (when kill-buffer (kill-buffer base)))) (defun org-capture-kill () "Abort the current capture process." @@ -1006,7 +1009,7 @@ may have been stored before." (org-switch-to-buffer-other-window (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) (widen) - (show-all) + (outline-show-all) (goto-char (org-capture-get :pos)) (org-set-local 'org-capture-target-marker (point-marker)) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 84d032c..f6ca89d 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1457,7 +1457,7 @@ When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock line and position cursor in that line." (org-back-to-heading t) (catch 'exit - (let* ((beg (line-beginning-position 2)) + (let* ((beg (line-beginning-position)) (end (save-excursion (outline-next-heading) (point))) (org-clock-into-drawer (org-clock-into-drawer)) (drawer (org-clock-drawer-name))) @@ -1499,10 +1499,7 @@ line and position cursor in that line." (cond ((null positions) ;; Skip planning line and property drawer, if any. - (when (org-looking-at-p org-planning-line-re) (forward-line)) - (when (looking-at org-property-drawer-re) - (goto-char (match-end 0)) - (forward-line)) + (org-end-of-meta-data) (unless (bolp) (insert "\n")) ;; Create a new drawer if necessary. (when (and org-clock-into-drawer @@ -1515,15 +1512,13 @@ line and position cursor in that line." (org-flag-drawer t) (forward-line)))) ;; When a clock drawer needs to be created because of the - ;; number of clock items, collect all clocks in the section - ;; and wrap them within the drawer. - ((and (wholenump org-clock-into-drawer) - (>= (1+ count) org-clock-into-drawer)) + ;; number of clock items or simply if it is missing, collect + ;; all clocks in the section and wrap them within the drawer. + ((or drawer + (and (wholenump org-clock-into-drawer) + (>= (1+ count) org-clock-into-drawer))) ;; Skip planning line and property drawer, if any. - (when (org-looking-at-p org-planning-line-re) (forward-line)) - (when (looking-at org-property-drawer-re) - (goto-char (match-end 0)) - (forward-line)) + (org-end-of-meta-data) (let ((beg (point))) (insert (mapconcat @@ -1900,10 +1895,14 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (defun org-clock-display (&optional arg) "Show subtree times in the entire buffer. -With one universal prefix argument, show the total time for -today. With two universal prefix arguments, show the total time -for a custom range, entered at the prompt. With three universal -prefix arguments, show the total time in the echo area. +By default, show the total time for the range defined in +`org-clock-display-default-range'. With \\[universal-argument] \ +prefix, show +the total time for today instead. With \\[universal-argument] \ +\\[universal-argument] prefix, use +a custom range, entered at the prompt. With \\[universal-argument] \ +\\[universal-argument] \\[universal-argument] +prefix, display the total time in the echo area. Use \\[org-clock-remove-overlays] to remove the subtree times." (interactive "P") @@ -2179,11 +2178,11 @@ have priority." key 'week))) ((string-match "\\`\\([0-9]+\\)-[qQ]\\([1-4]\\)\\'" skey) (require 'cal-iso) + (setq q (string-to-number (match-string 2 skey))) (let ((date (calendar-gregorian-from-absolute (calendar-iso-to-absolute (org-quarter-to-date - (string-to-number (match-string 2 skey)) - (string-to-number (match-string 1 skey))))))) + q (string-to-number (match-string 1 skey))))))) (setq d (nth 1 date) month (car date) y (nth 2 date) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 3838531..359c46a 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -548,7 +548,7 @@ Where possible, use the standard interface for changing this line." (condition-case nil (org-no-warnings (next-line 1)) (error nil)) (setq hidep (org-at-heading-p 1))) (eval form) - (and hidep (hide-entry)))) + (and hidep (outline-hide-entry)))) (defun org-columns-previous-allowed-value () "Switch to the previous allowed value for this column." @@ -1193,47 +1193,41 @@ This function updates `org-columns-current-fmt-compiled'." ;;; Dynamic block for Column view -(defvar org-heading-regexp) ; defined in org.el -(defvar org-heading-keyword-regexp-format) ; defined in org.el (defun org-columns-capture-view (&optional maxlevel skip-empty-rows) "Get the column view of the current buffer or subtree. -The first optional argument MAXLEVEL sets the level limit. A -second optional argument SKIP-EMPTY-ROWS tells whether to skip +The first optional argument MAXLEVEL sets the level limit. +A second optional argument SKIP-EMPTY-ROWS tells whether to skip empty rows, an empty row being one where all the column view -specifiers except ITEM are empty. This function returns a list +specifiers but ITEM are empty. This function returns a list containing the title row and all other rows. Each row is a list of fields." (save-excursion - (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) - (re-archive (concat ".*:" org-archive-tag ":")) - (n (length title)) row tbl) + (let* ((title (mapcar #'cadr org-columns-current-fmt-compiled)) + (has-item? (member "ITEM" title)) + (n (length title)) + tbl) (goto-char (point-min)) - (while (re-search-forward org-heading-regexp nil t) + (while (re-search-forward org-outline-regexp-bol nil t) (catch 'next (when (and (or (null maxlevel) - (>= maxlevel - (if org-odd-levels-only - (/ (1+ (length (match-string 1))) 2) - (length (match-string 1))))) + (>= maxlevel (org-reduced-level (org-outline-level)))) (get-char-property (match-beginning 0) 'org-columns-key)) (when (or (org-in-commented-heading-p t) - (save-excursion - (beginning-of-line) - (looking-at re-archive))) + (member org-archive-tag (org-get-tags))) (org-end-of-subtree t) (throw 'next t)) - (setq row nil) - (loop for i from 0 to (1- n) do - (push - (org-quote-vert - (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified) - (get-char-property (+ (match-beginning 0) i) 'org-columns-value) - "")) - row)) - (setq row (nreverse row)) - (unless (and skip-empty-rows - (eq 1 (length (delete "" (delete-dups (copy-sequence row)))))) - (push row tbl))))) + (let (row) + (dotimes (i n) + (let ((col (+ (line-beginning-position) i))) + (push (org-quote-vert + (or (get-char-property col 'org-columns-value-modified) + (get-char-property col 'org-columns-value) + "")) + row))) + (unless (and skip-empty-rows + (let ((r (delete-dups (remove "" row)))) + (or (null r) (and has-item? (= (length r) 1))))) + (push (nreverse row) tbl)))))) (append (list title 'hline) (nreverse tbl))))) ;;;###autoload diff --git a/lisp/org-compat.el b/lisp/org-compat.el index d4dcdff..e7518d8 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -539,6 +539,18 @@ Implements `file-equal-p' for older emacsen and XEmacs." (buffer-narrowed-p) (/= (- (point-max) (point-min)) (buffer-size)))) +;; As of Emacs 25.1, `outline-mode` functions are under the 'outline-' +;; prefix. +(when (< emacs-major-version 25) + (defalias 'outline-show-all 'show-all) + (defalias 'outline-hide-subtree 'hide-subtree) + (defalias 'outline-show-subtree 'show-subtree) + (defalias 'outline-show-branches 'show-branches) + (defalias 'outline-show-children 'show-children) + (defalias 'outline-show-entry 'show-entry) + (defalias 'outline-hide-entry 'hide-entry) + (defalias 'outline-hide-sublevels 'hide-sublevels)) + (defmacro org-with-silent-modifications (&rest body) (if (fboundp 'with-silent-modifications) `(with-silent-modifications ,@body) diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index 59804a5..abe9f3c 100644 --- a/lisp/org-crypt.el +++ b/lisp/org-crypt.el @@ -191,7 +191,7 @@ See `org-crypt-disable-auto-save'." (insert encrypted-text) (when folded (goto-char start-heading) - (hide-subtree)) + (outline-hide-subtree)) nil))))) (defun org-decrypt-entry () diff --git a/lisp/org-element.el b/lisp/org-element.el index 1fbedd1..911e4e1 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4183,6 +4183,7 @@ otherwise. Modes can be either `first-section', `item', (if parentp (case type (headline 'section) + (inlinetask 'planning) (plain-list 'item) (property-drawer 'node-property) (section 'planning) diff --git a/lisp/org-feed.el b/lisp/org-feed.el index 6990e75..f637bfd 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -406,8 +406,8 @@ it can be a list structured like an entry in `org-feed-alist'." ;; Normalize the visibility of the inbox tree (goto-char inbox-pos) - (hide-subtree) - (show-children) + (outline-hide-subtree) + (outline-show-children) (org-cycle-hide-drawers 'children) ;; Hooks and messages @@ -604,6 +604,7 @@ Assumes headers are indeed present!" "Parse BUFFER for RSS feed entries. Returns a list of entries, with each entry a property list, containing the properties `:guid' and `:item-full-text'." + (require 'xml) (let ((case-fold-search t) entries beg end item guid entry) (with-current-buffer buffer @@ -615,7 +616,7 @@ containing the properties `:guid' and `:item-full-text'." (match-beginning 0))) (setq item (buffer-substring beg end) guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item) - (org-match-string-no-properties 1 item))) + (xml-substitute-special (org-match-string-no-properties 1 item)))) (setq entry (list :guid guid :item-full-text item)) (push entry entries) (widen) diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index 10e95ee..7fd55d9 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -533,7 +533,7 @@ or new, let the user edit the definition of the footnote." (label (org-footnote-normalize-label (if (eq org-footnote-auto-label 'random) - (format "fn:%x" (random #x100000000)) + (format "fn:%x" (random most-positive-fixnum)) (let ((propose (org-footnote-unique-label all))) (if (memq org-footnote-auto-label '(t plain)) propose (org-icompleting-read diff --git a/lisp/org-indent.el b/lisp/org-indent.el index 197042d..83c5aac 100644 --- a/lisp/org-indent.el +++ b/lisp/org-indent.el @@ -1,5 +1,5 @@ ;;; org-indent.el --- Dynamic indentation for Org-mode -;; Copyright (C) 2009-2015 Free Software Foundation, Inc. +;; Copyright (C) 2009-2016 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -342,11 +342,12 @@ Flag will be non-nil if command is going to modify or delete an headline." (when org-indent-mode (setq org-indent-modified-headline-flag - (save-excursion - (goto-char beg) - (save-match-data - (or (and (org-at-heading-p) (< beg (match-end 0))) - (re-search-forward org-outline-regexp-bol end t))))))) + (org-with-wide-buffer + (goto-char beg) + (save-match-data + (or (and (org-at-heading-p) (< beg (match-end 0))) + (re-search-forward + (org-with-limited-levels org-outline-regexp-bol) end t))))))) (defun org-indent-refresh-maybe (beg end dummy) "Refresh indentation properties in an adequate portion of buffer. @@ -358,19 +359,21 @@ This function is meant to be called by `after-change-functions'." (save-match-data ;; If a headline was modified or inserted, set properties until ;; next headline. - (if (or org-indent-modified-headline-flag - (save-excursion - (goto-char beg) - (beginning-of-line) - (re-search-forward org-outline-regexp-bol end t))) - (let ((end (save-excursion - (goto-char end) - (org-with-limited-levels (outline-next-heading)) - (point)))) - (setq org-indent-modified-headline-flag nil) - (org-indent-add-properties beg end)) - ;; Otherwise, only set properties on modified area. - (org-indent-add-properties beg end))))) + (org-with-wide-buffer + (if (or org-indent-modified-headline-flag + (save-excursion + (goto-char beg) + (beginning-of-line) + (re-search-forward + (org-with-limited-levels org-outline-regexp-bol) end t))) + (let ((end (save-excursion + (goto-char end) + (org-with-limited-levels (outline-next-heading)) + (point)))) + (setq org-indent-modified-headline-flag nil) + (org-indent-add-properties beg end)) + ;; Otherwise, only set properties on modified area. + (org-indent-add-properties beg end)))))) (provide 'org-indent) diff --git a/lisp/org-lint.el b/lisp/org-lint.el new file mode 100644 index 0000000..37d05ed --- /dev/null +++ b/lisp/org-lint.el @@ -0,0 +1,1151 @@ +;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation + +;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr> +;; Keywords: outlines, hypermedia, calendar, wp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements linting for Org syntax. The sole public +;; function is `org-lint', which see. + +;; Internally, the library defines a new structure: +;; `org-lint-checker', with the following slots: + +;; - NAME: Unique check identifier, as a non-nil symbol that doesn't +;; start with an hyphen. +;; +;; The check is done calling the function `org-lint-NAME' with one +;; mandatory argument, the parse tree describing the current Org +;; buffer. Such function calls are wrapped within +;; a `save-excursion' and point is always at `point-min'. Its +;; return value has to be an alist (POSITION MESSAGE) when +;; POSITION refer to the buffer position of the error, as an +;; integer, and MESSAGE is a string describing the error. + +;; - DESCRIPTION: Summary about the check, as a string. + +;; - CATEGORIES: Categories relative to the check, as a list of +;; symbol. They are used for filtering when calling `org-lint'. +;; Checkers not explicitly associated to a category are collected +;; in the `default' one. + +;; - TRUST: The trust level one can have in the check. It is either +;; `low' or `high', depending on the heuristics implemented and +;; the nature of the check. This has an indicative value only and +;; is displayed along reports. + +;; All checks have to be listed in `org-lint--checkers'. + +;; Results are displayed in a special "*Org Lint*" buffer with +;; a dedicated major mode, derived from `tabulated-list-mode'. +;; +;; In addition to the usual key-bindings inherited from it, "C-j" and +;; "TAB" display problematic line reported under point whereas "RET" +;; jumps to it. Also, "h" hides all reports similar to the current +;; one. Additionally, "i" removes them from subsequent reports. + +;; Checks currently implemented are: + +;; - duplicate CUSTOM_ID properties +;; - duplicate NAME values +;; - duplicate targets +;; - duplicate footnote definitions +;; - orphaned affiliated keywords +;; - obsolete affiliated keywords +;; - missing language in src blocks +;; - invalid Babel call blocks +;; - NAME values with a colon +;; - deprecated Babel header properties +;; - wrong header arguments in src blocks +;; - misuse of CATEGORY keyword +;; - "coderef" links with unknown destination +;; - "custom-id" links with unknown destination +;; - "fuzzy" links with unknown destination +;; - "id" links with unknown destination +;; - links to non-existent local files +;; - SETUPFILE keywords with non-existent file parameter +;; - INCLUDE keywords with wrong link parameter +;; - unknown items in OPTIONS keyword +;; - spurious macro arguments or invalid macro templates +;; - special properties in properties drawer +;; - obsolete syntax for PROPERTIES drawers +;; - missing definition for footnote references +;; - missing reference for footnote definitions +;; - non-footnote definitions in footnote section +;; - probable invalid keywords +;; - invalid blocks +;; - misplaced planning info line +;; - incomplete drawers +;; - indented diary-sexps +;; - obsolete QUOTE section + + +;;; Code: + +(require 'cl-lib) +(require 'org-element) +(require 'org-macro) +(require 'ox) +(require 'ob) + + +;;; Checkers + +(cl-defstruct (org-lint-checker (:copier nil)) + (name 'missing-checker-name) + (description "") + (categories '(default)) + (trust 'high)) ; `low' or `high' + +(defun org-lint-missing-checker-name (_) + (error + "`A checker has no `:name' property. Please verify `org-lint--checkers'")) + +(defconst org-lint--checkers + (list + (make-org-lint-checker + :name 'duplicate-custom-id + :description "Report duplicates CUSTOM_ID properties" + :categories '(link)) + (make-org-lint-checker + :name 'duplicate-name + :description "Report duplicate NAME values" + :categories '(babel link)) + (make-org-lint-checker + :name 'duplicate-target + :description "Report duplicate targets" + :categories '(link)) + (make-org-lint-checker + :name 'duplicate-footnote-definition + :description "Report duplicate footnote definitions" + :categories '(footnote)) + (make-org-lint-checker + :name 'orphaned-affiliated-keywords + :description "Report orphaned affiliated keywords" + :trust 'low) + (make-org-lint-checker + :name 'obsolete-affiliated-keywords + :description "Report obsolete affiliated keywords" + :categories '(obsolete)) + (make-org-lint-checker + :name 'deprecated-header-syntax + :description "Report deprecated Babel header syntax" + :categories '(babel obsolete) + :trust 'low) + (make-org-lint-checker + :name 'missing-language-in-src-block + :description "Report missing language in src blocks" + :categories '(babel)) + (make-org-lint-checker + :name 'invalid-babel-call-block + :description "Report invalid Babel call blocks" + :categories '(babel)) + (make-org-lint-checker + :name 'colon-in-name + :description "Report NAME values with a colon" + :categories '(babel)) + (make-org-lint-checker + :name 'wrong-header-argument + :description "Report wrong babel headers" + :categories '(babel)) + (make-org-lint-checker + :name 'wrong-header-value + :description "Report invalid value in babel headers" + :categories '(babel) + :trust 'low) + (make-org-lint-checker + :name 'deprecated-category-setup + :description "Report misuse of CATEGORY keyword" + :categories '(obsolete)) + (make-org-lint-checker + :name 'invalid-coderef-link + :description "Report \"coderef\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'invalid-custom-id-link + :description "Report \"custom-id\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'invalid-fuzzy-link + :description "Report \"fuzzy\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'invalid-id-link + :description "Report \"id\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'link-to-local-file + :description "Report links to non-existent local files" + :categories '(link) + :trust 'low) + (make-org-lint-checker + :name 'non-existent-setupfile-parameter + :description "Report SETUPFILE keywords with non-existent file parameter" + :trust 'low) + (make-org-lint-checker + :name 'wrong-include-link-parameter + :description "Report INCLUDE keywords with misleading link parameter" + :categories '(export) + :trust 'low) + (make-org-lint-checker + :name 'unknown-options-item + :description "Report unknown items in OPTIONS keyword" + :categories '(export) + :trust 'low) + (make-org-lint-checker + :name 'invalid-macro-argument-and-template + :description "Report spurious macro arguments or invalid macro templates" + :categories '(export) + :trust 'low) + (make-org-lint-checker + :name 'special-property-in-properties-drawer + :description "Report special properties in properties drawers" + :categories '(properties)) + (make-org-lint-checker + :name 'obsolete-properties-drawer + :description "Report obsolete syntax for properties drawers" + :categories '(obsolete properties)) + (make-org-lint-checker + :name 'undefined-footnote-reference + :description "Report missing definition for footnote references" + :categories '(footnote)) + (make-org-lint-checker + :name 'unreferenced-footnote-definition + :description "Report missing reference for footnote definitions" + :categories '(footnote)) + (make-org-lint-checker + :name 'extraneous-element-in-footnote-section + :description "Report non-footnote definitions in footnote section" + :categories '(footnote)) + (make-org-lint-checker + :name 'invalid-keyword-syntax + :description "Report probable invalid keywords" + :trust 'low) + (make-org-lint-checker + :name 'invalid-block + :description "Report invalid blocks" + :trust 'low) + (make-org-lint-checker + :name 'misplaced-planning-info + :description "Report misplaced planning info line" + :trust 'low) + (make-org-lint-checker + :name 'incomplete-drawer + :description "Report probable incomplete drawers" + :trust 'low) + (make-org-lint-checker + :name 'indented-diary-sexp + :description "Report probable indented diary-sexps" + :trust 'low) + (make-org-lint-checker + :name 'quote-section + :description "Report obsolete QUOTE section" + :categories '(obsolete) + :trust 'low)) + "List of all available checkers.") + +(defun org-lint--collect-duplicates + (ast type extract-key extract-position build-message) + "Helper function to collect duplicates in parse tree AST. + +EXTRACT-KEY is a function extracting key. It is called with +a single argument: the element or object. Comparison is done +with `equal'. + +EXTRACT-POSITION is a function returning position for the report. +It is called with two arguments, the object or element, and the +key. + +BUILD-MESSAGE is a function creating the report message. It is +called with one argument, the key used for comparison." + (let* (keys + originals + reports + (make-report + (lambda (position value) + (push (list position (funcall build-message value)) reports)))) + (org-element-map ast type + (lambda (datum) + (let ((key (funcall extract-key datum))) + (cond + ((not key)) + ((assoc key keys) (cl-pushnew (assoc key keys) originals) + (funcall make-report (funcall extract-position datum key) key)) + (t (push (cons key (funcall extract-position datum key)) keys)))))) + (dolist (e originals reports) (funcall make-report (cdr e) (car e))))) + +(defun org-lint-duplicate-custom-id (ast) + (org-lint--collect-duplicates + ast + 'node-property + (lambda (property) + (and (eq (compare-strings "CUSTOM_ID" nil nil + (org-element-property :key property) nil nil + t) + t) + (org-element-property :value property))) + (lambda (property _) (org-element-property :begin property)) + (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key)))) + +(defun org-lint-duplicate-name (ast) + (org-lint--collect-duplicates + ast + org-element-all-elements + (lambda (datum) (org-element-property :name datum)) + (lambda (datum name) + (goto-char (org-element-property :begin datum)) + (re-search-forward + (format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name))) + (match-beginning 0)) + (lambda (key) (format "Duplicate NAME \"%s\"" key)))) + +(defun org-lint-duplicate-target (ast) + (org-lint--collect-duplicates + ast + 'target + (lambda (target) (org-split-string (org-element-property :value target))) + (lambda (target _) (org-element-property :begin target)) + (lambda (key) + (format "Duplicate target <<%s>>" (mapconcat #'identity key " "))))) + +(defun org-lint-duplicate-footnote-definition (ast) + (org-lint--collect-duplicates + ast + 'footnote-definition + (lambda (definition) (org-element-property :label definition)) + (lambda (definition _) (org-element-property :post-affiliated definition)) + (lambda (key) (format "Duplicate footnote definition \"%s\"" key)))) + +(defun org-lint-orphaned-affiliated-keywords (ast) + ;; Ignore orphan RESULTS keywords, which could be generated from + ;; a source block returning no value. + (let ((keywords (cl-set-difference org-element-affiliated-keywords + '("RESULT" "RESULTS") + :test #'equal))) + (org-element-map ast 'keyword + (lambda (k) + (let ((key (org-element-property :key k))) + (and (or (let ((case-fold-search t)) + (org-string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key)) + (member key keywords)) + (list (org-element-property :post-affiliated k) + (format "Orphaned affiliated keyword: \"%s\"" key)))))))) + +(defun org-lint-obsolete-affiliated-keywords (_) + (let ((regexp (format "^[ \t]*#\\+%s:" + (regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE" + "SRCNAME" "TBLNAME" "RESULT" "HEADERS") + t))) + reports) + (while (re-search-forward regexp nil t) + (let ((key (upcase (org-match-string-no-properties 1)))) + (when (< (point) + (org-element-property :post-affiliated (org-element-at-point))) + (push + (list (line-beginning-position) + (format + "Obsolete affiliated keyword: \"%s\". Use \"%s\" instead" + key + (pcase key + ("HEADERS" "HEADER") + ("RESULT" "RESULTS") + (_ "NAME")))) + reports)))) + reports)) + +(defun org-lint-deprecated-header-syntax (ast) + (let* ((deprecated-babel-properties + (mapcar (lambda (arg) (symbol-name (car arg))) + org-babel-common-header-args-w-values)) + (deprecated-re + (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t)))) + (org-element-map ast '(keyword node-property) + (lambda (datum) + (let ((key (org-element-property :key datum))) + (pcase (org-element-type datum) + (`keyword + (let ((value (org-element-property :value datum))) + (and (string= key "PROPERTY") + (string-match deprecated-re value) + (list (org-element-property :begin datum) + (format "Deprecated syntax for \"%s\". \ +Use header-args instead" + (org-match-string-no-properties 1 value)))))) + (`node-property + (and (member-ignore-case key deprecated-babel-properties) + (list + (org-element-property :begin datum) + (format "Deprecated syntax for \"%s\". \ +Use :header-args: instead" + key)))))))))) + +(defun org-lint-missing-language-in-src-block (ast) + (org-element-map ast 'src-block + (lambda (b) + (unless (org-element-property :language b) + (list (org-element-property :post-affiliated b) + "Missing language in source block"))))) + +(defun org-lint-invalid-babel-call-block (ast) + (org-element-map ast 'babel-call + (lambda (b) + (cond + ((not (org-element-property :call b)) + (list (org-element-property :post-affiliated b) + "Invalid syntax in babel call block")) + ((let ((h (org-element-property :end-header b))) + (and h (org-string-match-p "\\`\\[.*\\]\\'" h))) + (list + (org-element-property :post-affiliated b) + "Babel call's end header must not be wrapped within brackets")))))) + +(defun org-lint-deprecated-category-setup (ast) + (org-element-map ast 'keyword + (let (category-flag) + (lambda (k) + (cond + ((not (string= (org-element-property :key k) "CATEGORY")) nil) + (category-flag + (list (org-element-property :post-affiliated k) + "Spurious CATEGORY keyword. Set :CATEGORY: property instead")) + (t (setf category-flag t) nil)))))) + +(defun org-lint-invalid-coderef-link (ast) + (let ((info (list :parse-tree ast))) + (org-element-map ast 'link + (lambda (link) + (let ((ref (org-element-property :path link))) + (and (equal (org-element-property :type link) "coderef") + (not (ignore-errors (org-export-resolve-coderef ref info))) + (list (org-element-property :begin link) + (format "Unknown coderef \"%s\"" ref)))))))) + +(defun org-lint-invalid-custom-id-link (ast) + (let ((info (list :parse-tree ast))) + (org-element-map ast 'link + (lambda (link) + (and (equal (org-element-property :type link) "custom-id") + (not (ignore-errors (org-export-resolve-id-link link info))) + (list (org-element-property :begin link) + (format "Unknown custom ID \"%s\"" + (org-element-property :path link)))))))) + +(defun org-lint-invalid-fuzzy-link (ast) + (let ((info (list :parse-tree ast))) + (org-element-map ast 'link + (lambda (link) + (and (equal (org-element-property :type link) "fuzzy") + (not (ignore-errors (org-export-resolve-fuzzy-link link info))) + (list (org-element-property :begin link) + (format "Unknown fuzzy location \"%s\"" + (let ((path (org-element-property :path link))) + (if (string-prefix-p "*" path) + (substring path 1) + path))))))))) + +(defun org-lint-invalid-id-link (ast) + (org-element-map ast 'link + (lambda (link) + (let ((id (org-element-property :path link))) + (and (equal (org-element-property :type link) "id") + (not (org-id-find id)) + (list (org-element-property :begin link) + (format "Unknown ID \"%s\"" id))))))) + +(defun org-lint-special-property-in-properties-drawer (ast) + (org-element-map ast 'node-property + (lambda (p) + (let ((key (org-element-property :key p))) + (and (member-ignore-case key org-special-properties) + (list (org-element-property :begin p) + (format + "Special property \"%s\" found in a properties drawer" + key))))))) + +(defun org-lint-obsolete-properties-drawer (ast) + (org-element-map ast 'drawer + (lambda (d) + (when (equal (org-element-property :drawer-name d) "PROPERTIES") + (let ((section (org-element-lineage d '(section)))) + (unless (org-element-map section 'property-drawer #'identity nil t) + (list (org-element-property :post-affiliated d) + (if (save-excursion + (goto-char (org-element-property :post-affiliated d)) + (forward-line -1) + (or (org-at-heading-p) (org-at-planning-p))) + "Incorrect contents for PROPERTIES drawer" + "Incorrect location for PROPERTIES drawer")))))))) + +(defun org-lint-link-to-local-file (ast) + (org-element-map ast 'link + (lambda (l) + (when (equal (org-element-property :type l) "file") + (let ((file (org-link-unescape (org-element-property :path l)))) + (and (not (file-remote-p file)) + (not (file-exists-p file)) + (list (org-element-property :begin l) + (format (if (org-element-lineage l '(link)) + "Link to non-existent image file \"%s\"\ + in link description" + "Link to non-existent local file \"%s\"") + file)))))))) + +(defun org-lint-non-existent-setupfile-parameter (ast) + (org-element-map ast 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "SETUPFILE") + (let ((file (org-remove-double-quotes + (org-element-property :value k)))) + (and (not (file-remote-p file)) + (not (file-exists-p file)) + (list (org-element-property :begin k) + (format "Non-existent setup file \"%s\"" file)))))))) + +(defun org-lint-wrong-include-link-parameter (ast) + (org-element-map ast 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "INCLUDE") + (let* ((value (org-element-property :value k)) + (path + (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value) + (save-match-data + (org-remove-double-quotes (match-string 1 value)))))) + (if (not path) + (list (org-element-property :post-affiliated k) + "Missing location argument in INCLUDE keyword") + (let* ((file (org-string-nw-p + (if (string-match "::\\(.*\\)\\'" path) + (substring path 0 (match-beginning 0)) + path))) + (search (and (not (equal file path)) + (org-string-nw-p (match-string 1 path))))) + (if (and file + (not (file-remote-p file)) + (not (file-exists-p file))) + (list (org-element-property :post-affiliated k) + "Non-existent file argument in INCLUDE keyword") + (let* ((visiting (if file (find-buffer-visiting file) + (current-buffer))) + (buffer (or visiting (find-file-noselect file)))) + (unwind-protect + (with-current-buffer buffer + (when (and search + (not + (ignore-errors + (let ((org-link-search-inhibit-query t)) + (org-link-search search nil t))))) + (list (org-element-property :post-affiliated k) + (format + "Invalid search part \"%s\" in INCLUDE keyword" + search)))) + (unless visiting (kill-buffer buffer)))))))))))) + +(defun org-lint-unknown-options-item (ast) + (let ((allowed (delq nil + (append + (mapcar (lambda (o) (nth 2 o)) org-export-options-alist) + (cl-mapcan + (lambda (b) + (mapcar (lambda (o) (nth 2 o)) + (org-export-backend-options b))) + org-export-registered-backends)))) + reports) + (org-element-map ast 'keyword + (lambda (k) + (when (string= (org-element-property :key k) "OPTIONS") + (let ((value (org-element-property :value k)) + (start 0)) + (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*" + value + start) + (setf start (match-end 0)) + (let ((item (match-string 1 value))) + (unless (member item allowed) + (push (list (org-element-property :post-affiliated k) + (format "Unknown OPTIONS item \"%s\"" item)) + reports)))))))) + reports)) + +(defun org-lint-invalid-macro-argument-and-template (ast) + (let ((extract-placeholders + (lambda (template) + (let ((start 0) + args) + (while (string-match "\\$\\([1-9][0-9]*\\)" template start) + (setf start (match-end 0)) + (push (string-to-number (match-string 1 template)) args)) + (sort (org-uniquify args) #'<)))) + reports) + ;; Check arguments for macro templates. + (org-element-map ast 'keyword + (lambda (k) + (when (string= (org-element-property :key k) "MACRO") + (let* ((value (org-element-property :value k)) + (name (and (string-match "^\\S-+" value) + (match-string 0 value))) + (template (and name + (org-trim (substring value (match-end 0)))))) + (cond + ((not name) + (push (list (org-element-property :post-affiliated k) + "Missing name in MACRO keyword") + reports)) + ((not (org-string-nw-p template)) + (push (list (org-element-property :post-affiliated k) + "Missing template in macro \"%s\"" name) + reports)) + (t + (unless (let ((args (funcall extract-placeholders template))) + (equal (number-sequence 1 (or (org-last args) 0)) args)) + (push (list (org-element-property :post-affiliated k) + (format "Unused placeholders in macro \"%s\"" + name)) + reports)))))))) + ;; Check arguments for macros. + (org-macro-initialize-templates) + (let ((templates (append + (mapcar (lambda (m) (cons m "$1")) + '("author" "date" "email" "title" "results")) + org-macro-templates))) + (org-element-map ast 'macro + (lambda (macro) + (let* ((name (org-element-property :key macro)) + (template (cdr (assoc-string name templates t)))) + (if (not template) + (push (list (org-element-property :begin macro) + (format "Undefined macro \"%s\"" name)) + reports) + (let ((arg-numbers (funcall extract-placeholders template))) + (when arg-numbers + (let ((spurious-args + (nthcdr (apply #'max arg-numbers) + (org-element-property :args macro)))) + (when spurious-args + (push + (list (org-element-property :begin macro) + (format "Unused argument%s in macro \"%s\": %s" + (if (> (length spurious-args) 1) "s" "") + name + (mapconcat (lambda (a) (format "\"%s\"" a)) + spurious-args + ", "))) + reports)))))))))) + reports)) + +(defun org-lint-undefined-footnote-reference (ast) + (let ((definitions (org-element-map ast 'footnote-definition + (lambda (f) (org-element-property :label f))))) + (org-element-map ast 'footnote-reference + (lambda (f) + (let ((label (org-element-property :label f))) + (and label + (not (member label definitions)) + (list (org-element-property :begin f) + (format "Missing definition for footnote [%s]" + label)))))))) + +(defun org-lint-unreferenced-footnote-definition (ast) + (let ((references (org-element-map ast 'footnote-reference + (lambda (f) (org-element-property :label f))))) + (org-element-map ast 'footnote-definition + (lambda (f) + (let ((label (org-element-property :label f))) + (and label + (not (member label references)) + (list (org-element-property :post-affiliated f) + (format "No reference for footnote definition [%s]" + label)))))))) + +(defun org-lint-colon-in-name (ast) + (org-element-map ast org-element-all-elements + (lambda (e) + (let ((name (org-element-property :name e))) + (and name + (org-string-match-p ":" name) + (list (progn + (goto-char (org-element-property :begin e)) + (re-search-forward + (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name))) + (match-beginning 0)) + (format + "Name \"%s\" contains a colon; Babel cannot use it as input" + name))))))) + +(defun org-lint-misplaced-planning-info (_) + (let ((case-fold-search t) + reports) + (while (re-search-forward org-planning-line-re nil t) + (unless (memq (org-element-type (org-element-at-point)) + '(comment-block example-block export-block planning + src-block verse-block)) + (push (list (line-beginning-position) "Misplaced planning info line") + reports))) + reports)) + +(defun org-lint-incomplete-drawer (_) + (let (reports) + (while (re-search-forward org-drawer-regexp nil t) + (let ((name (org-trim (org-match-string-no-properties 0))) + (element (org-element-at-point))) + (pcase (org-element-type element) + ((or `drawer `property-drawer) + (goto-char (org-element-property :end element)) + nil) + ((or `comment-block `example-block `export-block `src-block + `verse-block) + nil) + (_ + (push (list (line-beginning-position) + (format "Possible incomplete drawer \"%s\"" name)) + reports))))) + reports)) + +(defun org-lint-indented-diary-sexp (_) + (let (reports) + (while (re-search-forward "^[ \t]+%%(" nil t) + (unless (memq (org-element-type (org-element-at-point)) + '(comment-block diary-sexp example-block export-block + src-block verse-block)) + (push (list (line-beginning-position) "Possible indented diary-sexp") + reports))) + reports)) + +(defun org-lint-invalid-block (_) + (let ((case-fold-search t) + (regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*") + reports) + (while (re-search-forward regexp nil t) + (let ((name (org-trim (buffer-substring-no-properties + (line-beginning-position) (line-end-position))))) + (cond + ((and (string-prefix-p "END" (match-string 1) t) + (not (eolp))) + (push (list (line-beginning-position) + (format "Invalid block closing line \"%s\"" name)) + reports)) + ((not (memq (org-element-type (org-element-at-point)) + '(center-block comment-block dynamic-block example-block + export-block quote-block special-block + src-block verse-block))) + (push (list (line-beginning-position) + (format "Possible incomplete block \"%s\"" + name)) + reports))))) + reports)) + +(defun org-lint-invalid-keyword-syntax (_) + (let ((regexp "^[ \t]*#\\+\\([^[:space:]:]*\\)\\(?: \\|$\\)") + (exception-re + (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)" + (regexp-opt org-element-dual-keywords))) + reports) + (while (re-search-forward regexp nil t) + (let ((name (org-match-string-no-properties 1))) + (unless (or (string-prefix-p "BEGIN" name t) + (string-prefix-p "END" name t) + (save-excursion + (beginning-of-line) + (let ((case-fold-search t)) (looking-at exception-re)))) + (push (list (match-beginning 0) + (format "Possible missing colon in keyword \"%s\"" name)) + reports)))) + reports)) + +(defun org-lint-extraneous-element-in-footnote-section (ast) + (org-element-map ast 'headline + (lambda (h) + (and (org-element-property :footnote-section-p h) + (org-element-map (org-element-contents h) + (cl-remove-if + (lambda (e) + (memq e '(comment comment-block footnote-definition + property-drawer section))) + org-element-all-elements) + (lambda (e) + (not (and (eq (org-element-type e) 'headline) + (org-element-property :commentedp e)))) + nil t '(footnote-definition property-drawer)) + (list (org-element-property :begin h) + "Extraneous elements in footnote section"))))) + +(defun org-lint-quote-section (ast) + (org-element-map ast '(headline inlinetask) + (lambda (h) + (let ((title (org-element-property :raw-value h))) + (and (or (string-prefix-p "QUOTE " title) + (string-prefix-p (concat org-comment-string " QUOTE ") title)) + (list (org-element-property :begin h) + "Deprecated QUOTE section")))))) + +(defun org-lint-wrong-header-argument (ast) + (let* ((reports) + (verify + (lambda (datum language headers) + (let ((allowed + ;; If LANGUAGE is specified, restrict allowed + ;; headers to both LANGUAGE-specific and default + ;; ones. Otherwise, accept headers from any loaded + ;; language. + (append + org-babel-header-arg-names + (cl-mapcan + (lambda (l) + (let ((v (intern (format "org-babel-header-args:%s" l)))) + (and (boundp v) (mapcar #'car (symbol-value v))))) + (if language (list language) + (mapcar #'car org-babel-load-languages)))))) + (dolist (header headers) + (let ((h (symbol-name (car header))) + (p (or (org-element-property :post-affiliated datum) + (org-element-property :begin datum)))) + (cond + ((not (string-prefix-p ":" h)) + (push + (list p + (format "Missing colon in header argument \"%s\"" h)) + reports)) + ((assoc-string (substring h 1) allowed)) + (t (push (list p (format "Unknown header argument \"%s\"" h)) + reports))))))))) + (org-element-map ast '(babel-call inline-babel-call inline-src-block keyword + node-property src-block) + (lambda (datum) + (pcase (org-element-type datum) + ((or `babel-call `inline-babel-call) + (funcall verify + datum + nil + (cl-mapcan #'org-babel-parse-header-arguments + (list + (org-element-property :inside-header datum) + (org-element-property :end-header datum))))) + (`inline-src-block + (funcall verify + datum + (org-element-property :language datum) + (org-babel-parse-header-arguments + (org-element-property :parameters datum)))) + (`keyword + (when (string= (org-element-property :key datum) "PROPERTY") + (let ((value (org-element-property :value datum))) + (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *" + value) + (funcall verify + datum + (match-string 1 value) + (org-babel-parse-header-arguments + (substring value (match-end 0)))))))) + (`node-property + (let ((key (org-element-property :key datum))) + (when (let ((case-fold-search t)) + (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?" + key)) + (funcall verify + datum + (match-string 1 key) + (org-babel-parse-header-arguments + (org-element-property :value datum)))))) + (`src-block + (funcall verify + datum + (org-element-property :language datum) + (cl-mapcan #'org-babel-parse-header-arguments + (cons (org-element-property :parameters datum) + (org-element-property :header datum)))))))) + reports)) + +(defun org-lint-wrong-header-value (ast) + (let (reports) + (org-element-map ast + '(babel-call inline-babel-call inline-src-block src-block) + (lambda (datum) + (let* ((type (org-element-type datum)) + (language (org-element-property :language datum)) + (allowed-header-values + (append (and language + (let ((v (intern (concat "org-babel-header-args:" + language)))) + (and (boundp v) (symbol-value v)))) + org-babel-common-header-args-w-values)) + (datum-header-values + (apply + #'org-babel-merge-params + org-babel-default-header-args + (and language + (let ((v (intern (concat "org-babel-default-header-args:" + language)))) + (and (boundp v) (symbol-value v)))) + (append + (list (and (memq type '(babel-call inline-babel-call)) + org-babel-default-lob-header-args)) + (progn (goto-char (org-element-property :begin datum)) + (org-babel-params-from-properties language)) + (list + (org-babel-parse-header-arguments + (org-trim + (pcase type + (`src-block + (mapconcat + #'identity + (cons (org-element-property :parameters datum) + (org-element-property :header datum)) + " ")) + (`inline-src-block + (or (org-element-property :parameters datum) "")) + (_ + (concat + (org-element-property :inside-header datum) + " " + (org-element-property :end-header datum))))))))))) + (dolist (header datum-header-values) + (let ((allowed-values + (cdr (assoc-string (substring (symbol-name (car header)) 1) + allowed-header-values)))) + (unless (memq allowed-values '(:any nil)) + (let ((values (cdr header)) + groups-alist) + (dolist (v (if (stringp values) (org-split-string values) + (list values))) + (let ((valid-value nil)) + (catch 'exit + (dolist (group allowed-values) + (cond + ((not (funcall + (if (stringp v) #'assoc-string #'assoc) + v group)) + (when (memq :any group) + (setf valid-value t) + (push (cons group v) groups-alist))) + ((assq group groups-alist) + (push + (list + (or (org-element-property :post-affiliated datum) + (org-element-property :begin datum)) + (format + "Forbidden combination in header \"%s\": %s, %s" + (car header) + (cdr (assq group groups-alist)) + v)) + reports) + (throw 'exit nil)) + (t (push (cons group v) groups-alist) + (setf valid-value t)))) + (unless valid-value + (push + (list + (or (org-element-property :post-affiliated datum) + (org-element-property :begin datum)) + (format "Unknown value \"%s\" for header \"%s\"" + v + (car header))) + reports)))))))))))) + reports)) + + +;;; Reports UI + +(defvar org-lint--report-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map tabulated-list-mode-map) + (define-key map (kbd "RET") 'org-lint--jump-to-source) + (define-key map (kbd "TAB") 'org-lint--show-source) + (define-key map (kbd "C-j") 'org-lint--show-source) + (define-key map (kbd "h") 'org-lint--hide-checker) + (define-key map (kbd "i") 'org-lint--ignore-checker) + map) + "Local keymap for `org-lint--report-mode' buffers.") + +(define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint" + "Major mode used to display reports emitted during linting. +\\{org-lint--report-mode-map}" + (setf tabulated-list-format + `[("Line" 6 + (lambda (a b) + (< (string-to-number (aref (cadr a) 0)) + (string-to-number (aref (cadr b) 0)))) + :right-align t) + ("Trust" 5 t) + ("Warning" 0 t)]) + (tabulated-list-init-header)) + +(defun org-lint--generate-reports (buffer checkers) + "Generate linting report for BUFFER. + +CHECKERS is the list of checkers used. + +Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable +for `tabulated-list-printer'." + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (let ((ast (org-element-parse-buffer)) + (id 0) + (last-line 1) + (last-pos 1)) + ;; Insert unique ID for each report. Replace buffer positions + ;; with line numbers. + (mapcar + (lambda (report) + (list + (incf id) + (apply #'vector + (cons + (progn + (goto-char (car report)) + (beginning-of-line) + (prog1 (number-to-string + (incf last-line (count-lines last-pos (point)))) + (setf last-pos (point)))) + (cdr report))))) + ;; Insert trust level in generated reports. Also sort them + ;; by buffer position in order to optimize lines computation. + (sort (cl-mapcan + (lambda (c) + (let ((trust (symbol-name (org-lint-checker-trust c)))) + (mapcar + (lambda (report) + (list (car report) trust (nth 1 report) c)) + (save-excursion + (funcall + (intern (format "org-lint-%s" + (org-lint-checker-name c))) + ast))))) + checkers) + #'car-less-than-car)))))) + +(defvar-local org-lint--source-buffer nil + "Source buffer associated to current report buffer.") + +(defvar-local org-lint--local-checkers nil + "List of checkers used to build current report.") + +(defun org-lint--refresh-reports () + (setq tabulated-list-entries + (org-lint--generate-reports org-lint--source-buffer + org-lint--local-checkers)) + (tabulated-list-print)) + +(defun org-lint--current-line () + "Return current report line, as a number." + (string-to-number (aref (tabulated-list-get-entry) 0))) + +(defun org-lint--current-checker (&optional entry) + "Return current report checker. +When optional argument ENTRY is non-nil, use this entry instead +of current one." + (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3)) + +(defun org-lint--display-reports (source checkers) + "Display linting reports for buffer SOURCE. +CHECKERS is the list of checkers used." + (let ((buffer (get-buffer-create "*Org Lint*"))) + (with-current-buffer buffer + (org-lint--report-mode) + (setf org-lint--source-buffer source) + (setf org-lint--local-checkers checkers) + (org-lint--refresh-reports) + (tabulated-list-print) + (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t)) + (pop-to-buffer buffer))) + +(defun org-lint--jump-to-source () + "Move to source line that generated the report at point." + (interactive) + (let ((l (org-lint--current-line))) + (switch-to-buffer-other-window org-lint--source-buffer) + (org-goto-line l) + (org-show-set-visibility 'local) + (recenter))) + +(defun org-lint--show-source () + "Show source line that generated the report at point." + (interactive) + (let ((buffer (current-buffer))) + (org-lint--jump-to-source) + (switch-to-buffer-other-window buffer))) + +(defun org-lint--hide-checker () + "Hide all reports from checker that generated the report at point." + (interactive) + (let ((c (org-lint--current-checker))) + (setf tabulated-list-entries + (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e))) + tabulated-list-entries)) + (tabulated-list-print))) + +(defun org-lint--ignore-checker () + "Ignore all reports from checker that generated the report at point. +Checker will also be ignored in all subsequent reports." + (interactive) + (setf org-lint--local-checkers + (remove (org-lint--current-checker) org-lint--local-checkers)) + (org-lint--hide-checker)) + + +;;; Public function + +;;;###autoload +(defun org-lint (&optional arg) + "Check current Org buffer for syntax mistakes. + +By default, run all checkers. With a single prefix ARG \ +\\[universal-argument], +select one category of checkers only. With a double prefix +\\[universal-argument] \\[universal-argument], select one precise \ +checker by its name. + +ARG can also be a list of checker names, as symbols, to run." + (interactive "P") + (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer")) + (when (org-called-interactively-p) + (message "Org linting process starting...")) + (let ((checkers + (pcase arg + (`nil org-lint--checkers) + (`(4) + (let ((category + (completing-read + "Checker category: " + (mapcar #'org-lint-checker-categories org-lint--checkers) + nil t))) + (cl-remove-if-not + (lambda (c) + (assoc-string (org-lint-checker-categories c) category)) + org-lint--checkers))) + (`(16) + (list + (let ((name (completing-read + "Checker name: " + (mapcar #'org-lint-checker-name org-lint--checkers) + nil t))) + (catch 'exit + (dolist (c org-lint--checkers) + (when (string= (org-lint-checker-name c) name) + (throw 'exit c))))))) + ((pred consp) + (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg)) + org-lint--checkers)) + (_ (user-error "Invalid argument `%S' for `org-lint'" arg))))) + (if (not (org-called-interactively-p)) + (org-lint--generate-reports (current-buffer) checkers) + (org-lint--display-reports (current-buffer) checkers) + (message "Org linting process completed")))) + + +(provide 'org-lint) +;;; org-lint.el ends here diff --git a/lisp/org-loaddefs.el b/lisp/org-loaddefs.el index cfd12fb..1cec7d9 100644 --- a/lisp/org-loaddefs.el +++ b/lisp/org-loaddefs.el @@ -14,7 +14,7 @@ ;;;;;; org-babel-execute-src-block 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" "83c23eb7ea9b45eb61844eb96a1e0499") +;;;;;; "ob-core" "ob-core.el" "941575cd3238be25274d48a658089252") ;;; Generated autoloads from ob-core.el (autoload 'org-babel-execute-safely-maybe "ob-core" "\ @@ -264,7 +264,7 @@ Return a Library of Babel function call as a string. ;;;*** ;;;### (autoloads (org-babel-tangle org-babel-tangle-file) "ob-tangle" -;;;;;; "ob-tangle.el" "dacdacb67ec6b7ce5a3ca79dfe9aa403") +;;;;;; "ob-tangle.el" "bbdbf9322d0ab7e977944af2e50bfa5f") ;;; Generated autoloads from ob-tangle.el (autoload 'org-babel-tangle-file "ob-tangle" "\ @@ -298,7 +298,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" -;;;;;; (22026 7479)) +;;;;;; (22140 56762)) ;;; Generated autoloads from org-agenda.el (autoload 'org-toggle-sticky-agenda "org-agenda" "\ @@ -574,7 +574,7 @@ to override `appt-message-warning-time'. ;;;### (autoloads (org-archive-subtree-default-with-confirmation ;;;;;; org-archive-subtree-default org-toggle-archive-tag org-archive-to-archive-sibling ;;;;;; org-archive-subtree org-add-archive-files) "org-archive" -;;;;;; "org-archive.el" "3d45871a918bccfda0ed5aa8ce2828f8") +;;;;;; "org-archive.el" "ae38f88639f444f347a31cb5637a2fa9") ;;; Generated autoloads from org-archive.el (autoload 'org-add-archive-files "org-archive" "\ @@ -652,8 +652,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" (22016 -;;;;;; 58042)) +;;;;;; org-capture-string) "org-capture" "org-capture.el" (22124 +;;;;;; 4162)) ;;; Generated autoloads from org-capture.el (autoload 'org-capture-string "org-capture" "\ @@ -700,7 +700,7 @@ Set `org-capture-templates' to be similar to `org-remember-templates'. ;;;;;; org-clock-remove-overlays 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" -;;;;;; "2eb22f60f3e90e0c103ec1389f7da830") +;;;;;; "e6d87792d62998c4d6764d868a348c7e") ;;; Generated autoloads from org-clock.el (autoload 'org-resolve-clocks "org-clock" "\ @@ -769,10 +769,11 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes. (autoload 'org-clock-display "org-clock" "\ Show subtree times in the entire buffer. -With one universal prefix argument, show the total time for -today. With two universal prefix arguments, show the total time -for a custom range, entered at the prompt. With three universal -prefix arguments, show the total time in the echo area. +By default, show the total time for the range defined in +`org-clock-display-default-range'. With \\[universal-argument] prefix, show +the total time for today instead. With \\[universal-argument] \\[universal-argument] prefix, use +a custom range, entered at the prompt. With \\[universal-argument] \\[universal-argument] \\[universal-argument] +prefix, display the total time in the echo area. Use \\[org-clock-remove-overlays] to remove the subtree times. @@ -832,7 +833,7 @@ Otherwise, return nil. ;;;### (autoloads (org-agenda-columns org-insert-columns-dblock org-dblock-write:columnview ;;;;;; org-columns-number-to-string org-columns-compute org-columns ;;;;;; org-columns-get-format-and-top-level org-columns-remove-overlays) -;;;;;; "org-colview" "org-colview.el" (21964 9912)) +;;;;;; "org-colview" "org-colview.el" (22124 4162)) ;;; Generated autoloads from org-colview.el (autoload 'org-columns-remove-overlays "org-colview" "\ @@ -896,7 +897,7 @@ Turn on or update column view in the agenda. ;;;*** ;;;### (autoloads (org-check-version) "org-compat" "org-compat.el" -;;;;;; (22016 58042)) +;;;;;; (22124 4162)) ;;; Generated autoloads from org-compat.el (autoload 'org-check-version "org-compat" "\ @@ -922,7 +923,7 @@ tree can be found. ;;;### (autoloads (org-element-context org-element-at-point org-element-cache-refresh ;;;;;; org-element-cache-reset org-element-interpret-data org-element-update-syntax) -;;;;;; "org-element" "org-element.el" "63ae8089b96f8937b454a2f868747ad3") +;;;;;; "org-element" "org-element.el" "3e4331afb6c8cf1861c9a10de419bf72") ;;; Generated autoloads from org-element.el (autoload 'org-element-update-syntax "org-element" "\ @@ -995,7 +996,7 @@ Providing it allows for quicker computation. ;;;*** ;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update -;;;;;; org-feed-update-all) "org-feed" "org-feed.el" "c83eadc8f56f6f3040b7535597a183db") +;;;;;; org-feed-update-all) "org-feed" "org-feed.el" "56102e4de09ad6277cb8df0263dd7720") ;;; Generated autoloads from org-feed.el (autoload 'org-feed-update-all "org-feed" "\ @@ -1023,7 +1024,7 @@ Show the raw feed buffer of a feed. ;;;*** ;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote" -;;;;;; "org-footnote.el" "69cb58a7f018fde2fd452ebca8ed0fc6") +;;;;;; "org-footnote.el" "07722d60ada7fa7913881b21d915d854") ;;; Generated autoloads from org-footnote.el (autoload 'org-footnote-action "org-footnote" "\ @@ -1152,7 +1153,7 @@ Store a link to the current entry, using its ID. ;;;*** ;;;### (autoloads (org-indent-mode) "org-indent" "org-indent.el" -;;;;;; "0a614b4056871d7fd7a5f3b89cbf801c") +;;;;;; "da988e2c3b7826ad167376bcfd481df9") ;;; Generated autoloads from org-indent.el (autoload 'org-indent-mode "org-indent" "\ @@ -1179,8 +1180,24 @@ Dispatch to the appropriate function to store a link to an IRC session. ;;;*** +;;;### (autoloads (org-lint) "org-lint" "org-lint.el" (22106 38585)) +;;; Generated autoloads from org-lint.el + +(autoload 'org-lint "org-lint" "\ +Check current Org buffer for syntax mistakes. + +By default, run all checkers. With a single prefix ARG \\[universal-argument], +select one category of checkers only. With a double prefix +\\[universal-argument] \\[universal-argument], select one precise checker by its name. + +ARG can also be a list of checker names, as symbols, to run. + +\(fn &optional ARG)" t nil) + +;;;*** + ;;;### (autoloads (org-load-noerror-mustsuffix) "org-macs" "org-macs.el" -;;;;;; (22016 58042)) +;;;;;; (22124 4162)) ;;; Generated autoloads from org-macs.el (autoload 'org-load-noerror-mustsuffix "org-macs" "\ @@ -1243,7 +1260,7 @@ line directly before or after the table. ;;;;;; org-table-begin 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" -;;;;;; "bcde30b64542d0ebe3c477feee93db48") +;;;;;; "537e73768bb60b868fd2c10a3a780d73") ;;; Generated autoloads from org-table.el (autoload 'org-table-create-with-table\.el "org-table" "\ @@ -1587,7 +1604,7 @@ If NLAST is a number, only the NLAST fields will actually be summed. (autoload 'org-table-get-stored-formulas "org-table" "\ Return an alist with the stored formulas directly after current table. -\(fn &optional NOERROR)" t nil) +\(fn &optional NOERROR)" nil nil) (autoload 'org-table-maybe-eval-formula "org-table" "\ Check if the current field starts with \"=\" or \":=\". @@ -1985,7 +2002,7 @@ using three `C-u' prefix arguments. ;;;*** ;;;### (autoloads (org-git-version org-release) "org-version" "org-version.el" -;;;;;; (22026 39838)) +;;;;;; (22159 58592)) ;;; Generated autoloads from org-version.el (autoload 'org-release "org-version" "\ @@ -2011,7 +2028,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" (22026 7479)) +;;;;;; "org" "org.el" (22158 315)) ;;; Generated autoloads from org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -2234,7 +2251,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" "7009055e46700dbb68151c69c95e7e90") +;;;;;; "ox-ascii" "ox-ascii.el" "2c695b9d7d3e1e38409399fd2bb9051a") ;;; Generated autoloads from ox-ascii.el (autoload 'org-ascii-export-as-ascii "ox-ascii" "\ @@ -2337,7 +2354,7 @@ Return output file name. ;;;### (autoloads (org-beamer-publish-to-pdf org-beamer-publish-to-latex ;;;;;; 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" -;;;;;; "fcf86747012a3c93318a8c76d7e6dae8") +;;;;;; "5b748cdd893990814ca747054ba4e08a") ;;; Generated autoloads from ox-beamer.el (autoload 'org-beamer-mode "ox-beamer" "\ @@ -2474,7 +2491,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" "9fb7643fff02146d2dc738be2ff135fd") +;;;;;; "ox-html" "ox-html.el" "998bdaa7a35400df0fe9f3c72fbf9ecc") ;;; Generated autoloads from ox-html.el (put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) @@ -2582,7 +2599,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" -;;;;;; "5426fe8de7686769a87909e9e5a99643") +;;;;;; "2afaa2d0048aa2b617cf5801a7f189f8") ;;; Generated autoloads from ox-icalendar.el (autoload 'org-icalendar-export-to-ics "ox-icalendar" "\ @@ -2897,7 +2914,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" "8cb6bb87ee534a12af804fdc8ba36494") +;;;;;; "ox-org" "ox-org.el" "c9cccd49abced6f7ad4cc70d76d67f6e") ;;; Generated autoloads from ox-org.el (autoload 'org-org-export-as-org "ox-org" "\ @@ -2977,7 +2994,7 @@ Return output file name. ;;;### (autoloads (org-publish-current-project org-publish-current-file ;;;;;; org-publish-all org-publish) "ox-publish" "ox-publish.el" -;;;;;; "5675ef912592d842ef2bcb7256ba4441") +;;;;;; "fdfce4591b6fa2152faae1cba2401706") ;;; Generated autoloads from ox-publish.el (defalias 'org-publish-project 'org-publish) @@ -3047,7 +3064,7 @@ this command to convert it. ;;;### (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" "36d7ca3073e166c11f17a18ab55ebd10") +;;;;;; org-export-string-as org-export-as) "ox" "ox.el" "80b647995035a70655d4440422bf062a") ;;; Generated autoloads from ox.el (autoload 'org-export-as "ox" "\ diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index c2fa46a..43ebfb6 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -497,7 +497,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" `("Main Menu" ["Show Overview" org-mouse-show-overview t] ["Show Headlines" org-mouse-show-headlines t] - ["Show All" show-all t] + ["Show All" outline-show-all t] ["Remove Highlights" org-remove-occur-highlights :visible org-occur-highlights] "--" @@ -586,7 +586,7 @@ This means, between the beginning of line and the point." (:end ; insert text here (skip-chars-backward " \t") (kill-region (point) (point-at-eol)) - (unless (org-looking-back org-mouse-punctuation) + (unless (org-looking-back org-mouse-punctuation (line-beginning-position)) (insert (concat org-mouse-punctuation " "))))) (insert text) (beginning-of-line)) @@ -644,7 +644,8 @@ This means, between the beginning of line and the point." 'org-mode-restart)))) ((or (eolp) (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") - (org-looking-back " \\|\t" (- (point) 2)))) + (org-looking-back " \\|\t" (- (point) 2) + (line-beginning-position)))) (org-mouse-popup-global-menu)) ((funcall get-context :checkbox) (popup-menu diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index 05683fe..42d0f9f 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -93,8 +93,10 @@ The return value is a string naming the thing at point." (skip-chars-backward "[ \t\n]") ;; org-drawer-regexp matches a whole line but while ;; looking-back, we just ignore trailing whitespaces - (or (org-looking-back (substring org-drawer-regexp 0 -1)) - (org-looking-back org-property-re)))) + (or (org-looking-back (substring org-drawer-regexp 0 -1) + (line-beginning-position)) + (org-looking-back org-property-re + (line-beginning-position))))) (cons "prop" nil)) ((and (equal (char-before beg1) ?:) (not (equal (char-after (point-at-bol)) ?*))) diff --git a/lisp/org-table.el b/lisp/org-table.el index ba79690..e2d3198 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -1286,8 +1286,9 @@ is always the old value." (dline (org-table-current-dline)) (ref (format "@%d$%d" dline col)) (ref1 (org-table-convert-refs-to-an ref)) + ;; Prioritize field formulas over column formulas. (fequation (or (assoc name eql) (assoc ref eql))) - (cequation (assoc (int-to-string col) eql)) + (cequation (assoc (format "$%d" col) eql)) (eqn (or fequation cequation))) (let ((p (and eqn (get-text-property 0 :orig-eqn (car eqn))))) (when p (setq eqn p))) @@ -2191,17 +2192,19 @@ When NAMED is non-nil, look for a named equation." (line-beginning-position)) (org-table-current-column)) org-table-named-field-locations))) - (ref (format "@%d$%d" (org-table-current-dline) + (ref (format "@%d$%d" + (org-table-current-dline) (org-table-current-column))) (refass (assoc ref stored-list)) (nameass (assoc name stored-list)) - (scol (if named - (if (and name (not (string-match "^LR[0-9]+$" name))) - name - ref) - (int-to-string (org-table-current-column)))) - (dummy (and (or nameass refass) (not named) - (not (y-or-n-p "Replace existing field formula with column formula? " )) + (scol (cond + ((not named) (format "$%d" (org-table-current-column))) + ((and name (not (string-match "\\`LR[0-9]+\\'" name))) name) + (t ref))) + (dummy (and (or nameass refass) + (not named) + (not (y-or-n-p "Replace existing field formula with \ +column formula? " )) (message "Formula not replaced"))) (name (or name ref)) (org-table-may-need-update nil) @@ -2214,9 +2217,8 @@ When NAMED is non-nil, look for a named equation." (t (org-table-formula-from-user (read-string (org-table-formula-to-user - (format "%s formula %s%s=" + (format "%s formula %s=" (if named "Field" "Column") - (if (member (string-to-char scol) '(?$ ?@)) "" "$") scol)) (if stored (org-table-formula-to-user stored) "") 'org-table-formula-history @@ -2242,23 +2244,21 @@ When NAMED is non-nil, look for a named equation." (defun org-table-store-formulas (alist) "Store the list of formulas below the current table." - (setq alist (sort alist 'org-table-formula-less-p)) - (let ((case-fold-search t)) - (save-excursion - (goto-char (org-table-end)) + (save-excursion + (goto-char (org-table-end)) + (let ((case-fold-search t)) (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") (progn - ;; don't overwrite TBLFM, we might use text properties to store stuff + ;; Don't overwrite TBLFM, we might use text properties to + ;; store stuff. (goto-char (match-beginning 3)) (delete-region (match-beginning 3) (match-end 0))) (org-indent-line) (insert (or (match-string 2) "#+TBLFM:"))) (insert " " - (mapconcat (lambda (x) - (concat - (if (equal (string-to-char (car x)) ?@) "" "$") - (car x) "=" (cdr x))) - alist "::") + (mapconcat (lambda (x) (concat (car x) "=" (cdr x))) + (sort alist #'org-table-formula-less-p) + "::") "\n")))) (defsubst org-table-formula-make-cmp-string (a) @@ -2289,31 +2289,40 @@ When NAMED is non-nil, look for a named equation." ;;;###autoload (defun org-table-get-stored-formulas (&optional noerror) "Return an alist with the stored formulas directly after current table." - (interactive) ;; FIXME interactive? - (let ((case-fold-search t) scol eq eq-alist strings string seen) - (save-excursion - (goto-char (org-table-end)) - (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)") - (setq strings (org-split-string (org-match-string-no-properties 2) - " *:: *")) - (while (setq string (pop strings)) - (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string) - (setq scol (if (match-end 2) - (match-string 2 string) - (match-string 1 string)) - scol (if (member (string-to-char scol) '(?< ?>)) - (concat "$" scol) scol) - eq (match-string 3 string) - eq-alist (cons (cons scol eq) eq-alist)) - (if (member scol seen) - (if noerror - (progn - (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) - (ding) - (sit-for 2)) - (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) - (push scol seen)))))) - (nreverse eq-alist))) + (save-excursion + (goto-char (org-table-end)) + (let ((case-fold-search t)) + (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") + (let ((strings (org-split-string (org-match-string-no-properties 2) + " *:: *")) + eq-alist seen) + (dolist (string strings (nreverse eq-alist)) + (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|\\$\\([_a-zA-Z0-9]+\\|\ +[<>]+\\)\\) *= *\\(.*[^ \t]\\)" + string) + (let ((lhs + (let ((m (match-string 1 string))) + (cond + ((not (match-end 2)) m) + ;; Is it a column reference? + ((org-string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m) + ;; Since named columns are not possible in + ;; LHS, assume this is a named field. + (t (match-string 2 string))))) + (rhs (match-string 3 string))) + (push (cons lhs rhs) eq-alist) + (cond + ((not (member lhs seen)) (push lhs seen)) + (noerror + (message + "Double definition `%s=' in TBLFM line, please fix by hand" + lhs) + (ding) + (sit-for 2)) + (t + (user-error + "Double definition `%s=' in TBLFM line, please fix by hand" + lhs))))))))))) (defun org-table-fix-formulas (key replace &optional limit delta remove) "Modify the equations after the table structure has been edited. @@ -2534,24 +2543,27 @@ This function sets up the following dynamically scoped variables: (push 'hline types) ; Add an imaginary extra hline to the end. (setq org-table-current-line-types (apply #'vector (nreverse types))) (setq org-table-dlines (apply #'vector (cons nil (nreverse dlines)))) - (setq org-table-hlines (apply #'vector (cons nil (nreverse hlines)))) - (forward-line -1) - (let* ((last-dline (car dlines)) - (fields (org-split-string - (buffer-substring (line-beginning-position) - (line-end-position)) - "[ \t]*|[ \t]*")) - (nfields (length fields)) - al al2) - (setq org-table-current-ncol nfields) + (setq org-table-hlines (apply #'vector (cons nil (nreverse hlines))))) + ;; Get the number of columns from the first data line in table. + (goto-char beg) + (forward-line (aref org-table-dlines 1)) + (let* ((fields + (org-split-string + (buffer-substring (line-beginning-position) (line-end-position)) + "[ \t]*|[ \t]*")) + (nfields (length fields)) + al al2) + (setq org-table-current-ncol nfields) + (let ((last-dline + (aref org-table-dlines (1- (length org-table-dlines))))) (dotimes (i nfields) (let ((column (1+ i))) (push (list (format "LR%d" column) last-dline column) al) - (push (cons (format "LR%d" column) (nth i fields)) al2))) - (setq org-table-named-field-locations - (append org-table-named-field-locations al)) - (setq org-table-local-parameters - (append org-table-local-parameters al2))))))) + (push (cons (format "LR%d" column) (nth i fields)) al2)))) + (setq org-table-named-field-locations + (append org-table-named-field-locations al)) + (setq org-table-local-parameters + (append org-table-local-parameters al2)))))) (defun org-table-goto-field (ref &optional create-column-p) "Move point to a specific field in the current table. @@ -2717,7 +2729,9 @@ not overwrite the stored one." (setq orig (or (get-text-property 1 :orig-formula formula) "?")) (while (> ndown 0) (setq fields (org-split-string - (buffer-substring-no-properties (point-at-bol) (point-at-eol)) + (org-trim + (buffer-substring-no-properties + (line-beginning-position) (line-end-position))) " *| *")) ;; replace fields with duration values if relevant (if duration @@ -2904,7 +2918,9 @@ When CORNERS-ONLY is set, only return the corners of the range as a list (line1 column1 line2 column2) where line1 and line2 are line numbers relative to beginning of table, or TBEG, and column1 and column2 are table column numbers." - (let* ((desc (if (eq (string-to-char desc) ?@) desc (concat "@" desc))) + (let* ((desc (if (org-string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc) + (replace-regexp-in-string "\\$" "@0$" desc) + desc)) (col (or col (org-table-current-column))) (tbeg (or tbeg (org-table-begin))) (thisline (count-lines tbeg (line-beginning-position)))) @@ -3113,47 +3129,43 @@ known that the table will be realigned a little later anyway." (org-table-analyze) (let* ((eqlist (sort (org-table-get-stored-formulas) (lambda (a b) (string< (car a) (car b))))) - (eqlist1 (copy-sequence eqlist)) (inhibit-redisplay (not debug-on-error)) (line-re org-table-dataline-regexp) (log-first-time (current-time)) (log-last-time log-first-time) (cnt 0) - beg end eqlnum eqlname) - ;; Insert constants in all formulas + beg end eqlcol eqlfield) + ;; Insert constants in all formulas. (when eqlist (org-table-save-field - (setq eqlist - (mapcar - (lambda (x) - (when (string-match "\\`@-?I+" (car x)) - (user-error "Can't assign to hline relative reference")) - (when (string-match "\\`$[<>]" (car x)) - (let ((old-lhs (car x))) - (setq x - (cons - (substring - (org-table-formula-handle-first/last-rc old-lhs) - 1) - (cdr x))) - (when (assoc (car x) eqlist1) - (user-error "\"%s=\" formula tries to overwrite \ -existing formula for column %s" - old-lhs - (car x))))) - (cons (org-table-formula-handle-first/last-rc (car x)) - (org-table-formula-substitute-names - (org-table-formula-handle-first/last-rc (cdr x))))) - eqlist)) - ;; Split the equation list. + ;; Expand equations, then split the equation list between + ;; column formulas and field formulas. (dolist (eq eqlist) - (if (<= (string-to-char (car eq)) ?9) - (push eq eqlnum) - (push eq eqlname))) - (setq eqlnum (nreverse eqlnum)) + (let* ((rhs (org-table-formula-substitute-names + (org-table-formula-handle-first/last-rc (cdr eq)))) + (old-lhs (car eq)) + (lhs + (org-table-formula-handle-first/last-rc + (cond + ((string-match "\\`@-?I+" old-lhs) + (user-error "Can't assign to hline relative reference")) + ((string-match "\\`$[<>]" old-lhs) + (let ((new (org-table-formula-handle-first/last-rc + old-lhs))) + (when (assoc new eqlist) + (user-error "\"%s=\" formula tries to overwrite \ +existing formula for column %s" + old-lhs + new)) + new)) + (t old-lhs))))) + (if (org-string-match-p "\\`\\$[0-9]+\\'" lhs) + (push (cons lhs rhs) eqlcol) + (push (cons lhs rhs) eqlfield)))) + (setq eqlcol (nreverse eqlcol)) ;; Expand ranges in lhs of formulas - (setq eqlname (org-table-expand-lhs-ranges (nreverse eqlname))) - ;; Get the correct line range to process + (setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield))) + ;; Get the correct line range to process. (if all (progn (setq end (copy-marker (org-table-end))) @@ -3169,7 +3181,7 @@ existing formula for column %s" (re-search-forward org-table-dataline-regexp end t)) (setq beg (match-beginning 0))) ;; Just leave BEG where it is. - (t nil))) + (t (setq beg (line-beginning-position))))) (setq beg (line-beginning-position) end (copy-marker (line-beginning-position 2)))) (goto-char beg) @@ -3179,7 +3191,7 @@ existing formula for column %s" (let ((current-line (count-lines org-table-current-begin-pos (line-beginning-position))) seen-fields) - (dolist (eq eqlname) + (dolist (eq eqlfield) (let* ((name (car eq)) (location (assoc name org-table-named-field-locations)) (eq-line (or (nth 1 location) @@ -3218,14 +3230,15 @@ existing formula for column %s" (move-marker org-last-recalc-line (line-beginning-position)) (setq org-last-recalc-line (copy-marker (line-beginning-position)))) - (dolist (entry eqlnum) + (dolist (entry eqlcol) (goto-char org-last-recalc-line) - (org-table-goto-column (string-to-number (car entry)) nil 'force) + (org-table-goto-column + (string-to-number (substring (car entry) 1)) nil 'force) (unless (get-text-property (point) :org-untouchable) (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis))))) ;; Evaluate the field formulas. - (dolist (eq eqlname) + (dolist (eq eqlfield) (let ((reference (car eq)) (formula (cdr eq))) (setq log-last-time @@ -3350,19 +3363,25 @@ Return nil when the beginning of TBLFM line was not found." (defun org-table-expand-lhs-ranges (equations) "Expand list of formulas. -If some of the RHS in the formulas are ranges or a row reference, expand -them to individual field equations for each field." +If some of the RHS in the formulas are ranges or a row reference, +expand them to individual field equations for each field. This +function assumes the table is already analyzed (i.e., using +`org-table-analyze')." (let (res) (dolist (e equations (nreverse res)) (let ((lhs (car e)) (rhs (cdr e))) (cond - ((string-match "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs) + ((org-string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs) ;; This just refers to one fixed field. (push e res)) - ((string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs) + ((org-string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs) ;; This just refers to one fixed named field. (push e res)) + ((org-string-match-p "\\`\\$[0-9]+\\'" lhs) + ;; Column formulas are treated specially and are not + ;; expanded. + (push e res)) ((string-match "\\`@[0-9]+\\'" lhs) (dotimes (ic org-table-current-ncol) (push (cons (propertize (format "%s$%d" lhs (1+ ic)) :orig-eqn e) @@ -4782,6 +4801,8 @@ This may be either a string or a function of two arguments: example \"%s\\\\times10^{%s}\". This may also be a property list with column numbers and format strings or functions. :fmt will still be applied after :efmt." + ;; Make sure `org-export-create-backend' is available. + (require 'ox) (let* ((backend (plist-get params :backend)) (custom-backend ;; Build a custom back-end according to PARAMS. Before @@ -5276,7 +5297,7 @@ characters width of the plot. ASK may also be the (org-table-store-formulas (cons (cons - (number-to-string (1+ col)) + (concat "$" (number-to-string (1+ col))) (format "'(%s $%s %s %s %s)" "orgtbl-ascii-draw" col min max length)) (org-table-get-stored-formulas))) @@ -5375,29 +5396,22 @@ For example \"remote($1, @>$2)\" => \"remote(year_2013, @>$1)\". This indirection works only with the format @ROW$COLUMN. The format \"B3\" is not supported because it can not be distinguished from a plain table name or ID." - (let ((start 0)) - (while (string-match (concat - ;; Same as in `org-table-eval-formula'. - "\\<remote([ \t]*\\(" - ;; Allow "$1", "@<", "$-1", "@<<$1" etc. - "[@$][^ \t,]+" - ;; Same as in `org-table-eval-formula'. - "\\)[ \t]*,[ \t]*\\([^\n)]+\\))") - form - start) - ;; The position of the character as far as possible to the right - ;; that will not be replaced and particularly not be shifted by - ;; `replace-match'. - (setq start (match-beginning 1)) - ;; Substitute the remote reference with the value found in the - ;; field. - (setq form - (replace-match - (save-match-data - (org-table-get-range (org-table-formula-handle-first/last-rc - (match-string 1 form)))) - t t form 1)))) - form) + (let ((regexp + ;; Same as in `org-table-eval-formula'. + (concat "\\<remote([ \t]*\\(" + ;; Allow "$1", "@<", "$-1", "@<<$1" etc. + "[@$][^ \t,]+" + "\\)[ \t]*,[ \t]*\\([^\n)]+\\))"))) + (replace-regexp-in-string + regexp + (lambda (m) + (save-match-data + (let ((eq (org-table-formula-handle-first/last-rc (match-string 1 m)))) + (org-table-get-range + (if (org-string-match-p "\\`\\$[0-9]+\\'" eq) + (concat "@0" eq) + eq))))) + form t t 1))) (defmacro org-define-lookup-function (mode) (let ((mode-str (symbol-name mode)) diff --git a/lisp/org-version.el b/lisp/org-version.el index 08f47bf..02a663e 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.3.2")) + (let ((org-release "8.3.3")) 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.3.2-dist")) + (let ((org-git-version "8.3.3-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 ea6c955..2e5b91d 100755 --- a/lisp/org.el +++ b/lisp/org.el @@ -6748,7 +6748,7 @@ show the entire buffer, including any drawers. (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) ((equal arg '(64)) - (show-all) + (outline-show-all) (org-unlogged-message "Entire buffer visible, including drawers")) ;; Try cdlatex TAB completion @@ -6847,7 +6847,7 @@ Use \\[org-edit-special] to edit table.el tables")) (eq org-cycle-global-status 'contents)) ;; We just showed the table of contents - now show everything (run-hook-with-args 'org-pre-cycle-hook 'all) - (show-all) + (outline-show-all) (unless ga (org-unlogged-message "SHOW ALL")) (setq org-cycle-global-status 'all) (run-hook-with-args 'org-cycle-hook 'all)) @@ -6923,7 +6923,7 @@ Use \\[org-edit-special] to edit table.el tables")) (if (org-at-item-p) (org-list-set-item-visibility (point-at-bol) struct 'children) (org-show-entry) - (org-with-limited-levels (show-children)) + (org-with-limited-levels (outline-show-children)) ;; FIXME: This slows down the func way too much. ;; How keep drawers hidden in subtree anyway? ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook) @@ -6981,8 +6981,8 @@ With a numeric prefix, show all headlines up to that level." (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil))) (cond ((integerp arg) - (show-all) - (hide-sublevels arg) + (outline-show-all) + (outline-hide-sublevels arg) (setq org-cycle-global-status 'contents)) ((equal arg '(4)) (org-set-startup-visibility) @@ -6999,7 +6999,7 @@ With a numeric prefix, show all headlines up to that level." (org-content)) ((or (eq org-startup-folded 'showeverything) (eq org-startup-folded nil)) - (show-all))) + (outline-show-all))) (unless (eq org-startup-folded 'showeverything) (if org-hide-block-startup (org-hide-block-all)) (org-set-visibility-according-to-property 'no-cleanup) @@ -7018,21 +7018,21 @@ With a numeric prefix, show all headlines up to that level." (let ((state (match-string 3))) (save-excursion (org-back-to-heading t) - (hide-subtree) + (outline-hide-subtree) (org-reveal) (cond ((equal state "folded") - (hide-subtree)) + (outline-hide-subtree)) ((equal state "children") (org-show-hidden-entry) - (show-children)) + (outline-show-children)) ((equal state "content") (save-excursion (save-restriction (org-narrow-to-subtree) (org-content)))) ((member state '("all" "showall")) - (show-subtree))))))) + (outline-show-subtree))))))) (unless no-cleanup (org-cycle-hide-archived-subtrees 'all) (org-cycle-hide-drawers 'all) @@ -7056,7 +7056,7 @@ results." (progn (goto-char (match-beginning 0)) (funcall outline-level)))))) - (and level (hide-sublevels level))))) + (and level (outline-hide-sublevels level))))) (defun org-content (&optional arg) "Show all headlines in the buffer, like a table of contents. @@ -7074,8 +7074,8 @@ With numerical argument N, show content up to level N." t) (looking-at org-outline-regexp)) (if (integerp arg) - (show-children (1- arg)) - (show-branches)) + (outline-show-children (1- arg)) + (outline-show-branches)) (if (bobp) (throw 'exit nil)))))) (defun org-optimize-window-after-visibility-change (state) @@ -7126,7 +7126,7 @@ This function is the default value of the hook `org-cycle-hook'." (if (and (not (outline-invisible-p)) (save-excursion (goto-char (point-at-eol)) (outline-invisible-p))) - (hide-entry)))) + (outline-hide-entry)))) (org-cycle-show-empty-lines 'overview) (org-cycle-hide-drawers 'overview))))) @@ -7290,7 +7290,7 @@ DATA should have been made by `org-outline-overlay-data'." (save-excursion (save-restriction (widen) - (show-all) + (outline-show-all) (mapc (lambda (c) (outline-flag-region (car c) (cdr c) t)) data))))) @@ -7463,8 +7463,8 @@ returns to the original buffer in which the visibility is still unchanged. After RET it will also jump to the location selected in the indirect buffer and expose the headline hierarchy above. -With a prefix argument, use the alternative interface: e.g. if -`org-goto-interface' is 'outline use 'outline-path-completion." +With a prefix argument, use the alternative interface: e.g., if +`org-goto-interface' is `outline' use `outline-path-completion'." (interactive "P") (org-goto-map) (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) @@ -7675,7 +7675,7 @@ frame is not changed." (if (featurep 'xemacs) (save-excursion (org-mode) (turn-on-font-lock))) (narrow-to-region beg end) - (show-all) + (outline-show-all) (goto-char pos) (run-hook-with-args 'org-cycle-hook 'all) (and (window-live-p cwin) (select-window cwin)))) @@ -7844,7 +7844,7 @@ heading, unconditionally." (re-search-forward org-outline-regexp-bol) (beginning-of-line 0)) (skip-chars-backward " \r\t\n") - (and (not (looking-back "^\\*+" (line-beginning-position))) + (and (not (org-looking-back "^\\*+" (line-beginning-position))) (looking-at "[ \t]+") (replace-match "")) (unless (eobp) (forward-char 1)) (when (looking-at "^\\*") @@ -8475,9 +8475,9 @@ case." (insert (make-string (- ne-ins ne-beg) ?\n))) (move-marker ins-point nil) (if folded - (hide-subtree) + (outline-hide-subtree) (org-show-entry) - (show-children) + (outline-show-children) (org-cycle-hide-drawers 'children)) (org-clean-visibility-after-subtree-move) ;; move back to the initial column we were at @@ -8646,7 +8646,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard." (eq org-subtree-clip (current-kill 0)) org-subtree-clip-folded) ;; The tree was folded before it was killed/copied - (hide-subtree)) + (outline-hide-subtree)) (and for-yank (goto-char newend)) (and remove (setq kill-ring (cdr kill-ring)))))) @@ -8945,7 +8945,7 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." (point)) what "children") (goto-char start) - (show-subtree) + (outline-show-subtree) (outline-next-heading)) (t ;; we will sort the top-level entries in this file @@ -8961,7 +8961,7 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." (setq end (point-max)) (setq what "top-level") (goto-char start) - (show-all))) + (outline-show-all))) (setq beg (point)) (when (>= beg end) (goto-char start) (user-error "Nothing to sort")) @@ -9242,7 +9242,7 @@ buffer. It will also recognize item context in multiline items." outline-previous-visible-heading outline-promote outline-up-heading - show-children)) + outline-show-children)) (let ((f (or (car-safe cell) cell)) (disable-when-heading-prefix (cdr-safe cell))) (when (fboundp f) @@ -10443,7 +10443,9 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (unless (string-match "\\S-" desc) (setq desc nil)) (if remove (apply 'delete-region remove)) - (insert (org-make-link-string link desc)))) + (insert (org-make-link-string link desc)) + ;; Redisplay so as the new link has proper invisible characters. + (sit-for 0))) (defun org-link-try-special-completion (type) "If there is completion support for link type TYPE, offer it." @@ -11751,38 +11753,28 @@ such as the file name. SEPARATOR is inserted between the different parts of the path, the default is \"/\"." (setq width (or width 79)) - (if prefix (setq width (- width (length prefix)))) - (if (not path) - (or prefix "") - (let* ((nsteps (length path)) - (total-width (+ nsteps (apply '+ (mapcar 'length path)))) - (maxwidth (if (<= total-width width) - 10000 ;; everything fits - ;; we need to shorten the level headings - (/ (- width nsteps) nsteps))) - (org-odd-levels-only nil) - (n 0) - (total (1+ (length prefix)))) - (setq maxwidth (max maxwidth 10)) - (concat prefix - (if prefix (or separator "/")) - (mapconcat - (lambda (h) - (setq n (1+ n)) - (if (and (= n nsteps) (< maxwidth 10000)) - (setq maxwidth (- total-width total))) - (if (< (length h) maxwidth) - (progn (setq total (+ total (length h) 1)) h) - (setq h (substring h 0 (- maxwidth 2)) - total (+ total maxwidth 1)) - (if (string-match "[ \t]+\\'" h) - (setq h (substring h 0 (match-beginning 0)))) - (setq h (concat h ".."))) - (org-add-props h nil 'face - (nth (% (1- n) org-n-level-faces) - org-level-faces)) - h) - path (or separator "/")))))) + (setq path (delq nil path)) + (unless (> width 0) + (user-error "Argument `width' must be positive")) + (setq separator (or separator "/")) + (let* ((org-odd-levels-only nil) + (fpath (concat + prefix (and prefix path separator) + (mapconcat + (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) + (loop for head in path + for n from 0 + collect (org-add-props + head nil 'face + (nth (% n org-n-level-faces) org-level-faces))) + separator)))) + (when (> (length fpath) width) + (if (< width 7) + ;; It's unlikely that `width' will be this small, but don't + ;; waste characters by adding ".." if it is. + (setq fpath (substring fpath 0 width)) + (setf (substring fpath (- width 2)) ".."))) + fpath)) (defun org-display-outline-path (&optional file current separator just-return-string) "Display the current outline path in the echo area. @@ -12970,7 +12962,7 @@ statistics everywhere." (and (listp org-provide-todo-statistics) (stringp (car org-provide-todo-statistics)) (or (member kwd org-provide-todo-statistics) - (member kwd org-done-keywords))) + (member kwd org-done-keywords))) (and (listp org-provide-todo-statistics) (listp (car org-provide-todo-statistics)) (or (member kwd (car org-provide-todo-statistics)) @@ -12979,7 +12971,7 @@ statistics everywhere." (setq cnt-all (1+ cnt-all)) (if (eq org-provide-todo-statistics t) (and kwd (setq cnt-all (1+ cnt-all))))) - (when (or (and (member org-provide-todo-statistics '(t all-headlines)) + (when (or (and (member org-provide-todo-statistics '(t all-headlines)) (member kwd org-done-keywords)) (and (listp org-provide-todo-statistics) (listp (car org-provide-todo-statistics)) @@ -14012,7 +14004,7 @@ information." (org-show-entry) (org-with-limited-levels (case detail - ((tree canonical t) (show-children)) + ((tree canonical t) (outline-show-children)) ((nil minimal ancestors)) (t (save-excursion (outline-next-heading) @@ -14025,7 +14017,7 @@ information." (while (org-up-heading-safe) (org-flag-heading nil) (when (memq detail '(canonical t)) (org-show-entry)) - (when (memq detail '(tree canonical t)) (show-children))))))) + (when (memq detail '(tree canonical t)) (outline-show-children))))))) (defvar org-reveal-start-hook nil "Hook run before revealing a location.") @@ -15567,6 +15559,12 @@ but in some other way.") "Some properties that are used by Org mode for various purposes. Being in this list makes sure that they are offered for completion.") +(defun org--valid-property-p (property) + "Non nil when string PROPERTY is a valid property name." + (not + (or (equal property "") + (org-string-match-p "\\s-" property)))) + (defun org--update-property-plist (key val props) "Associate KEY to VAL in alist PROPS. Modifications are made by side-effect. Return new alist." @@ -16087,8 +16085,9 @@ and the new value.") (defun org-entry-put (pom property value) "Set PROPERTY to VALUE for entry at point-or-marker POM. -If the value is nil, it is converted to the empty string. If -it is not a string, an error is raised. +If the value is nil, it is converted to the empty string. If it +is not a string, an error is raised. Also raise an error on +invalid property names. PROPERTY can be any regular property (see `org-special-properties'). It can also be \"TODO\", @@ -16098,7 +16097,9 @@ For the last two properties, VALUE may have any of the special values \"earlier\" and \"later\". The function then increases or decreases scheduled or deadline date by one day." (cond ((null value) (setq value "")) - ((not (stringp value)) (error "Properties values should be strings"))) + ((not (stringp value)) (error "Properties values should be strings")) + ((not (org--valid-property-p property)) + (user-error "Invalid property name: \"%s\"" property))) (org-with-point-at pom (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p)) (org-back-to-heading t) @@ -16381,21 +16382,29 @@ When use-default, don't even ask, just use the last (defun org-set-property (property value) "In the current entry, set PROPERTY to VALUE. + When called interactively, this will prompt for a property name, offering completion on existing and default properties. And then it will prompt for a value, offering completion either on allowed values (via an inherited xxx_ALL property) or on existing values in other instances of this property -in the current file." +in the current file. + +Throw an error when trying to set a property with an invalid name." (interactive (list nil nil)) - (let* ((property (or property (org-read-property-name))) - (value (or value (org-read-property-value property))) - (fn (cdr (assoc property org-properties-postprocess-alist)))) - (setq org-last-set-property property) - (setq org-last-set-property-value (concat property ": " value)) - ;; Possibly postprocess the inserted value: - (when fn (setq value (funcall fn value))) - (unless (equal (org-entry-get nil property) value) - (org-entry-put nil property value)))) + (let ((property (or property (org-read-property-name)))) + ;; `org-entry-put' also makes the following check, but this one + ;; avoids polluting `org-last-set-property' and + ;; `org-last-set-property-value' needlessly. + (unless (org--valid-property-p property) + (user-error "Invalid property name: \"%s\"" property)) + (let ((value (or value (org-read-property-value property))) + (fn (cdr (assoc-string property org-properties-postprocess-alist t)))) + (setq org-last-set-property property) + (setq org-last-set-property-value (concat property ": " value)) + ;; Possibly postprocess the inserted value: + (when fn (setq value (funcall fn value))) + (unless (equal (org-entry-get nil property) value) + (org-entry-put nil property value))))) (defun org-find-property (property &optional value) "Find first entry in buffer that sets PROPERTY. @@ -16770,7 +16779,9 @@ So these are more for recording a certain time/date." (org-defkey map (kbd ".") (lambda () (interactive) ;; Are we at the beginning of the prompt? - (if (looking-back "^[^:]+: ") + (if (org-looking-back "^[^:]+: " + (let ((inhibit-field-text-motion t)) + (line-beginning-position))) (org-eval-in-calendar '(calendar-goto-today)) (insert ".")))) (org-defkey map (kbd "C-.") @@ -18063,7 +18074,8 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (message "No clock to adjust") (cond ((save-excursion ; fix previous clock? (re-search-backward org-ts-regexp0 nil t) - (org-looking-back (concat org-clock-string " \\["))) + (org-looking-back (concat org-clock-string " \\[") + (line-beginning-position))) (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$"))) ((save-excursion ; fix next clock? (re-search-backward org-ts-regexp0 nil t) @@ -18980,10 +18992,12 @@ removed, nil otherwise." (end (or end (point-max)))) (org-remove-if (lambda (o) - (and (>= (overlay-start o) beg) - (<= (overlay-end o) end) - (progn (delete-overlay o) - (or removedp (setq removedp t))))) + (cond ((not (overlay-buffer o)) (delete-overlay o) t) + ((and (>= (overlay-start o) beg) + (<= (overlay-end o) end)) + (delete-overlay o) + (unless removedp (setq removedp t))) + (t nil))) org-latex-fragment-image-overlays))) removedp)) @@ -19731,12 +19745,12 @@ boundaries." ;; Outline functions from `outline-mode-prefix-map' ;; that can be remapped in Org: (define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree) -(define-key org-mode-map [remap show-subtree] 'org-show-subtree) +(define-key org-mode-map [remap outline-show-subtree] 'org-show-subtree) (define-key org-mode-map [remap outline-forward-same-level] 'org-forward-heading-same-level) (define-key org-mode-map [remap outline-backward-same-level] 'org-backward-heading-same-level) -(define-key org-mode-map [remap show-branches] +(define-key org-mode-map [remap outline-show-branches] 'org-kill-note-or-show-branches) (define-key org-mode-map [remap outline-promote] 'org-promote-subtree) (define-key org-mode-map [remap outline-demote] 'org-demote-subtree) @@ -19859,7 +19873,7 @@ boundaries." ;; All the other keys -(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. +(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up. (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) (if (boundp 'narrow-map) (org-defkey narrow-map "s" 'org-narrow-to-subtree) @@ -20177,23 +20191,23 @@ overwritten, and the table is not marked as requiring realignment." ((and (org-table-p) (progn - ;; check if we blank the field, and if that triggers align + ;; Check if we blank the field, and if that triggers align. (and (featurep 'org-table) org-table-auto-blank-field (memq last-command '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) - (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) - ;; got extra space, this field does not determine column width + (if (or (eq (char-after) ?\s) (looking-at "[^|\n]* |")) + ;; Got extra space, this field does not determine + ;; column width. (let (org-table-may-need-update) (org-table-blank-field)) - ;; no extra space, this field may determine column width + ;; No extra space, this field may determine column + ;; width. (org-table-blank-field))) t) (eq N 1) - (looking-at "[^|\n]* |")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (backward-delete-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N))) + (looking-at "[^|\n]* \\( \\)|")) + ;; There is room for insertion without re-aligning the table. + (delete-region (match-beginning 1) (match-end 1)) + (self-insert-command N)) (t (setq org-table-may-need-update t) (self-insert-command N) @@ -20245,7 +20259,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." (if invisible-before-point (goto-char (previous-single-char-property-change (point) 'invisible))) - (show-subtree)) + (outline-show-subtree)) (cond ((eq org-catch-invisible-edits 'show) ;; That's it, we do the edit after showing @@ -21258,8 +21272,8 @@ Use \\[org-edit-special] to edit table.el tables")) (interactive) (if (not org-finish-function) (progn - (hide-subtree) - (call-interactively 'show-branches)) + (outline-hide-subtree) + (call-interactively 'outline-show-branches)) (let ((org-note-abort t)) (funcall org-finish-function)))) @@ -21322,25 +21336,23 @@ will not happen if point is in a table or on a \"dead\" object (e.g., within a comment). In these case, you need to use `org-open-at-point' directly." (interactive) - (let* ((context (if org-return-follows-link (org-element-context) - (org-element-at-point))) - (type (org-element-type context))) + (let ((context (if org-return-follows-link (org-element-context) + (org-element-at-point)))) (cond ;; In a table, call `org-table-next-row'. - ((or (and (eq type 'table) + ((or (and (eq (org-element-type context) 'table) (>= (point) (org-element-property :contents-begin context)) (< (point) (org-element-property :contents-end context))) (org-element-lineage context '(table-row table-cell) t)) (org-table-justify-field-maybe) (call-interactively #'org-table-next-row)) - ;; On a link or a timestamp but not on white spaces after it, - ;; call `org-open-line' if `org-return-follows-link' allows it. + ;; On a link or a timestamp, call `org-open-line' if + ;; `org-return-follows-link' allows it. Tolerate fuzzy + ;; locations, e.g., in a comment, as `org-open-line'. ((and org-return-follows-link - (memq type '(link timestamp)) - (< (point) - (save-excursion (goto-char (org-element-property :end context)) - (skip-chars-backward " \t") - (point)))) + (or (org-at-timestamp-p t) + (org-at-date-range-p t) + (org-in-regexp org-any-link-re))) (call-interactively #'org-open-at-point)) ;; Insert newline in heading, but preserve tags. ((and (not (bolp)) @@ -21735,7 +21747,7 @@ on context. See the individual commands for more information." ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] ["Sparse Tree..." org-sparse-tree t] ["Reveal Context" org-reveal t] - ["Show All" show-all t] + ["Show All" outline-show-all t] "--" ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) "--" @@ -24131,7 +24143,7 @@ interactive command with similar behavior." (or (looking-at org-outline-regexp) (re-search-forward org-outline-regexp-bol end t)) (while (and (< (point) end) (looking-at org-outline-regexp)) - (hide-subtree) + (outline-hide-subtree) (org-cycle-show-empty-lines 'folded) (condition-case nil (outline-forward-same-level 1) diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index 5cc70bd..2dfd5b8 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -921,14 +921,17 @@ channel." (format "[%s] %s" anchor - (if (not dest) (org-ascii--translate "Unknown reference" info) + (if (stringp dest) ; External file. + dest (format (org-ascii--translate "See section %s" info) (if (org-export-numbered-headline-p dest info) (mapconcat #'number-to-string - (org-export-get-headline-number dest info) ".") + (org-export-get-headline-number dest info) + ".") (org-export-data (org-element-property :title dest) info))))) - width info) "\n\n"))) + width info) + "\n\n"))) ;; Do not add a link that cannot be resolved and doesn't have ;; any description: destination is already visible in the ;; paragraph. diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el index 3119bd4..4db312e 100644 --- a/lisp/ox-beamer.el +++ b/lisp/ox-beamer.el @@ -331,13 +331,17 @@ channel." INFO is a plist used as a communication channel. The value is either the label specified in \"BEAMER_opt\" -property, or a fallback value built from headline's number. This -function assumes HEADLINE will be treated as a frame." +property, or a unique internal label. This function assumes +HEADLINE will be treated as a frame." (let ((opt (org-element-property :BEAMER_OPT headline))) (if (and (stringp opt) (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt)) - (match-string 1 opt) - (format "{sec:%s}" (org-export-get-reference headline info))))) + (let ((label (match-string 1 opt))) + ;; Strip protective braces, if any. + (if (org-string-match-p "\\`{.*}\\'" label) + (substring label 1 -1) + label)) + (format "sec:%s" (org-export-get-reference headline info))))) (defun org-beamer--frame-level (headline info) "Return frame level in subtree containing HEADLINE. @@ -441,8 +445,13 @@ used as a communication channel." (or (string-match "\\(^\\|,\\)label=" beamer-opt) (string-match "allowframebreaks" beamer-opt))) (list - (format "label=%s" - (org-beamer--get-label headline info))))))) + (let ((label (org-beamer--get-label headline info))) + ;; Labels containing colons need to be + ;; wrapped within braces. + (format (if (org-string-match-p ":" label) + "label={%s}" + "label=%s") + label))))))) ;; Change options list into a string. (org-beamer--normalize-argument (mapconcat @@ -597,28 +606,27 @@ as a communication channel." (when overlay (org-beamer--normalize-argument overlay - (if (string-match "^\\[.*\\]$" overlay) 'defaction + (if (string-match "\\`\\[.*\\]\\'" overlay) 'defaction 'action)))) ;; Options. (let ((options (org-element-property :BEAMER_OPT headline))) (when options (org-beamer--normalize-argument options 'option))) ;; Resolve reference provided by "BEAMER_ref" - ;; property. This is done by building a minimal fake - ;; link and calling the appropriate resolve function, - ;; depending on the reference syntax. - (let* ((type - (progn - (string-match "^\\(id:\\|#\\|\\*\\)?\\(.*\\)" ref) - (cond - ((or (not (match-string 1 ref)) - (equal (match-string 1 ref) "*")) 'fuzzy) - ((equal (match-string 1 ref) "id:") 'id) - (t 'custom-id)))) - (link (list 'link (list :path (match-string 2 ref)))) - (target (if (eq type 'fuzzy) - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) + ;; property. This is done by building a minimal + ;; fake link and calling the appropriate resolve + ;; function, depending on the reference syntax. + (let ((target + (if (string-match "\\`\\(id:\\|#\\)" ref) + (org-export-resolve-id-link + `(link (:path ,(substring ref (match-end 0)))) + info) + (org-export-resolve-fuzzy-link + `(link (:path + ;; Look for headlines only. + ,(if (eq (string-to-char ref) ?*) ref + (concat "*" ref)))) + info)))) ;; Now use user-defined label provided in TARGET ;; headline, or fallback to standard one. (format "{%s}" (org-beamer--get-label target info))))))) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index 960bee8..a2db938 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -1088,10 +1088,10 @@ linebreaks Let MathJax perform automatic linebreaks. Valid values indent If align is not center, how far from the left/right side? Valid values are \"left\" and \"right\" multlinewidth The width of the multline environment. -autonumber How to number equations. Valid values are \"None\", +autonumber How to number equations. Valid values are \"None\", \"all\" and \"AMS Math\". tagindent The amount tags are indented. -tagside Which side to show tags/labels on. Valid values are +tagside Which side to show tags/labels on. Valid values are \"left\" and \"right\" You can also customize this for each buffer, using something like @@ -1116,14 +1116,14 @@ MathJax CDN Terms of Service. (list :tag "align (alignment of displayed equations)" (const :format " " align) (string)) (list :tag "font (used to display math)" - (const :format " " font) - (choice (const "TeX") - (const "STIX-Web") - (const "Asana-Math") - (const "Neo-Euler") - (const "Gyre-Pagella") - (const "Gyre-Termes") - (const "Latin-Modern"))) + (const :format " " font) + (choice (const "TeX") + (const "STIX-Web") + (const "Asana-Math") + (const "Neo-Euler") + (const "Gyre-Pagella") + (const "Gyre-Termes") + (const "Latin-Modern"))) (list :tag "linebreaks (automatic line-breaking)" (const :format " " linebreaks) (choice (const "true") diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el index aefddf8..29ba409 100644 --- a/lisp/ox-icalendar.el +++ b/lisp/ox-icalendar.el @@ -77,7 +77,7 @@ for timed events. If non-zero, alarms are created. (defcustom org-icalendar-exclude-tags nil "Tags that exclude a tree from export. This variable allows to specify different exclude tags from other -back-ends. It can also be set with the ICAL_EXCLUDE_TAGS +back-ends. It can also be set with the ICALENDAR_EXCLUDE_TAGS keyword." :group 'org-export-icalendar :type '(repeat (string :tag "Tag"))) @@ -901,7 +901,9 @@ This function assumes major mode for current buffer is (buffer-substring (point) (progn (outline-next-heading) (point))))))))) (forward-line))))) - 'icalendar t '(:ascii-charset utf-8 :ascii-links-to-notes nil)))) + 'icalendar t + '(:ascii-charset utf-8 :ascii-links-to-notes nil + :icalendar-include-todo all)))) (with-temp-file file (insert (org-icalendar--vcalendar diff --git a/lisp/ox-org.el b/lisp/ox-org.el index b395577..5b93104 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -298,7 +298,7 @@ Return output file name." newbuf) (with-current-buffer work-buffer (font-lock-ensure) - (show-all) + (outline-show-all) (org-show-block-all) (setq newbuf (htmlize-buffer))) (with-current-buffer newbuf diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el index 20cacf9..2ec4137 100644 --- a/lisp/ox-publish.el +++ b/lisp/ox-publish.el @@ -1229,7 +1229,7 @@ If FREE-CACHE, empty the cache." (setq org-publish-cache nil)) (defun org-publish-cache-file-needs-publishing - (filename &optional pub-dir pub-func base-dir) + (filename &optional pub-dir pub-func base-dir) "Check the timestamp of the last publishing of FILENAME. Return non-nil if the file needs publishing. Also check if any included files have been more recently published, so that @@ -1250,12 +1250,18 @@ the file including them will be republished as well." (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t) (let* ((element (org-element-at-point)) (included-file - (and (eq (org-element-type element) 'keyword) - (let ((value (org-element-property :value element))) - (and value - (string-match "^\\(\".+?\"\\|\\S-+\\)" value) - (org-remove-double-quotes - (match-string 1 value))))))) + (and (eq (org-element-type element) 'keyword) + (let ((value (org-element-property :value element))) + (and value + (string-match + "\\`\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" + value) + (let ((m (match-string 1 value))) + (org-remove-double-quotes + ;; Ignore search suffix. + (if (string-match "\\(::\\(.*?\\)\\)\"?\\'" m) + (substring m 0 (match-beginning 0)) + m)))))))) (when included-file (add-to-list 'included-files-ctime (org-publish-cache-ctime-of-src @@ -2588,25 +2588,45 @@ The function assumes BUFFER's major mode is `org-mode'." "Delete commented areas in the buffer. Commented areas are comments, comment blocks, commented trees and inlinetasks. Trailing blank lines after a comment or a comment -block are preserved. Narrowing, if any, is ignored." +block are removed, as long as it doesn't alter the structure of +the document. Narrowing, if any, is ignored." (org-with-wide-buffer (goto-char (point-min)) - (let ((regexp (concat org-outline-regexp-bol ".*" org-comment-string - "\\|" - "^[ \t]*#\\(?: \\|$\\|\\+begin_comment\\)")) - (case-fold-search t)) + (let* ((case-fold-search t) + (comment-re "^[ \t]*#\\(?: \\|$\\|\\+end_comment\\)") + (regexp (concat org-outline-regexp-bol ".*" org-comment-string "\\|" + comment-re))) (while (re-search-forward regexp nil t) - (let ((e (org-element-at-point))) - (case (org-element-type e) - ((comment comment-block) - (delete-region (org-element-property :begin e) - (progn (goto-char (org-element-property :end e)) - (skip-chars-backward " \r\t\n") - (line-beginning-position 2)))) + (let ((element (org-element-at-point))) + (case (org-element-type element) ((headline inlinetask) - (when (org-element-property :commentedp e) - (delete-region (org-element-property :begin e) - (org-element-property :end e)))))))))) + (when (org-element-property :commentedp element) + (delete-region (org-element-property :begin element) + (org-element-property :end element)))) + ((comment comment-block) + (let* ((parent (org-element-property :parent element)) + (start (org-element-property :begin element)) + (end (org-element-property :end element)) + ;; We remove trailing blank lines. Doing so could + ;; modify the structure of the document. Therefore + ;; we ensure that any comment between elements is + ;; replaced with one empty line, so as to keep them + ;; separated. + (add-blank? + (save-excursion + (goto-char start) + (not (or (bobp) + (eq (org-element-property :contents-begin parent) + start) + (eq (org-element-property :contents-end parent) + end) + (progn + (forward-line -1) + (or (org-looking-at-p "^[ \t]*$") + (org-with-limited-levels + (org-at-heading-p))))))))) + (delete-region start end) + (when add-blank? (insert "\n")))))))))) (defun org-export--prune-tree (data info) "Prune non exportable elements from DATA. @@ -2737,7 +2757,7 @@ returned by the function." (when new ;; Splice NEW at BLOB location in parse tree. (dolist (e new (org-element-extract-element blob)) - (unless (string= e "") (org-element-insert-before e blob)))))) + (unless (equal e "") (org-element-insert-before e blob)))))) info nil nil t) ;; Return modified parse tree. data) @@ -5054,105 +5074,115 @@ Return a list of src-block elements with a caption." ;; 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{}") + (primary-opening + :utf-8 "»" :html "»" :latex ">>" :texinfo "@guillemetright{}") + (primary-closing + :utf-8 "«" :html "«" :latex "<<" :texinfo "@guillemetleft{}") + (secondary-opening + :utf-8 "›" :html "›" :latex "\\frq{}" :texinfo "@guilsinglright{}") + (secondary-closing + :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 "\"'" - :texinfo "@quotedblleft{}") - (opening-single-quote :utf-8 "‚" :html "‚" :latex "\\glq{}" - :texinfo "@quotesinglbase{}") - (closing-single-quote :utf-8 "‘" :html "‘" :latex "\\grq{}" - :texinfo "@quoteleft{}") + (primary-opening + :utf-8 "„" :html "„" :latex "\"`" :texinfo "@quotedblbase{}") + (primary-closing + :utf-8 "“" :html "“" :latex "\"'" :texinfo "@quotedblleft{}") + (secondary-opening + :utf-8 "‚" :html "‚" :latex "\\glq{}" :texinfo "@quotesinglbase{}") + (secondary-closing + :utf-8 "‘" :html "‘" :latex "\\grq{}" :texinfo "@quoteleft{}") (apostrophe :utf-8 "’" :html "’")) ("en" - (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 "'") + (primary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (primary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'") (apostrophe :utf-8 "’" :html "’")) ("es" - (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 "''") + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (secondary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''") (apostrophe :utf-8 "’" :html "’")) ("fr" - (opening-double-quote :utf-8 "« " :html "« " :latex "\\og " - :texinfo "@guillemetleft{}@tie{}") - (closing-double-quote :utf-8 " »" :html " »" :latex "\\fg{}" - :texinfo "@tie{}@guillemetright{}") - (opening-single-quote :utf-8 "« " :html "« " :latex "\\og " - :texinfo "@guillemetleft{}@tie{}") - (closing-single-quote :utf-8 " »" :html " »" :latex "\\fg{}" - :texinfo "@tie{}@guillemetright{}") + (primary-opening + :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (primary-closing + :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") + (secondary-opening + :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (secondary-closing :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") (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 "'") + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (secondary-closing :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 "'") + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (secondary-closing :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 "'") + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'") (apostrophe :utf-8 "’" :html "’")) ("ru" ;; http://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5 ;; http://www.artlebedev.ru/kovodstvo/sections/104/ - (opening-double-quote :utf-8 "«" :html "«" :latex "{}<<" - :texinfo "@guillemetleft{}") - (closing-double-quote :utf-8 "»" :html "»" :latex ">>{}" - :texinfo "@guillemetright{}") - (opening-single-quote :utf-8 "„" :html "„" :latex "\\glqq{}" - :texinfo "@quotedblbase{}") - (closing-single-quote :utf-8 "“" :html "“" :latex "\\grqq{}" - :texinfo "@quotedblleft{}") + (primary-opening :utf-8 "«" :html "«" :latex "{}<<" + :texinfo "@guillemetleft{}") + (primary-closing :utf-8 "»" :html "»" :latex ">>{}" + :texinfo "@guillemetright{}") + (secondary-opening + :utf-8 "„" :html "„" :latex "\\glqq{}" :texinfo "@quotedblbase{}") + (secondary-closing + :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") (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 "’")) - ) + (primary-opening :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (primary-closing :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (secondary-opening :utf-8 "’" :html "’" :latex "’" :texinfo "`") + (secondary-closing :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 quote type as key and a plist associating various encodings to their translation as value. -A quote type can be any symbol among `opening-double-quote', -`closing-double-quote', `opening-single-quote', -`closing-single-quote' and `apostrophe'. +A quote type can be any symbol among `primary-opening', +`primary-closing', `secondary-opening', `secondary-closing' and +`apostrophe'. Valid encodings include `:utf-8', `:html', `:latex' and `:texinfo'. @@ -5178,7 +5208,7 @@ INFO is the current export state, as a plist." (cond ((equal (match-string 0 text) "\"") (setf level1-open (not level1-open)) - (if level1-open 'opening-double-quote 'closing-double-quote)) + (if level1-open 'primary-opening 'primary-closing)) ;; Not already in a level 1 quote: this is an ;; apostrophe. ((not level1-open) 'apostrophe) @@ -5223,8 +5253,8 @@ INFO is the current export state, as a plist." (memq next '(blank nil)))))) (cond ((and allow-open allow-close) (error "Should not happen")) - (allow-open 'opening-single-quote) - (allow-close 'closing-single-quote) + (allow-open 'secondary-opening) + (allow-close 'secondary-closing) (t 'apostrophe))))) current-status) (setq start (1+ start))) diff --git a/mk/version.mk b/mk/version.mk index 284aff6..efb2985 100644 --- a/mk/version.mk +++ b/mk/version.mk @@ -1,2 +1,2 @@ -ORGVERSION ?= 8.3.2 -GITVERSION ?= 8.3.2-dist +ORGVERSION ?= 8.3.3 +GITVERSION ?= 8.3.3-dist |