diff options
author | Bastien <bzg@gnu.org> | 2018-04-29 16:02:07 +0200 |
---|---|---|
committer | Bastien <bzg@gnu.org> | 2018-04-29 16:02:07 +0200 |
commit | 4aa251388279a0ffe7a3f6e721705f327b4d7316 (patch) | |
tree | c407caabd5ff2024064ee866c77a6d167b66d13a | |
parent | dc4896aeef88a5e08a1a66b2470e7c70737471c7 (diff) | |
parent | 61cfd675f3d486106afe6776b9e6e549505a6720 (diff) | |
download | org-mode-4aa251388279a0ffe7a3f6e721705f327b4d7316.tar.gz |
Merge branch 'master' of code.orgmode.org:bzg/org-mode
-rw-r--r-- | doc/org-manual.org | 5 | ||||
-rw-r--r-- | lisp/org-clock.el | 162 | ||||
-rw-r--r-- | lisp/org-colview.el | 52 | ||||
-rw-r--r-- | lisp/org-compat.el | 79 | ||||
-rw-r--r-- | lisp/org-indent.el | 62 | ||||
-rw-r--r-- | lisp/org-list.el | 2 | ||||
-rw-r--r-- | lisp/org-macro.el | 1 | ||||
-rw-r--r-- | lisp/org-macs.el | 725 | ||||
-rw-r--r-- | lisp/org.el | 166 | ||||
-rw-r--r-- | testing/examples/babel.org | 26 |
10 files changed, 631 insertions, 649 deletions
diff --git a/doc/org-manual.org b/doc/org-manual.org index 049ffaf..5012980 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -11799,6 +11799,11 @@ Org comes with following pre-defined macros: specified counter is reset to 1. You may leave {{{var(NAME)}}} empty to reset the default counter. +#+cindex: @samp{results}, macro +Moreover, inline source blocks (see [[*Structure of Code Blocks]]) use the +special =results= macro to mark their output. As such, you are +advised against re-defining it, unless you know what you are doing. + #+vindex: org-hide-macro-markers The surrounding brackets can be made invisible by setting ~org-hide-macro-markers~ non-~nil~. diff --git a/lisp/org-clock.el b/lisp/org-clock.el index eb5f923..d727fa1 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1788,87 +1788,87 @@ HEADLINE-FILTER is a zero-arg function that, if specified, is called for each headline in the time range with point at the headline. Headlines for which HEADLINE-FILTER returns nil are excluded from the clock summation. PROPNAME lets you set a custom text property instead of :org-clock-minutes." - (org-with-silent-modifications - (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" - org-clock-string - "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) - (lmax 30) - (ltimes (make-vector lmax 0)) - (level 0) - (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart)) - ((consp tstart) (float-time tstart)) - (t tstart))) - (tend (cond ((stringp tend) (org-time-string-to-seconds tend)) - ((consp tend) (float-time tend)) - (t tend))) - (t1 0) - time) - (remove-text-properties (point-min) (point-max) - `(,(or propname :org-clock-minutes) t - :org-clock-force-headline-inclusion t)) - (save-excursion - (goto-char (point-max)) - (while (re-search-backward re nil t) - (cond - ((match-end 2) - ;; Two time stamps. - (let* ((ts (float-time - (apply #'encode-time - (save-match-data - (org-parse-time-string (match-string 2)))))) - (te (float-time - (apply #'encode-time - (org-parse-time-string (match-string 3))))) - (dt (- (if tend (min te tend) te) - (if tstart (max ts tstart) ts)))) - (when (> dt 0) (cl-incf t1 (floor (/ dt 60)))))) - ((match-end 4) - ;; A naked time. - (setq t1 (+ t1 (string-to-number (match-string 5)) - (* 60 (string-to-number (match-string 4)))))) - (t ;A headline - ;; Add the currently clocking item time to the total. - (when (and org-clock-report-include-clocking-task - (eq (org-clocking-buffer) (current-buffer)) - (eq (marker-position org-clock-hd-marker) (point)) - tstart - tend - (>= (float-time org-clock-start-time) tstart) - (<= (float-time org-clock-start-time) tend)) - (let ((time (floor (- (float-time) - (float-time org-clock-start-time)) - 60))) - (setq t1 (+ t1 time)))) - (let* ((headline-forced - (get-text-property (point) - :org-clock-force-headline-inclusion)) - (headline-included - (or (null headline-filter) - (save-excursion - (save-match-data (funcall headline-filter)))))) - (setq level (- (match-end 1) (match-beginning 1))) - (when (>= level lmax) - (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax))) - (when (or (> t1 0) (> (aref ltimes level) 0)) - (when (or headline-included headline-forced) - (if headline-included - (cl-loop for l from 0 to level do - (aset ltimes l (+ (aref ltimes l) t1)))) - (setq time (aref ltimes level)) - (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) - (or propname :org-clock-minutes) time) - (when headline-filter - (save-excursion - (save-match-data - (while (org-up-heading-safe) - (put-text-property - (point) (line-end-position) - :org-clock-force-headline-inclusion t)))))) - (setq t1 0) - (cl-loop for l from level to (1- lmax) do - (aset ltimes l 0))))))) - (setq org-clock-file-total-minutes (aref ltimes 0)))))) + (with-silent-modifications + (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" + org-clock-string + "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) + (lmax 30) + (ltimes (make-vector lmax 0)) + (level 0) + (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart)) + ((consp tstart) (float-time tstart)) + (t tstart))) + (tend (cond ((stringp tend) (org-time-string-to-seconds tend)) + ((consp tend) (float-time tend)) + (t tend))) + (t1 0) + time) + (remove-text-properties (point-min) (point-max) + `(,(or propname :org-clock-minutes) t + :org-clock-force-headline-inclusion t)) + (save-excursion + (goto-char (point-max)) + (while (re-search-backward re nil t) + (cond + ((match-end 2) + ;; Two time stamps. + (let* ((ts (float-time + (apply #'encode-time + (save-match-data + (org-parse-time-string (match-string 2)))))) + (te (float-time + (apply #'encode-time + (org-parse-time-string (match-string 3))))) + (dt (- (if tend (min te tend) te) + (if tstart (max ts tstart) ts)))) + (when (> dt 0) (cl-incf t1 (floor (/ dt 60)))))) + ((match-end 4) + ;; A naked time. + (setq t1 (+ t1 (string-to-number (match-string 5)) + (* 60 (string-to-number (match-string 4)))))) + (t ;A headline + ;; Add the currently clocking item time to the total. + (when (and org-clock-report-include-clocking-task + (eq (org-clocking-buffer) (current-buffer)) + (eq (marker-position org-clock-hd-marker) (point)) + tstart + tend + (>= (float-time org-clock-start-time) tstart) + (<= (float-time org-clock-start-time) tend)) + (let ((time (floor (- (float-time) + (float-time org-clock-start-time)) + 60))) + (setq t1 (+ t1 time)))) + (let* ((headline-forced + (get-text-property (point) + :org-clock-force-headline-inclusion)) + (headline-included + (or (null headline-filter) + (save-excursion + (save-match-data (funcall headline-filter)))))) + (setq level (- (match-end 1) (match-beginning 1))) + (when (>= level lmax) + (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax))) + (when (or (> t1 0) (> (aref ltimes level) 0)) + (when (or headline-included headline-forced) + (if headline-included + (cl-loop for l from 0 to level do + (aset ltimes l (+ (aref ltimes l) t1)))) + (setq time (aref ltimes level)) + (goto-char (match-beginning 0)) + (put-text-property (point) (point-at-eol) + (or propname :org-clock-minutes) time) + (when headline-filter + (save-excursion + (save-match-data + (while (org-up-heading-safe) + (put-text-property + (point) (line-end-position) + :org-clock-force-headline-inclusion t)))))) + (setq t1 0) + (cl-loop for l from level to (1- lmax) do + (aset ltimes l 0))))))) + (setq org-clock-file-total-minutes (aref ltimes 0)))))) (defun org-clock-sum-current-item (&optional tstart) "Return time, clocked on current item in total." diff --git a/lisp/org-colview.el b/lisp/org-colview.el index cf63148..bba8c14 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -411,14 +411,14 @@ DATELINE is non-nil when the face used should be (line-beginning-position 2)))) (overlay-put ov 'keymap org-columns-map) (push ov org-columns-overlays)) - (org-with-silent-modifications - (let ((inhibit-read-only t)) - (put-text-property - (line-end-position 0) - (line-beginning-position 2) - 'read-only - (substitute-command-keys - "Type \\<org-columns-map>`\\[org-columns-edit-value]' \ + (with-silent-modifications + (let ((inhibit-read-only t)) + (put-text-property + (line-end-position 0) + (line-beginning-position 2) + 'read-only + (substitute-command-keys + "Type \\<org-columns-map>`\\[org-columns-edit-value]' \ to edit property"))))))) (defun org-columns-add-ellipses (string width) @@ -491,11 +491,11 @@ for the duration of the command.") (set-marker org-columns-begin-marker nil) (when (markerp org-columns-top-level-marker) (set-marker org-columns-top-level-marker nil)) - (org-with-silent-modifications - (mapc #'delete-overlay org-columns-overlays) - (setq org-columns-overlays nil) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) + (with-silent-modifications + (mapc #'delete-overlay org-columns-overlays) + (setq org-columns-overlays nil) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t)))) (when org-columns-flyspell-was-active (flyspell-mode 1)) (when (local-variable-p 'org-colview-initial-truncate-line-value) @@ -520,10 +520,10 @@ for the duration of the command.") (defun org-columns-quit () "Remove the column overlays and in this way exit column editing." (interactive) - (org-with-silent-modifications - (org-columns-remove-overlays) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) + (with-silent-modifications + (org-columns-remove-overlays) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t)))) (if (not (eq major-mode 'org-agenda-mode)) (setq org-columns-current-fmt nil) (setq org-agenda-columns-active nil) @@ -622,8 +622,8 @@ Where possible, use the standard interface for changing this line." (org-agenda-columns))) (t (let ((inhibit-read-only t)) - (org-with-silent-modifications - (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) + (with-silent-modifications + (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) (org-columns--call action)) ;; Some properties can modify headline (e.g., "TODO"), and ;; possible shuffle overlays. Make sure they are still all at @@ -1170,9 +1170,9 @@ properties drawers." (old (assoc spec summaries-alist))) (if old (setcdr old summary) (push (cons spec summary) summaries-alist) - (org-with-silent-modifications - (add-text-properties - pos (1+ pos) (list 'org-summaries summaries-alist))))) + (with-silent-modifications + (add-text-properties + pos (1+ pos) (list 'org-summaries summaries-alist))))) ;; When PROPERTY exists in current node, even if empty, ;; but its value doesn't match the one computed, use ;; the latter instead. @@ -1208,8 +1208,8 @@ column specification." (defun org-columns-compute-all () "Compute all columns that have operators defined." - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) (let ((org-columns--time (float-time (current-time))) seen) (dolist (spec org-columns-current-fmt-compiled) @@ -1638,8 +1638,8 @@ This will add overlays to the date lines, to show the summary for each day." (let ((b (find-buffer-visiting file))) (with-current-buffer (or (buffer-base-buffer b) b) (org-with-wide-buffer - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) (goto-char (point-min)) (org-columns-get-format-and-top-level) (dolist (spec fmt) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 66854fa..0739f0f 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -35,6 +35,7 @@ (declare-function org-agenda-diary-entry "org-agenda") (declare-function org-agenda-maybe-redo "org-agenda" ()) (declare-function org-agenda-remove-restriction-lock "org-agenda" (&optional noupdate)) +(declare-function org-align-tags "org" (&optional all)) (declare-function org-at-heading-p "org" (&optional ignored)) (declare-function org-at-table.el-p "org" ()) (declare-function org-element-at-point "org-element" ()) @@ -43,10 +44,12 @@ (declare-function org-element-type "org-element" (element)) (declare-function org-element-property "org-element" (property element)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(declare-function org-get-tags "org" (&optional pos local)) (declare-function org-invisible-p "org" (&optional pos)) (declare-function org-link-display-format "org" (s)) (declare-function org-link-set-parameters "org" (type &rest rest)) (declare-function org-log-into-drawer "org" ()) +(declare-function org-make-tag-string "org" (tags)) (declare-function org-reduced-level "org" (l)) (declare-function org-show-context "org" (&optional key)) (declare-function org-table-end "org-table" (&optional table-type)) @@ -110,7 +113,7 @@ Case is significant." ;;; Obsolete aliases (remove them after the next major release). ;;;; XEmacs compatibility, now removed. -(define-obsolete-function-alias 'org-activate-mark 'activate-mark) +(define-obsolete-function-alias 'org-activate-mark 'activate-mark "Org 9.0") (define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0") (define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0") (define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0") @@ -283,13 +286,13 @@ See `org-link-parameters' for documentation on the other parameters." ;; Not used since commit 6d1e3082, Feb 2010. (make-obsolete 'org-table-recognize-table.el - "please notify the Org mailing list if you use this function." + "please notify Org mailing list if you use this function." "Org 9.0") (defmacro org-preserve-lc (&rest body) (declare (debug (body)) - (obsolete "please notify the Org mailing list if you use this function." - "Org 9.0")) + (obsolete "please notify Org mailing list if you use this function." + "Org 9.2")) (org-with-gensyms (line col) `(let ((,line (org-current-line)) (,col (current-column))) @@ -298,6 +301,12 @@ See `org-link-parameters' for documentation on the other parameters." (org-goto-line ,line) (org-move-to-column ,col))))) +(defun org-version-check (version &rest _) + "Non-nil if VERSION is lower (older) than `emacs-version'." + (declare (obsolete "use `version<' or `fboundp' instead." + "Org 9.2")) + (version< version emacs-version)) + (defun org-remove-angle-brackets (s) (org-unbracket-string "<" ">" s)) (make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0") @@ -430,6 +439,11 @@ use of this function is for the stuck project list." (declare (obsolete "use `org-align-tags' instead." "Org 9.2")) (org-align-tags t)) +(defmacro org-with-silent-modifications (&rest body) + (declare (obsolete "use `with-silent-modifications' instead." "9.2") + (debug (body))) + `(with-silent-modifications ,@body)) + ;;;; Obsolete link types (eval-after-load 'org @@ -441,30 +455,6 @@ use of this function is for the stuck project list." ;;; Miscellaneous functions -(defun org-version-check (version feature level) - (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) - (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) - (rmaj (or (nth 0 v1) 99)) - (rmin (or (nth 1 v1) 99)) - (rbld (or (nth 2 v1) 99)) - (maj (or (nth 0 v2) 0)) - (min (or (nth 1 v2) 0)) - (bld (or (nth 2 v2) 0))) - (if (or (< maj rmaj) - (and (= maj rmaj) - (< min rmin)) - (and (= maj rmaj) - (= min rmin) - (< bld rbld))) - (if (eq level :predicate) - ;; just return if we have the version - nil - (let ((msg (format "Emacs %s or greater is recommended for %s" - version feature))) - (display-warning 'org msg level) - t)) - t))) - (defun org-get-x-clipboard (value) "Get the value of the X or Windows clipboard." (cond ((and (eq window-system 'x) @@ -478,23 +468,6 @@ use of this function is for the stuck project list." ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) (w32-get-clipboard-data)))) -(defun org-fit-window-to-buffer (&optional window max-height min-height - shrink-only) - "Fit WINDOW to the buffer, but only if it is not a side-by-side window. -WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are -passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call -`shrink-window-if-larger-than-buffer' instead, the height limit is -ignored in this case." - (cond ((if (fboundp 'window-full-width-p) - (not (window-full-width-p window)) - ;; do nothing if another window would suffer - (> (frame-width) (window-width window)))) - ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) - (fit-window-to-buffer window max-height min-height)) - ((fboundp 'shrink-window-if-larger-than-buffer) - (shrink-window-if-larger-than-buffer window))) - (or window (selected-window))) - ;; `set-transient-map' is only in Emacs >= 24.4 (defalias 'org-set-transient-map (if (fboundp 'set-transient-map) @@ -576,14 +549,9 @@ Pass COLUMN and FORCE to `move-to-column'." (or (file-remote-p file 'localname) file)))) (defmacro org-no-popups (&rest body) - "Suppress popup windows. -Let-bind some variables to nil around BODY to achieve the desired -effect, which variables to use depends on the Emacs version." - (if (org-version-check "24.2.50" "" :predicate) - `(let (pop-up-frames display-buffer-alist) - ,@body) - `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) - ,@body))) + "Suppress popup windows and evaluate BODY." + `(let (pop-up-frames display-buffer-alist) + ,@body)) ;;;###autoload (defmacro org-check-version () @@ -603,11 +571,6 @@ effect, which variables to use depends on the Emacs version." (defun org-release () "N/A") (defun org-git-version () "N/A !!check installation!!")))))) -(defmacro org-with-silent-modifications (&rest body) - (if (fboundp 'with-silent-modifications) - `(with-silent-modifications ,@body) - `(org-unmodified ,@body))) -(def-edebug-spec org-with-silent-modifications (body)) ;;; Functions for Emacs < 24.4 compatibility diff --git a/lisp/org-indent.el b/lisp/org-indent.el index 84bac2a..38c5f07 100644 --- a/lisp/org-indent.el +++ b/lisp/org-indent.el @@ -157,8 +157,8 @@ useful to make it ever so slightly different." (defsubst org-indent-remove-properties (beg end) "Remove indentations between BEG and END." - (org-with-silent-modifications - (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) + (with-silent-modifications + (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) ;;;###autoload (define-minor-mode org-indent-mode @@ -329,35 +329,35 @@ stopped." ;; For each line, set `line-prefix' and `wrap-prefix' ;; properties depending on the type of line (headline, inline ;; task, item or other). - (org-with-silent-modifications - (while (and (<= (point) end) (not (eobp))) - (cond - ;; When in asynchronous mode, check if interrupt is - ;; required. - ((and delay (input-pending-p)) (throw 'interrupt (point))) - ;; In asynchronous mode, take a break of - ;; `org-indent-agent-resume-delay' every DELAY to avoid - ;; blocking any other idle timer or process output. - ((and delay (time-less-p time-limit (current-time))) - (setq org-indent-agent-resume-timer - (run-with-idle-timer - (time-add (current-idle-time) org-indent-agent-resume-delay) - nil #'org-indent-initialize-agent)) - (throw 'interrupt (point))) - ;; Headline or inline task. - ((looking-at org-outline-regexp) - (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) - (type (or (looking-at-p limited-re) 'inlinetask))) - (org-indent-set-line-properties nstars 0 type) - ;; At an headline, define new value for LEVEL. - (unless (eq type 'inlinetask) (setq level nstars)))) - ;; List item: `wrap-prefix' is set where body starts. - ((org-at-item-p) - (org-indent-set-line-properties - level (org-list-item-body-column (point)))) - ;; Regular line. - (t - (org-indent-set-line-properties level (org-get-indentation)))))))))) + (with-silent-modifications + (while (and (<= (point) end) (not (eobp))) + (cond + ;; When in asynchronous mode, check if interrupt is + ;; required. + ((and delay (input-pending-p)) (throw 'interrupt (point))) + ;; In asynchronous mode, take a break of + ;; `org-indent-agent-resume-delay' every DELAY to avoid + ;; blocking any other idle timer or process output. + ((and delay (time-less-p time-limit (current-time))) + (setq org-indent-agent-resume-timer + (run-with-idle-timer + (time-add (current-idle-time) org-indent-agent-resume-delay) + nil #'org-indent-initialize-agent)) + (throw 'interrupt (point))) + ;; Headline or inline task. + ((looking-at org-outline-regexp) + (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) + (type (or (looking-at-p limited-re) 'inlinetask))) + (org-indent-set-line-properties nstars 0 type) + ;; At an headline, define new value for LEVEL. + (unless (eq type 'inlinetask) (setq level nstars)))) + ;; List item: `wrap-prefix' is set where body starts. + ((org-at-item-p) + (org-indent-set-line-properties + level (org-list-item-body-column (point)))) + ;; Regular line. + (t + (org-indent-set-line-properties level (org-get-indentation)))))))))) (defun org-indent-notify-modified-headline (beg end) "Set `org-indent-modified-headline-flag' depending on context. diff --git a/lisp/org-list.el b/lisp/org-list.el index d96ef1c..6e8cf4c 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -91,6 +91,7 @@ (defvar org-drawer-regexp) (defvar org-element-all-objects) (defvar org-inhibit-startup) +(defvar org-loop-over-headlines-in-active-region) (defvar org-odd-levels-only) (defvar org-outline-regexp-bol) (defvar org-scheduled-string) @@ -139,6 +140,7 @@ (declare-function org-previous-line-empty-p "org" ()) (declare-function org-reduced-level "org" (L)) (declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-set-tags "org" (tags)) (declare-function org-show-subtree "org" ()) (declare-function org-sort-remove-invisible "org" (S)) (declare-function org-time-string-to-seconds "org" (s)) diff --git a/lisp/org-macro.el b/lisp/org-macro.el index cab15c8..0ed40f4 100644 --- a/lisp/org-macro.el +++ b/lisp/org-macro.el @@ -62,7 +62,6 @@ (declare-function org-file-url-p "org" (file)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-mode "org" ()) -(declare-function org-trim "org" (s &optional keep-lead)) (declare-function vc-backend "vc-hooks" (f)) (declare-function vc-call "vc-hooks" (fun file &rest args) t) (declare-function vc-exec-after "vc-dispatcher" (code)) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index dbaceda..8ec2498 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -31,6 +31,9 @@ ;;; Code: +(declare-function format-spec "format-spec" (format specification)) +(declare-function org-string-collate-less-p "org-compat" (s1 s2 &rest _)) + ;;; Macros @@ -41,8 +44,8 @@ symbols) ,@body)) -;; Use `org-with-silent-modifications' to ignore cosmetic changes and -;; `org-unmodified' to ignore real text modifications +;; Use `with-silent-modifications' to ignore cosmetic changes and +;; `org-unmodified' to ignore real text modifications. (defmacro org-unmodified (&rest body) "Run BODY while preserving the buffer's `buffer-modified-p' state." (declare (debug (body))) @@ -191,7 +194,7 @@ because otherwise all these markers will point to nowhere." -;;; Buffer +;;; Buffer and windows (defun org-base-buffer (buffer) "Return the base buffer of BUFFER, if it has one. Else return the buffer." @@ -209,6 +212,29 @@ not an indirect buffer." (or (buffer-base-buffer buf) buf) nil))) +(defun org-switch-to-buffer-other-window (&rest args) + "Switch to buffer in a second window on the current frame. +In particular, do not allow pop-up frames. +Returns the newly created buffer." + (org-no-popups (apply #'switch-to-buffer-other-window args))) + +(defun org-fit-window-to-buffer (&optional window max-height min-height + shrink-only) + "Fit WINDOW to the buffer, but only if it is not a side-by-side window. +WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are +passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call +`shrink-window-if-larger-than-buffer' instead, the height limit is +ignored in this case." + (cond ((if (fboundp 'window-full-width-p) + (not (window-full-width-p window)) + ;; Do nothing if another window would suffer. + (> (frame-width) (window-width window)))) + ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) + (fit-window-to-buffer window max-height min-height)) + ((fboundp 'shrink-window-if-larger-than-buffer) + (shrink-window-if-larger-than-buffer window))) + (or window (selected-window))) + ;;; File @@ -282,6 +308,48 @@ it for output." +;;; Indentation + +(defun org-get-indentation (&optional line) + "Get the indentation of the current line, interpreting tabs. +When LINE is given, assume it represents a line and compute its indentation." + (if line + (when (string-match "^ *" (org-remove-tabs line)) + (match-end 0)) + (save-excursion + (beginning-of-line 1) + (skip-chars-forward " \t") + (current-column)))) + +(defun org-do-remove-indentation (&optional n) + "Remove the maximum common indentation from the buffer. +When optional argument N is a positive integer, remove exactly +that much characters from indentation, if possible. Return nil +if it fails." + (catch :exit + (goto-char (point-min)) + ;; Find maximum common indentation, if not specified. + (let ((n (or n + (let ((min-ind (point-max))) + (save-excursion + (while (re-search-forward "^[ \t]*\\S-" nil t) + (let ((ind (1- (current-column)))) + (if (zerop ind) (throw :exit nil) + (setq min-ind (min min-ind ind)))))) + min-ind)))) + (if (zerop n) (throw :exit nil) + ;; Remove exactly N indentation, but give up if not possible. + (while (not (eobp)) + (let ((ind (progn (skip-chars-forward " \t") (current-column)))) + (cond ((eolp) (delete-region (line-beginning-position) (point))) + ((< ind n) (throw :exit nil)) + (t (indent-line-to (- ind n)))) + (forward-line))) + ;; Signal success. + t)))) + + + ;;; Input (defun org-read-function (prompt &optional allow-empty?) @@ -406,6 +474,117 @@ is selected, only the bare key is returned." (when buffer (kill-buffer buffer)))))) +;;; List manipulation + +(defsubst org-get-alist-option (option key) + (cond ((eq key t) t) + ((eq option t) t) + ((assoc key option) (cdr (assoc key option))) + (t (let ((r (cdr (assq 'default option)))) + (if (listp r) (delq nil r) r))))) + +(defsubst org-last (list) + "Return the last element of LIST." + (car (last list))) + +(defsubst org-uniquify (list) + "Non-destructively remove duplicate elements from LIST." + (let ((res (copy-sequence list))) (delete-dups res))) + +(defun org-uniquify-alist (alist) + "Merge elements of ALIST with the same key. + +For example, in this alist: + +\(org-uniquify-alist \\='((a 1) (b 2) (a 3))) + => \\='((a 1 3) (b 2)) + +merge (a 1) and (a 3) into (a 1 3). + +The function returns the new ALIST." + (let (rtn) + (dolist (e alist rtn) + (let (n) + (if (not (assoc (car e) rtn)) + (push e rtn) + (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) + (setq rtn (assq-delete-all (car e) rtn)) + (push n rtn)))))) + +(defun org-delete-all (elts list) + "Remove all elements in ELTS from LIST. +Comparison is done with `equal'. It is a destructive operation +that may remove elements by altering the list structure." + (while elts + (setq list (delete (pop elts) list))) + list) + +(defun org-plist-delete (plist property) + "Delete PROPERTY from PLIST. +This is in contrast to merely setting it to 0." + (let (p) + (while plist + (if (not (eq property (car plist))) + (setq p (plist-put p (car plist) (nth 1 plist)))) + (setq plist (cddr plist))) + p)) + +(defun org-combine-plists (&rest plists) + "Create a single property list from all plists in PLISTS. +The process starts by copying the first list, and then setting properties +from the other lists. Settings in the last list are the most significant +ones and overrule settings in the other lists." + (let ((rtn (copy-sequence (pop plists))) + p v ls) + (while plists + (setq ls (pop plists)) + (while ls + (setq p (pop ls) v (pop ls)) + (setq rtn (plist-put rtn p v)))) + rtn)) + + + +;;; Local variables + +(defconst org-unique-local-variables + '(org-element--cache + org-element--cache-objects + org-element--cache-sync-keys + org-element--cache-sync-requests + org-element--cache-sync-timer) + "List of local variables that cannot be transferred to another buffer.") + +(defun org-get-local-variables () + "Return a list of all local variables in an Org mode buffer." + (delq nil + (mapcar + (lambda (x) + (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x)))) + (name (car binding))) + (and (not (get name 'org-state)) + (not (memq name org-unique-local-variables)) + (string-match-p + "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\ +auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" + (symbol-name name)) + binding))) + (with-temp-buffer + (org-mode) + (buffer-local-variables))))) + +(defun org-clone-local-variables (from-buffer &optional regexp) + "Clone local variables from FROM-BUFFER. +Optional argument REGEXP selects variables to clone." + (dolist (pair (buffer-local-variables from-buffer)) + (pcase pair + (`(,name . ,value) ;ignore unbound variables + (when (and (not (memq name org-unique-local-variables)) + (or (null regexp) (string-match-p regexp (symbol-name name)))) + (ignore-errors (set (make-local-variable name) value))))))) + + + ;;; Logic (defsubst org-xor (a b) @@ -414,6 +593,83 @@ is selected, only the bare key is returned." +;;; Miscellaneous + +(defsubst org-call-with-arg (command arg) + "Call COMMAND interactively, but pretend prefix arg was ARG." + (let ((current-prefix-arg arg)) (call-interactively command))) + +(defsubst org-check-external-command (cmd &optional use no-error) + "Check if external program CMD for USE exists, error if not. +When the program does exist, return its path. +When it does not exist and NO-ERROR is set, return nil. +Otherwise, throw an error. The optional argument USE can describe what this +program is needed for, so that the error message can be more informative." + (or (executable-find cmd) + (if no-error + nil + (error "Can't find `%s'%s" cmd + (if use (format " (%s)" use) ""))))) + +(defun org-display-warning (message) + "Display the given MESSAGE as a warning." + (display-warning 'org message :warning)) + +(defun org-unlogged-message (&rest args) + "Display a message, but avoid logging it in the *Messages* buffer." + (let ((message-log-max nil)) + (apply #'message args))) + +(defun org-let (list &rest body) + (eval (cons 'let (cons list body)))) +(put 'org-let 'lisp-indent-function 1) + +(defun org-let2 (list1 list2 &rest body) + (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) +(put 'org-let2 'lisp-indent-function 2) + +(defun org-eval (form) + "Eval FORM and return result." + (condition-case error + (eval form) + (error (format "%%![Error: %s]" error)))) + +(defvar org-outline-regexp) ; defined in org.el +(defvar org-odd-levels-only) ; defined in org.el +(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el +(defun org-get-limited-outline-regexp () + "Return outline-regexp with limited number of levels. +The number of levels is controlled by `org-inlinetask-min-level'" + (cond ((not (derived-mode-p 'org-mode)) + outline-regexp) + ((not (featurep 'org-inlinetask)) + org-outline-regexp) + (t + (let* ((limit-level (1- org-inlinetask-min-level)) + (nstars (if org-odd-levels-only + (1- (* limit-level 2)) + limit-level))) + (format "\\*\\{1,%d\\} " nstars))))) + + +(provide 'org-macs) + +;;; Motion + +(defsubst org-goto-line (N) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- N)))) + +(defsubst org-current-line (&optional pos) + (save-excursion + (and pos (goto-char pos)) + ;; works also in narrowed buffer, because we start at 1, not point-min + (+ (if (bolp) 1 0) (count-lines 1 (point))))) + + + ;;; Overlays (defun org-overlay-display (ovl text &optional face evap) @@ -451,45 +707,60 @@ SPEC is the invisibility spec, as a symbol." -;;; Indentation +;;; Regexp matching -(defun org-get-indentation (&optional line) - "Get the indentation of the current line, interpreting tabs. -When LINE is given, assume it represents a line and compute its indentation." - (if line - (when (string-match "^ *" (org-remove-tabs line)) - (match-end 0)) - (save-excursion - (beginning-of-line 1) - (skip-chars-forward " \t") - (current-column)))) +(defsubst org-pos-in-match-range (pos n) + (and (match-beginning n) + (<= (match-beginning n) pos) + (>= (match-end n) pos))) -(defun org-do-remove-indentation (&optional n) - "Remove the maximum common indentation from the buffer. -When optional argument N is a positive integer, remove exactly -that much characters from indentation, if possible. Return nil -if it fails." +(defun org-skip-whitespace () + "Skip over space, tabs and newline characters." + (skip-chars-forward " \t\n\r")) + +(defun org-match-line (regexp) + "Match REGEXP at the beginning of the current line." + (save-excursion + (beginning-of-line) + (looking-at regexp))) + +(defun org-match-any-p (re list) + "Non-nil if regexp RE matches an element in LIST." + (cl-some (lambda (x) (string-match-p re x)) list)) + +(defun org-in-regexp (regexp &optional nlines visually) + "Check if point is inside a match of REGEXP. + +Normally only the current line is checked, but you can include +NLINES extra lines around point into the search. If VISUALLY is +set, require that the cursor is not after the match but really +on, so that the block visually is on the match. + +Return nil or a cons cell (BEG . END) where BEG and END are, +respectively, the positions at the beginning and the end of the +match." (catch :exit - (goto-char (point-min)) - ;; Find maximum common indentation, if not specified. - (let ((n (or n - (let ((min-ind (point-max))) - (save-excursion - (while (re-search-forward "^[ \t]*\\S-" nil t) - (let ((ind (1- (current-column)))) - (if (zerop ind) (throw :exit nil) - (setq min-ind (min min-ind ind)))))) - min-ind)))) - (if (zerop n) (throw :exit nil) - ;; Remove exactly N indentation, but give up if not possible. - (while (not (eobp)) - (let ((ind (progn (skip-chars-forward " \t") (current-column)))) - (cond ((eolp) (delete-region (line-beginning-position) (point))) - ((< ind n) (throw :exit nil)) - (t (indent-line-to (- ind n)))) - (forward-line))) - ;; Signal success. - t)))) + (let ((pos (point)) + (eol (line-end-position (if nlines (1+ nlines) 1)))) + (save-excursion + (beginning-of-line (- 1 (or nlines 0))) + (while (and (re-search-forward regexp eol t) + (<= (match-beginning 0) pos)) + (let ((end (match-end 0))) + (when (or (> end pos) (and (= end pos) (not visually))) + (throw :exit (cons (match-beginning 0) (match-end 0)))))))))) + +(defun org-point-in-group (point group &optional context) + "Check if POINT is in match-group GROUP. +If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the +match. If the match group does not exist or point is not inside it, +return nil." + (and (match-beginning group) + (>= point (match-beginning group)) + (<= point (match-end group)) + (if context + (list context (match-beginning group) (match-end group)) + t))) @@ -704,215 +975,6 @@ as-is if removal failed." -;;; List manipulation - -(defsubst org-get-alist-option (option key) - (cond ((eq key t) t) - ((eq option t) t) - ((assoc key option) (cdr (assoc key option))) - (t (let ((r (cdr (assq 'default option)))) - (if (listp r) (delq nil r) r))))) - -(defsubst org-last (list) - "Return the last element of LIST." - (car (last list))) - -(defsubst org-uniquify (list) - "Non-destructively remove duplicate elements from LIST." - (let ((res (copy-sequence list))) (delete-dups res))) - -(defun org-uniquify-alist (alist) - "Merge elements of ALIST with the same key. - -For example, in this alist: - -\(org-uniquify-alist \\='((a 1) (b 2) (a 3))) - => \\='((a 1 3) (b 2)) - -merge (a 1) and (a 3) into (a 1 3). - -The function returns the new ALIST." - (let (rtn) - (dolist (e alist rtn) - (let (n) - (if (not (assoc (car e) rtn)) - (push e rtn) - (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) - (setq rtn (assq-delete-all (car e) rtn)) - (push n rtn)))))) - -(defun org-delete-all (elts list) - "Remove all elements in ELTS from LIST. -Comparison is done with `equal'. It is a destructive operation -that may remove elements by altering the list structure." - (while elts - (setq list (delete (pop elts) list))) - list) - -(defun org-plist-delete (plist property) - "Delete PROPERTY from PLIST. -This is in contrast to merely setting it to 0." - (let (p) - (while plist - (if (not (eq property (car plist))) - (setq p (plist-put p (car plist) (nth 1 plist)))) - (setq plist (cddr plist))) - p)) - -(defun org-combine-plists (&rest plists) - "Create a single property list from all plists in PLISTS. -The process starts by copying the first list, and then setting properties -from the other lists. Settings in the last list are the most significant -ones and overrule settings in the other lists." - (let ((rtn (copy-sequence (pop plists))) - p v ls) - (while plists - (setq ls (pop plists)) - (while ls - (setq p (pop ls) v (pop ls)) - (setq rtn (plist-put rtn p v)))) - rtn)) - - - -;;; Regexp matching - -(defsubst org-pos-in-match-range (pos n) - (and (match-beginning n) - (<= (match-beginning n) pos) - (>= (match-end n) pos))) - -(defun org-skip-whitespace () - "Skip over space, tabs and newline characters." - (skip-chars-forward " \t\n\r")) - -(defun org-match-line (regexp) - "Match REGEXP at the beginning of the current line." - (save-excursion - (beginning-of-line) - (looking-at regexp))) - -(defun org-match-any-p (re list) - "Non-nil if regexp RE matches an element in LIST." - (cl-some (lambda (x) (string-match-p re x)) list)) - -(defun org-in-regexp (regexp &optional nlines visually) - "Check if point is inside a match of REGEXP. - -Normally only the current line is checked, but you can include -NLINES extra lines around point into the search. If VISUALLY is -set, require that the cursor is not after the match but really -on, so that the block visually is on the match. - -Return nil or a cons cell (BEG . END) where BEG and END are, -respectively, the positions at the beginning and the end of the -match." - (catch :exit - (let ((pos (point)) - (eol (line-end-position (if nlines (1+ nlines) 1)))) - (save-excursion - (beginning-of-line (- 1 (or nlines 0))) - (while (and (re-search-forward regexp eol t) - (<= (match-beginning 0) pos)) - (let ((end (match-end 0))) - (when (or (> end pos) (and (= end pos) (not visually))) - (throw :exit (cons (match-beginning 0) (match-end 0)))))))))) - -(defun org-point-in-group (point group &optional context) - "Check if POINT is in match-group GROUP. -If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the -match. If the match group does not exist or point is not inside it, -return nil." - (and (match-beginning group) - (>= point (match-beginning group)) - (<= point (match-end group)) - (if context - (list context (match-beginning group) (match-end group)) - t))) - - - -;;; Motion - -(defsubst org-goto-line (N) - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- N)))) - -(defsubst org-current-line (&optional pos) - (save-excursion - (and pos (goto-char pos)) - ;; works also in narrowed buffer, because we start at 1, not point-min - (+ (if (bolp) 1 0) (count-lines 1 (point))))) - - - -;;; Time - -(defun org-2ft (s) - "Convert S to a floating point time. -If S is already a number, just return it. If it is a string, -parse it as a time string and apply `float-time' to it. If S is -nil, just return 0." - (cond - ((numberp s) s) - ((stringp s) - (condition-case nil - (float-time (apply #'encode-time (org-parse-time-string s))) - (error 0.))) - (t 0.))) - -(defun org-time= (a b) - (let ((a (org-2ft a)) - (b (org-2ft b))) - (and (> a 0) (> b 0) (= a b)))) - -(defun org-time< (a b) - (let ((a (org-2ft a)) - (b (org-2ft b))) - (and (> a 0) (> b 0) (< a b)))) - -(defun org-time<= (a b) - (let ((a (org-2ft a)) - (b (org-2ft b))) - (and (> a 0) (> b 0) (<= a b)))) - -(defun org-time> (a b) - (let ((a (org-2ft a)) - (b (org-2ft b))) - (and (> a 0) (> b 0) (> a b)))) - -(defun org-time>= (a b) - (let ((a (org-2ft a)) - (b (org-2ft b))) - (and (> a 0) (> b 0) (>= a b)))) - -(defun org-time<> (a b) - (let ((a (org-2ft a)) - (b (org-2ft b))) - (and (> a 0) (> b 0) (\= a b)))) - -(defun org-matcher-time (s) - "Interpret a time comparison value S." - (let ((today (float-time (apply #'encode-time - (append '(0 0 0) (nthcdr 3 (decode-time))))))) - (save-match-data - (cond - ((string= s "<now>") (float-time)) - ((string= s "<today>") today) - ((string= s "<tomorrow>") (+ 86400.0 today)) - ((string= s "<yesterday>") (- today 86400.0)) - ((string-match "\\`<\\([-+][0-9]+\\)\\([hdwmy]\\)>\\'" s) - (+ today - (* (string-to-number (match-string 1 s)) - (cdr (assoc (match-string 2 s) - '(("d" . 86400.0) ("w" . 604800.0) - ("m" . 2678400.0) ("y" . 31557600.0))))))) - (t (org-2ft s)))))) - - - ;;; Text properties (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t @@ -982,105 +1044,92 @@ move it back by one char before doing this check." -;;; Local variables - -(defconst org-unique-local-variables - '(org-element--cache - org-element--cache-objects - org-element--cache-sync-keys - org-element--cache-sync-requests - org-element--cache-sync-timer) - "List of local variables that cannot be transferred to another buffer.") - -(defun org-get-local-variables () - "Return a list of all local variables in an Org mode buffer." - (delq nil - (mapcar - (lambda (x) - (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x)))) - (name (car binding))) - (and (not (get name 'org-state)) - (not (memq name org-unique-local-variables)) - (string-match-p - "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\ -auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" - (symbol-name name)) - binding))) - (with-temp-buffer - (org-mode) - (buffer-local-variables))))) - -(defun org-clone-local-variables (from-buffer &optional regexp) - "Clone local variables from FROM-BUFFER. -Optional argument REGEXP selects variables to clone." - (dolist (pair (buffer-local-variables from-buffer)) - (pcase pair - (`(,name . ,value) ;ignore unbound variables - (when (and (not (memq name org-unique-local-variables)) - (or (null regexp) (string-match-p regexp (symbol-name name)))) - (ignore-errors (set (make-local-variable name) value))))))) - - - -;;; Miscellaneous +;;; Time -(defsubst org-call-with-arg (command arg) - "Call COMMAND interactively, but pretend prefix arg was ARG." - (let ((current-prefix-arg arg)) (call-interactively command))) +(defun org-2ft (s) + "Convert S to a floating point time. +If S is already a number, just return it. If it is a string, +parse it as a time string and apply `float-time' to it. If S is +nil, just return 0." + (cond + ((numberp s) s) + ((stringp s) + (condition-case nil + (float-time (apply #'encode-time (org-parse-time-string s))) + (error 0.))) + (t 0.))) -(defsubst org-check-external-command (cmd &optional use no-error) - "Check if external program CMD for USE exists, error if not. -When the program does exist, return its path. -When it does not exist and NO-ERROR is set, return nil. -Otherwise, throw an error. The optional argument USE can describe what this -program is needed for, so that the error message can be more informative." - (or (executable-find cmd) - (if no-error - nil - (error "Can't find `%s'%s" cmd - (if use (format " (%s)" use) ""))))) +(defun org-time= (a b) + (let ((a (org-2ft a)) + (b (org-2ft b))) + (and (> a 0) (> b 0) (= a b)))) -(defun org-display-warning (message) - "Display the given MESSAGE as a warning." - (display-warning 'org message :warning)) +(defun org-time< (a b) + (let ((a (org-2ft a)) + (b (org-2ft b))) + (and (> a 0) (> b 0) (< a b)))) -(defun org-unlogged-message (&rest args) - "Display a message, but avoid logging it in the *Messages* buffer." - (let ((message-log-max nil)) - (apply #'message args))) +(defun org-time<= (a b) + (let ((a (org-2ft a)) + (b (org-2ft b))) + (and (> a 0) (> b 0) (<= a b)))) -(defun org-let (list &rest body) - (eval (cons 'let (cons list body)))) -(put 'org-let 'lisp-indent-function 1) +(defun org-time> (a b) + (let ((a (org-2ft a)) + (b (org-2ft b))) + (and (> a 0) (> b 0) (> a b)))) -(defun org-let2 (list1 list2 &rest body) - (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) -(put 'org-let2 'lisp-indent-function 2) +(defun org-time>= (a b) + (let ((a (org-2ft a)) + (b (org-2ft b))) + (and (> a 0) (> b 0) (>= a b)))) -(defun org-eval (form) - "Eval FORM and return result." - (condition-case error - (eval form) - (error (format "%%![Error: %s]" error)))) +(defun org-time<> (a b) + (let ((a (org-2ft a)) + (b (org-2ft b))) + (and (> a 0) (> b 0) (\= a b)))) -(defvar org-outline-regexp) ; defined in org.el -(defvar org-odd-levels-only) ; defined in org.el -(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el -(defun org-get-limited-outline-regexp () - "Return outline-regexp with limited number of levels. -The number of levels is controlled by `org-inlinetask-min-level'" - (cond ((not (derived-mode-p 'org-mode)) - outline-regexp) - ((not (featurep 'org-inlinetask)) - org-outline-regexp) - (t - (let* ((limit-level (1- org-inlinetask-min-level)) - (nstars (if org-odd-levels-only - (1- (* limit-level 2)) - limit-level))) - (format "\\*\\{1,%d\\} " nstars))))) +(defun org-parse-time-string (s &optional nodefault) + "Parse Org time string S. + +If time is not given, defaults to 0:00. However, with optional +NODEFAULT, hour and minute fields are nil if not given. + +Throw an error if S in not a valid Org time string. + +This should be a lot faster than the `parse-time-string'." + (cond ((string-match org-ts-regexp0 s) + (list 0 + (when (or (match-beginning 8) (not nodefault)) + (string-to-number (or (match-string 8 s) "0"))) + (when (or (match-beginning 7) (not nodefault)) + (string-to-number (or (match-string 7 s) "0"))) + (string-to-number (match-string 4 s)) + (string-to-number (match-string 3 s)) + (string-to-number (match-string 2 s)) + nil nil nil)) + ((string-match "\\`<[^>]+>\\'" s) + (decode-time (seconds-to-time (org-matcher-time s)))) + (t (error "Not an Org time string: %s" s)))) +(defun org-matcher-time (s) + "Interpret a time comparison value S." + (let ((today (float-time (apply #'encode-time + (append '(0 0 0) (nthcdr 3 (decode-time))))))) + (save-match-data + (cond + ((string= s "<now>") (float-time)) + ((string= s "<today>") today) + ((string= s "<tomorrow>") (+ 86400.0 today)) + ((string= s "<yesterday>") (- today 86400.0)) + ((string-match "\\`<\\([-+][0-9]+\\)\\([hdwmy]\\)>\\'" s) + (+ today + (* (string-to-number (match-string 1 s)) + (cdr (assoc (match-string 2 s) + '(("d" . 86400.0) ("w" . 604800.0) + ("m" . 2678400.0) ("y" . 31557600.0))))))) + (t (org-2ft s)))))) -(provide 'org-macs) + ;;; org-macs.el ends here diff --git a/lisp/org.el b/lisp/org.el index 8513104..af6322f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8742,9 +8742,9 @@ function is being called interactively." (when (and (eq (org-clock-is-active) (current-buffer)) (<= start (marker-position org-clock-marker)) (>= end (marker-position org-clock-marker))) - (org-with-silent-modifications - (put-text-property (1- org-clock-marker) org-clock-marker - :org-clock-marker-backup t)) + (with-silent-modifications + (put-text-property (1- org-clock-marker) org-clock-marker + :org-clock-marker-backup t)) t)) (dcst (downcase sorting-type)) (case-fold-search nil) @@ -8960,16 +8960,16 @@ the value of the drawer property." (inherit? (org-property-inherit-p dprop)) (property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t)) (global (and inherit? (org--property-global-value dprop nil)))) - (org-with-silent-modifications - (org-with-point-at 1 - ;; Set global values (e.g., values defined through - ;; "#+PROPERTY:" keywords) to the whole buffer. - (when global (put-text-property (point-min) (point-max) tprop global)) - ;; Set local values. - (while (re-search-forward property-re nil t) - (when (org-at-property-p) - (org-refresh-property tprop (org-entry-get (point) dprop) inherit?)) - (outline-next-heading)))))) + (with-silent-modifications + (org-with-point-at 1 + ;; Set global values (e.g., values defined through + ;; "#+PROPERTY:" keywords) to the whole buffer. + (when global (put-text-property (point-min) (point-max) tprop global)) + ;; Set local values. + (while (re-search-forward property-re nil t) + (when (org-at-property-p) + (org-refresh-property tprop (org-entry-get (point) dprop) inherit?)) + (outline-next-heading)))))) (defun org-refresh-property (tprop p &optional inherit) "Refresh the buffer text property TPROP from the drawer property P. @@ -9001,49 +9001,49 @@ sub-tree if optional argument INHERIT is non-nil." "???")) ((symbolp org-category) (symbol-name org-category)) (t org-category)))) - (org-with-silent-modifications - (org-with-wide-buffer - ;; Set buffer-wide category. Search last #+CATEGORY keyword. - ;; This is the default category for the buffer. If none is - ;; found, fall-back to `org-category' or buffer file name. - (put-text-property - (point-min) (point-max) - 'org-category - (catch 'buffer-category - (goto-char (point-max)) - (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (throw 'buffer-category - (org-element-property :value element))))) - default-category)) - ;; Set sub-tree specific categories. - (goto-char (point-min)) - (let ((regexp (org-re-property "CATEGORY"))) - (while (re-search-forward regexp nil t) - (let ((value (match-string-no-properties 3))) - (when (org-at-property-p) - (put-text-property - (save-excursion (org-back-to-heading t) (point)) - (save-excursion (org-end-of-subtree t t) (point)) - 'org-category - value))))))))) + (with-silent-modifications + (org-with-wide-buffer + ;; Set buffer-wide category. Search last #+CATEGORY keyword. + ;; This is the default category for the buffer. If none is + ;; found, fall-back to `org-category' or buffer file name. + (put-text-property + (point-min) (point-max) + 'org-category + (catch 'buffer-category + (goto-char (point-max)) + (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (throw 'buffer-category + (org-element-property :value element))))) + default-category)) + ;; Set sub-tree specific categories. + (goto-char (point-min)) + (let ((regexp (org-re-property "CATEGORY"))) + (while (re-search-forward regexp nil t) + (let ((value (match-string-no-properties 3))) + (when (org-at-property-p) + (put-text-property + (save-excursion (org-back-to-heading t) (point)) + (save-excursion (org-end-of-subtree t t) (point)) + 'org-category + value))))))))) (defun org-refresh-stats-properties () "Refresh stats text properties in the buffer." - (org-with-silent-modifications - (org-with-point-at 1 - (let ((regexp (concat org-outline-regexp-bol - ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]"))) - (while (re-search-forward regexp nil t) - (let* ((numerator (string-to-number (match-string 1))) - (denominator (and (match-end 2) - (string-to-number (match-string 2)))) - (stats (cond ((not denominator) numerator) ;percent - ((= denominator 0) 0) - (t (/ (* numerator 100) denominator))))) - (put-text-property (point) (progn (org-end-of-subtree t t) (point)) - 'org-stats stats))))))) + (with-silent-modifications + (org-with-point-at 1 + (let ((regexp (concat org-outline-regexp-bol + ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]"))) + (while (re-search-forward regexp nil t) + (let* ((numerator (string-to-number (match-string 1))) + (denominator (and (match-end 2) + (string-to-number (match-string 2)))) + (stats (cond ((not denominator) numerator) ;percent + ((= denominator 0) 0) + (t (/ (* numerator 100) denominator))))) + (put-text-property (point) (progn (org-end-of-subtree t t) (point)) + 'org-stats stats))))))) (defun org-refresh-effort-properties () "Refresh effort properties" @@ -17154,31 +17154,6 @@ day number." (list (nth 4 d) (nth 3 d) (nth 5 d)))) ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d))))) -(defun org-parse-time-string (s &optional nodefault) - "Parse the standard Org time string. - -This should be a lot faster than the normal `parse-time-string'. - -If time is not given, defaults to 0:00. However, with optional -NODEFAULT, hour and minute fields will be nil if not given." - (cond ((string-match org-ts-regexp0 s) - (list 0 - (when (or (match-beginning 8) (not nodefault)) - (string-to-number (or (match-string 8 s) "0"))) - (when (or (match-beginning 7) (not nodefault)) - (string-to-number (or (match-string 7 s) "0"))) - (string-to-number (match-string 4 s)) - (string-to-number (match-string 3 s)) - (string-to-number (match-string 2 s)) - nil nil nil)) - ((string-match "^<[^>]+>$" s) - ;; FIXME: `decode-time' needs to be called with ZONE as its - ;; second argument. However, this requires at least Emacs - ;; 25.1. We can do it when we switch to this version as our - ;; minimal requirement. - (decode-time (seconds-to-time (org-matcher-time s)))) - (t (error "Not a standard Org time string: %s" s)))) - (defun org-timestamp-up (&optional arg) "Increase the date item at the cursor by one. If the cursor is on the year, change the year. If it is on the month, @@ -17956,20 +17931,20 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (if old (setcdr old (org-uniquify (append (cdr old) (cdr alist)))) (push alist org-tag-groups-alist-for-agenda))))) - (org-with-silent-modifications - (save-excursion - (remove-text-properties (point-min) (point-max) pall) - (when org-agenda-skip-archived-trees - (goto-char (point-min)) - (while (re-search-forward rea nil t) - (when (org-at-heading-p t) - (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) - (goto-char (point-min)) - (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string)) - (while (re-search-forward re nil t) - (when (save-match-data (org-in-commented-heading-p t)) - (add-text-properties - (match-beginning 0) (org-end-of-subtree t) pc))))) + (with-silent-modifications + (save-excursion + (remove-text-properties (point-min) (point-max) pall) + (when org-agenda-skip-archived-trees + (goto-char (point-min)) + (while (re-search-forward rea nil t) + (when (org-at-heading-p t) + (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) + (goto-char (point-min)) + (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string)) + (while (re-search-forward re nil t) + (when (save-match-data (org-in-commented-heading-p t)) + (add-text-properties + (match-beginning 0) (org-end-of-subtree t) pc))))) (goto-char pos))))) (setq org-todo-keywords-for-agenda (org-uniquify org-todo-keywords-for-agenda)) @@ -21422,13 +21397,6 @@ Returns the number of empty lines passed." (goto-char (min (point) pos)) (count-lines (point) pos))) -(defun org-switch-to-buffer-other-window (&rest args) - "Switch to buffer in a second window on the current frame. -In particular, do not allow pop-up frames. -Returns the newly created buffer." - (org-no-popups - (apply 'switch-to-buffer-other-window args))) - (defun org-replace-escapes (string table) "Replace %-escapes in STRING with values in TABLE. TABLE is an association list with keys like \"%a\" and string values. diff --git a/testing/examples/babel.org b/testing/examples/babel.org index 556e93e..c889d5d 100644 --- a/testing/examples/babel.org +++ b/testing/examples/babel.org @@ -112,21 +112,17 @@ #+name: pascals-triangle #+begin_src emacs-lisp :var n=5 :exports both - (require 'cl) - (defalias 'my-map (if (org-version-check "24.2.50" "cl" :predicate) - 'cl-map - 'map)) - (defun pascals-triangle (n) - (if (= n 0) - (list (list 1)) - (let* ((prev-triangle (pascals-triangle (- n 1))) - (prev-row (car (reverse prev-triangle)))) - (append prev-triangle - (list (my-map 'list #'+ - (append prev-row '(0)) - (append '(0) prev-row))))))) - - (pascals-triangle n) +(defun pascals-triangle (n) + (if (= n 0) + (list (list 1)) + (let* ((prev-triangle (pascals-triangle (- n 1))) + (prev-row (car (reverse prev-triangle)))) + (append prev-triangle + (list (cl-map 'list #'+ + (append prev-row '(0)) + (append '(0) prev-row))))))) + +(pascals-triangle n) #+end_src * calling code blocks from inside table |