summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien <bzg@gnu.org>2018-04-29 16:02:07 +0200
committerBastien <bzg@gnu.org>2018-04-29 16:02:07 +0200
commit4aa251388279a0ffe7a3f6e721705f327b4d7316 (patch)
treec407caabd5ff2024064ee866c77a6d167b66d13a
parentdc4896aeef88a5e08a1a66b2470e7c70737471c7 (diff)
parent61cfd675f3d486106afe6776b9e6e549505a6720 (diff)
downloadorg-mode-4aa251388279a0ffe7a3f6e721705f327b4d7316.tar.gz
Merge branch 'master' of code.orgmode.org:bzg/org-mode
-rw-r--r--doc/org-manual.org5
-rw-r--r--lisp/org-clock.el162
-rw-r--r--lisp/org-colview.el52
-rw-r--r--lisp/org-compat.el79
-rw-r--r--lisp/org-indent.el62
-rw-r--r--lisp/org-list.el2
-rw-r--r--lisp/org-macro.el1
-rw-r--r--lisp/org-macs.el725
-rw-r--r--lisp/org.el166
-rw-r--r--testing/examples/babel.org26
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