2016-06-21 20:56:46 +00:00
|
|
|
|
;;; org-macs.el --- Top-level Definitions for Org -*- lexical-binding: t; -*-
|
2008-03-22 15:52:18 +00:00
|
|
|
|
|
2022-01-01 20:10:55 +00:00
|
|
|
|
;; Copyright (C) 2004-2022 Free Software Foundation, Inc.
|
2008-03-22 15:52:18 +00:00
|
|
|
|
|
2021-05-07 14:50:57 +00:00
|
|
|
|
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
|
2008-03-22 15:52:18 +00:00
|
|
|
|
;; Keywords: outlines, hypermedia, calendar, wp
|
2018-01-16 16:22:00 +00:00
|
|
|
|
;; Homepage: https://orgmode.org
|
2008-03-22 15:52:18 +00:00
|
|
|
|
;;
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
;;
|
2008-05-06 12:45:52 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
2008-03-22 15:52:18 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 12:45:52 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
2008-03-22 15:52:18 +00:00
|
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2017-09-13 22:52:52 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
2008-03-22 15:52:18 +00:00
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
;;
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
2008-04-04 21:44:48 +00:00
|
|
|
|
;; This file contains macro definitions, defsubst definitions, other
|
2016-06-21 20:56:46 +00:00
|
|
|
|
;; stuff needed for compilation and top-level forms in Org mode, as
|
|
|
|
|
;; well lots of small functions that are not Org mode specific but
|
|
|
|
|
;; simply generally useful stuff.
|
2008-03-22 15:52:18 +00:00
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
2018-03-17 00:41:17 +00:00
|
|
|
|
(require 'cl-lib)
|
2018-05-10 00:04:12 +00:00
|
|
|
|
(require 'format-spec)
|
|
|
|
|
|
2020-12-13 18:56:29 +00:00
|
|
|
|
(declare-function org-mode "org" ())
|
2022-01-16 07:07:25 +00:00
|
|
|
|
(declare-function org-agenda-files "org" (&optional unrestricted archives))
|
|
|
|
|
(declare-function org-fold-show-context "org-fold" (&optional key))
|
|
|
|
|
(declare-function org-fold-save-outline-visibility "org-fold" (use-markers &rest body))
|
|
|
|
|
(declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p))
|
2022-01-29 07:32:08 +00:00
|
|
|
|
(declare-function org-fold-core-with-forced-fontification "org-fold" (&rest body))
|
2022-01-16 07:07:25 +00:00
|
|
|
|
(declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p))
|
2021-10-05 03:43:14 +00:00
|
|
|
|
(declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
|
2018-04-29 10:03:17 +00:00
|
|
|
|
|
2018-04-30 11:59:34 +00:00
|
|
|
|
(defvar org-ts-regexp0)
|
2021-05-18 14:31:39 +00:00
|
|
|
|
(defvar ffap-url-regexp)
|
2022-01-16 07:07:25 +00:00
|
|
|
|
(defvar org-fold-core-style)
|
2018-04-30 11:59:34 +00:00
|
|
|
|
|
2017-09-18 19:24:23 +00:00
|
|
|
|
|
|
|
|
|
;;; Macros
|
|
|
|
|
|
2011-08-10 05:28:41 +00:00
|
|
|
|
(defmacro org-with-gensyms (symbols &rest body)
|
2015-05-04 15:32:43 +00:00
|
|
|
|
(declare (debug (sexp body)) (indent 1))
|
2011-08-10 05:28:41 +00:00
|
|
|
|
`(let ,(mapcar (lambda (s)
|
2015-05-04 15:32:43 +00:00
|
|
|
|
`(,s (make-symbol (concat "--" (symbol-name ',s)))))
|
|
|
|
|
symbols)
|
2011-08-10 05:28:41 +00:00
|
|
|
|
,@body))
|
|
|
|
|
|
2018-04-29 10:02:01 +00:00
|
|
|
|
;; Use `with-silent-modifications' to ignore cosmetic changes and
|
|
|
|
|
;; `org-unmodified' to ignore real text modifications.
|
2017-09-18 19:24:23 +00:00
|
|
|
|
(defmacro org-unmodified (&rest body)
|
|
|
|
|
"Run BODY while preserving the buffer's `buffer-modified-p' state."
|
|
|
|
|
(declare (debug (body)))
|
|
|
|
|
(org-with-gensyms (was-modified)
|
|
|
|
|
`(let ((,was-modified (buffer-modified-p)))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(let ((buffer-undo-list t)
|
|
|
|
|
(inhibit-modification-hooks t))
|
|
|
|
|
,@body)
|
|
|
|
|
(set-buffer-modified-p ,was-modified)))))
|
|
|
|
|
|
|
|
|
|
(defmacro org-without-partial-completion (&rest body)
|
|
|
|
|
(declare (debug (body)))
|
|
|
|
|
`(if (and (boundp 'partial-completion-mode)
|
|
|
|
|
partial-completion-mode
|
|
|
|
|
(fboundp 'partial-completion-mode))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(partial-completion-mode -1)
|
|
|
|
|
,@body)
|
|
|
|
|
(partial-completion-mode 1))
|
|
|
|
|
,@body))
|
|
|
|
|
|
|
|
|
|
(defmacro org-with-point-at (pom &rest body)
|
|
|
|
|
"Move to buffer and point of point-or-marker POM for the duration of BODY."
|
|
|
|
|
(declare (debug (form body)) (indent 1))
|
|
|
|
|
(org-with-gensyms (mpom)
|
|
|
|
|
`(let ((,mpom ,pom))
|
|
|
|
|
(save-excursion
|
Many small code improvements
* lisp/org-capture.el (org-capture-member): Make obsolete; the old
definition was identical to ‘org-capture-get’ anyway.
(org-capture-mode-map): Move the calls to ‘define-key’ up to where the
variable is defined.
(org-capture-mode-hook): Small docstring tweak.
(org-capture-mode): Fix typo in mode lighter.
(org-capture-set-target-location, org-capture-place-item):
(org-capture-place-plain-text, org-capture-narrow):
(org-capture-empty-lines-after):
(org-capture-import-remember-templates): ‘if’ without else -> ‘when’
* lisp/org-colview.el (org-columns-edit-value): Change an error to a
user-error.
(org-columns-uncompile-format): Improve docstring.
* lisp/org-compat.el (org-remove-from-invisibility-spec): Make
obsolete, the underlying emacs function exists since 1997, commit 31aa282e.
(org-in-invisibility-spec-p, org-count-lines): ‘if’ without else -> ‘when’.
* lisp/org-element.el (org-element-swap-A-B):
* lisp/org-entities.el (org-entities-create-table):
* lisp/org-list.el (org-insert-item):
* lisp/org-macs.el (org-with-point-at, org-base-buffer):
(org-preserve-local-variables, org-overlay-display):
(org-overlay-before-string): ‘if’ without else -> ‘when’.
* lisp/org-eshell.el (org-eshell-open): Fix docstring typo.
* lisp/org-pcomplete.el (pcomplete/org-mode/file-option/language):
(pcomplete/org-mode/file-option/startup):
(pcomplete/org-mode/file-option/options):
(pcomplete/org-mode/file-option/infojs_opt):
(pcomplete/org-mode/link, pcomplete/org-mode/tex):
(pcomplete/org-mode/todo, pcomplete/org-mode/searchhead):
(pcomplete/org-mode/tag, pcomplete/org-mode/prop): Avoid the formerly
misspelled ‘pcomplete-uniqify-list’ function. It has a defalias in
emacs >= 27; we add our own for older emacsen.
(pcomplete/org-mode/file-option/bind): ‘if’ without else -> ‘when’.
* lisp/org-protocol.el (org-protocol-capture):
(org-protocol-convert-query-to-plist): ‘if’ without else -> ‘when’.
(org-protocol-do-capture): Pacify byte compiler, simplify conditional
logic.
* lisp/org-table.el (org-table-create-with-table.el): Simplify conditional
logic.
(org-table-create, org-table-convert-region, org-table-next-field):
(org-table-beginning-of-field, org-table-end-of-field):
* lisp/org-w3m.el (org-w3m-copy-for-org-mode): ‘if’ without else ->
‘when’.
* lisp/org.el (org-babel-do-load-languages, org-previous-link):
(org-refile): Use ‘(foo ...)’ instead of ‘(funcall 'foo ...)’.
(org-add-log-note): Convert a long cond into a cl-case.
(org-priority): Improve docstring, show a deprecation warning if the
‘show’ argument is passed (which was previously silently ignored).
Also, use ?\s instead of ?\ as a character literal for space.
(org-fast-tag-insert): Fix docstring typo.
(org-fill-element): ‘if’ without else -> ‘when’.
(org-on-target-p): Remove ancient compatibility alias.
2018-05-10 01:02:35 +00:00
|
|
|
|
(when (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
|
2017-09-18 19:24:23 +00:00
|
|
|
|
(org-with-wide-buffer
|
|
|
|
|
(goto-char (or ,mpom (point)))
|
|
|
|
|
,@body)))))
|
|
|
|
|
|
|
|
|
|
(defmacro org-with-remote-undo (buffer &rest body)
|
|
|
|
|
"Execute BODY while recording undo information in two buffers."
|
|
|
|
|
(declare (debug (form body)) (indent 1))
|
|
|
|
|
(org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2)
|
|
|
|
|
`(let ((,cline (org-current-line))
|
|
|
|
|
(,cmd this-command)
|
|
|
|
|
(,buf1 (current-buffer))
|
|
|
|
|
(,buf2 ,buffer)
|
|
|
|
|
(,undo1 buffer-undo-list)
|
|
|
|
|
(,undo2 (with-current-buffer ,buffer buffer-undo-list))
|
|
|
|
|
,c1 ,c2)
|
|
|
|
|
,@body
|
|
|
|
|
(when org-agenda-allow-remote-undo
|
|
|
|
|
(setq ,c1 (org-verify-change-for-undo
|
|
|
|
|
,undo1 (with-current-buffer ,buf1 buffer-undo-list))
|
|
|
|
|
,c2 (org-verify-change-for-undo
|
|
|
|
|
,undo2 (with-current-buffer ,buf2 buffer-undo-list)))
|
|
|
|
|
(when (or ,c1 ,c2)
|
|
|
|
|
;; make sure there are undo boundaries
|
|
|
|
|
(and ,c1 (with-current-buffer ,buf1 (undo-boundary)))
|
|
|
|
|
(and ,c2 (with-current-buffer ,buf2 (undo-boundary)))
|
|
|
|
|
;; remember which buffer to undo
|
|
|
|
|
(push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2)
|
|
|
|
|
org-agenda-undo-list))))))
|
|
|
|
|
|
|
|
|
|
(defmacro org-no-read-only (&rest body)
|
|
|
|
|
"Inhibit read-only for BODY."
|
|
|
|
|
(declare (debug (body)))
|
|
|
|
|
`(let ((inhibit-read-only t)) ,@body))
|
|
|
|
|
|
2022-01-16 07:07:25 +00:00
|
|
|
|
(defalias 'org-save-outline-visibility #'org-fold-save-outline-visibility)
|
2017-09-18 19:24:23 +00:00
|
|
|
|
|
|
|
|
|
(defmacro org-with-wide-buffer (&rest body)
|
|
|
|
|
"Execute body while temporarily widening the buffer."
|
|
|
|
|
(declare (debug (body)))
|
|
|
|
|
`(save-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(widen)
|
|
|
|
|
,@body)))
|
|
|
|
|
|
|
|
|
|
(defmacro org-with-limited-levels (&rest body)
|
|
|
|
|
"Execute BODY with limited number of outline levels."
|
|
|
|
|
(declare (debug (body)))
|
|
|
|
|
`(progn
|
|
|
|
|
(defvar org-called-with-limited-levels)
|
|
|
|
|
(defvar org-outline-regexp)
|
|
|
|
|
(defvar outline-regexp)
|
|
|
|
|
(defvar org-outline-regexp-bol)
|
|
|
|
|
(let* ((org-called-with-limited-levels t)
|
|
|
|
|
(org-outline-regexp (org-get-limited-outline-regexp))
|
|
|
|
|
(outline-regexp org-outline-regexp)
|
|
|
|
|
(org-outline-regexp-bol (concat "^" org-outline-regexp)))
|
|
|
|
|
,@body)))
|
|
|
|
|
|
|
|
|
|
(defmacro org-eval-in-environment (environment form)
|
2021-05-16 06:57:08 +00:00
|
|
|
|
(declare (debug (form form)) (indent 1) (obsolete cl-progv "2021"))
|
2017-09-18 19:24:23 +00:00
|
|
|
|
`(eval (list 'let ,environment ',form)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defmacro org-load-noerror-mustsuffix (file)
|
|
|
|
|
"Load FILE with optional arguments NOERROR and MUSTSUFFIX."
|
|
|
|
|
`(load ,file 'noerror nil nil 'mustsuffix))
|
2017-10-17 07:37:34 +00:00
|
|
|
|
|
2017-12-18 14:50:51 +00:00
|
|
|
|
(defmacro org-preserve-local-variables (&rest body)
|
|
|
|
|
"Execute BODY while preserving local variables."
|
|
|
|
|
(declare (debug (body)))
|
|
|
|
|
`(let ((local-variables
|
|
|
|
|
(org-with-wide-buffer
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(let ((case-fold-search t))
|
|
|
|
|
(and (re-search-backward "^[ \t]*# +Local Variables:"
|
|
|
|
|
(max (- (point) 3000) 1)
|
|
|
|
|
t)
|
|
|
|
|
(delete-and-extract-region (point) (point-max)))))))
|
|
|
|
|
(unwind-protect (progn ,@body)
|
|
|
|
|
(when local-variables
|
|
|
|
|
(org-with-wide-buffer
|
|
|
|
|
(goto-char (point-max))
|
2022-01-16 07:18:53 +00:00
|
|
|
|
(unless (bolp) (insert "\n"))
|
|
|
|
|
(insert local-variables))))))
|
2017-12-18 14:50:51 +00:00
|
|
|
|
|
2018-04-30 11:58:25 +00:00
|
|
|
|
(defmacro org-no-popups (&rest body)
|
|
|
|
|
"Suppress popup windows and evaluate BODY."
|
2021-05-31 12:47:45 +00:00
|
|
|
|
`(let (pop-up-frames pop-up-windows)
|
2018-04-30 11:58:25 +00:00
|
|
|
|
,@body))
|
|
|
|
|
|
2022-01-30 07:17:38 +00:00
|
|
|
|
(defmacro org-element-with-disabled-cache (&rest body)
|
|
|
|
|
"Run BODY without active org-element-cache."
|
2022-05-07 03:34:10 +00:00
|
|
|
|
(declare (debug (form body)) (indent 0))
|
2022-01-30 07:17:38 +00:00
|
|
|
|
`(cl-letf (((symbol-function #'org-element--cache-active-p) (lambda (&rest _) nil)))
|
|
|
|
|
,@body))
|
|
|
|
|
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
2018-04-29 08:30:11 +00:00
|
|
|
|
;;; Buffer and windows
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
|
|
|
|
(defun org-base-buffer (buffer)
|
|
|
|
|
"Return the base buffer of BUFFER, if it has one. Else return the buffer."
|
Many small code improvements
* lisp/org-capture.el (org-capture-member): Make obsolete; the old
definition was identical to ‘org-capture-get’ anyway.
(org-capture-mode-map): Move the calls to ‘define-key’ up to where the
variable is defined.
(org-capture-mode-hook): Small docstring tweak.
(org-capture-mode): Fix typo in mode lighter.
(org-capture-set-target-location, org-capture-place-item):
(org-capture-place-plain-text, org-capture-narrow):
(org-capture-empty-lines-after):
(org-capture-import-remember-templates): ‘if’ without else -> ‘when’
* lisp/org-colview.el (org-columns-edit-value): Change an error to a
user-error.
(org-columns-uncompile-format): Improve docstring.
* lisp/org-compat.el (org-remove-from-invisibility-spec): Make
obsolete, the underlying emacs function exists since 1997, commit 31aa282e.
(org-in-invisibility-spec-p, org-count-lines): ‘if’ without else -> ‘when’.
* lisp/org-element.el (org-element-swap-A-B):
* lisp/org-entities.el (org-entities-create-table):
* lisp/org-list.el (org-insert-item):
* lisp/org-macs.el (org-with-point-at, org-base-buffer):
(org-preserve-local-variables, org-overlay-display):
(org-overlay-before-string): ‘if’ without else -> ‘when’.
* lisp/org-eshell.el (org-eshell-open): Fix docstring typo.
* lisp/org-pcomplete.el (pcomplete/org-mode/file-option/language):
(pcomplete/org-mode/file-option/startup):
(pcomplete/org-mode/file-option/options):
(pcomplete/org-mode/file-option/infojs_opt):
(pcomplete/org-mode/link, pcomplete/org-mode/tex):
(pcomplete/org-mode/todo, pcomplete/org-mode/searchhead):
(pcomplete/org-mode/tag, pcomplete/org-mode/prop): Avoid the formerly
misspelled ‘pcomplete-uniqify-list’ function. It has a defalias in
emacs >= 27; we add our own for older emacsen.
(pcomplete/org-mode/file-option/bind): ‘if’ without else -> ‘when’.
* lisp/org-protocol.el (org-protocol-capture):
(org-protocol-convert-query-to-plist): ‘if’ without else -> ‘when’.
(org-protocol-do-capture): Pacify byte compiler, simplify conditional
logic.
* lisp/org-table.el (org-table-create-with-table.el): Simplify conditional
logic.
(org-table-create, org-table-convert-region, org-table-next-field):
(org-table-beginning-of-field, org-table-end-of-field):
* lisp/org-w3m.el (org-w3m-copy-for-org-mode): ‘if’ without else ->
‘when’.
* lisp/org.el (org-babel-do-load-languages, org-previous-link):
(org-refile): Use ‘(foo ...)’ instead of ‘(funcall 'foo ...)’.
(org-add-log-note): Convert a long cond into a cl-case.
(org-priority): Improve docstring, show a deprecation warning if the
‘show’ argument is passed (which was previously silently ignored).
Also, use ?\s instead of ?\ as a character literal for space.
(org-fast-tag-insert): Fix docstring typo.
(org-fill-element): ‘if’ without else -> ‘when’.
(org-on-target-p): Remove ancient compatibility alias.
2018-05-10 01:02:35 +00:00
|
|
|
|
(when buffer
|
2017-10-22 13:34:26 +00:00
|
|
|
|
(or (buffer-base-buffer buffer)
|
|
|
|
|
buffer)))
|
|
|
|
|
|
|
|
|
|
(defun org-find-base-buffer-visiting (file)
|
|
|
|
|
"Like `find-buffer-visiting' but always return the base buffer and
|
|
|
|
|
not an indirect buffer."
|
|
|
|
|
(let ((buf (or (get-file-buffer file)
|
|
|
|
|
(find-buffer-visiting file))))
|
Many small code improvements
* lisp/org-capture.el (org-capture-member): Make obsolete; the old
definition was identical to ‘org-capture-get’ anyway.
(org-capture-mode-map): Move the calls to ‘define-key’ up to where the
variable is defined.
(org-capture-mode-hook): Small docstring tweak.
(org-capture-mode): Fix typo in mode lighter.
(org-capture-set-target-location, org-capture-place-item):
(org-capture-place-plain-text, org-capture-narrow):
(org-capture-empty-lines-after):
(org-capture-import-remember-templates): ‘if’ without else -> ‘when’
* lisp/org-colview.el (org-columns-edit-value): Change an error to a
user-error.
(org-columns-uncompile-format): Improve docstring.
* lisp/org-compat.el (org-remove-from-invisibility-spec): Make
obsolete, the underlying emacs function exists since 1997, commit 31aa282e.
(org-in-invisibility-spec-p, org-count-lines): ‘if’ without else -> ‘when’.
* lisp/org-element.el (org-element-swap-A-B):
* lisp/org-entities.el (org-entities-create-table):
* lisp/org-list.el (org-insert-item):
* lisp/org-macs.el (org-with-point-at, org-base-buffer):
(org-preserve-local-variables, org-overlay-display):
(org-overlay-before-string): ‘if’ without else -> ‘when’.
* lisp/org-eshell.el (org-eshell-open): Fix docstring typo.
* lisp/org-pcomplete.el (pcomplete/org-mode/file-option/language):
(pcomplete/org-mode/file-option/startup):
(pcomplete/org-mode/file-option/options):
(pcomplete/org-mode/file-option/infojs_opt):
(pcomplete/org-mode/link, pcomplete/org-mode/tex):
(pcomplete/org-mode/todo, pcomplete/org-mode/searchhead):
(pcomplete/org-mode/tag, pcomplete/org-mode/prop): Avoid the formerly
misspelled ‘pcomplete-uniqify-list’ function. It has a defalias in
emacs >= 27; we add our own for older emacsen.
(pcomplete/org-mode/file-option/bind): ‘if’ without else -> ‘when’.
* lisp/org-protocol.el (org-protocol-capture):
(org-protocol-convert-query-to-plist): ‘if’ without else -> ‘when’.
(org-protocol-do-capture): Pacify byte compiler, simplify conditional
logic.
* lisp/org-table.el (org-table-create-with-table.el): Simplify conditional
logic.
(org-table-create, org-table-convert-region, org-table-next-field):
(org-table-beginning-of-field, org-table-end-of-field):
* lisp/org-w3m.el (org-w3m-copy-for-org-mode): ‘if’ without else ->
‘when’.
* lisp/org.el (org-babel-do-load-languages, org-previous-link):
(org-refile): Use ‘(foo ...)’ instead of ‘(funcall 'foo ...)’.
(org-add-log-note): Convert a long cond into a cl-case.
(org-priority): Improve docstring, show a deprecation warning if the
‘show’ argument is passed (which was previously silently ignored).
Also, use ?\s instead of ?\ as a character literal for space.
(org-fast-tag-insert): Fix docstring typo.
(org-fill-element): ‘if’ without else -> ‘when’.
(org-on-target-p): Remove ancient compatibility alias.
2018-05-10 01:02:35 +00:00
|
|
|
|
(org-base-buffer buf)))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
2018-04-29 08:30:11 +00:00
|
|
|
|
(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)))
|
|
|
|
|
|
2022-01-16 07:38:55 +00:00
|
|
|
|
(defun org-buffer-list (&optional predicate exclude-tmp)
|
|
|
|
|
"Return a list of Org buffers.
|
|
|
|
|
PREDICATE can be `export', `files' or `agenda'.
|
|
|
|
|
|
|
|
|
|
export restrict the list to Export buffers.
|
|
|
|
|
files restrict the list to buffers visiting Org files.
|
|
|
|
|
agenda restrict the list to buffers visiting agenda files.
|
|
|
|
|
|
|
|
|
|
If EXCLUDE-TMP is non-nil, ignore temporary buffers."
|
|
|
|
|
(let* ((bfn nil)
|
|
|
|
|
(agenda-files (and (eq predicate 'agenda)
|
|
|
|
|
(mapcar 'file-truename (org-agenda-files t))))
|
|
|
|
|
(filter
|
|
|
|
|
(cond
|
|
|
|
|
((eq predicate 'files)
|
|
|
|
|
(lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
|
|
|
|
|
((eq predicate 'export)
|
|
|
|
|
(lambda (b) (string-match "\\*Org .*Export" (buffer-name b))))
|
|
|
|
|
((eq predicate 'agenda)
|
|
|
|
|
(lambda (b)
|
|
|
|
|
(with-current-buffer b
|
|
|
|
|
(and (derived-mode-p 'org-mode)
|
|
|
|
|
(setq bfn (buffer-file-name b))
|
|
|
|
|
(member (file-truename bfn) agenda-files)))))
|
|
|
|
|
(t (lambda (b) (with-current-buffer b
|
|
|
|
|
(or (derived-mode-p 'org-mode)
|
|
|
|
|
(string-match "\\*Org .*Export"
|
|
|
|
|
(buffer-name b)))))))))
|
|
|
|
|
(delq nil
|
|
|
|
|
(mapcar
|
|
|
|
|
(lambda(b)
|
|
|
|
|
(if (and (funcall filter b)
|
|
|
|
|
(or (not exclude-tmp)
|
|
|
|
|
(not (string-match "tmp" (buffer-name b)))))
|
|
|
|
|
b
|
|
|
|
|
nil))
|
|
|
|
|
(buffer-list)))))
|
|
|
|
|
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
2018-04-11 20:03:18 +00:00
|
|
|
|
|
|
|
|
|
;;; File
|
|
|
|
|
|
|
|
|
|
(defun org-file-newer-than-p (file time)
|
|
|
|
|
"Non-nil if FILE is newer than TIME.
|
|
|
|
|
FILE is a filename, as a string, TIME is a list of integers, as
|
|
|
|
|
returned by, e.g., `current-time'."
|
|
|
|
|
(and (file-exists-p file)
|
|
|
|
|
;; Only compare times up to whole seconds as some file-systems
|
|
|
|
|
;; (e.g. HFS+) do not retain any finer granularity. As
|
|
|
|
|
;; a consequence, make sure we return non-nil when the two
|
|
|
|
|
;; times are equal.
|
|
|
|
|
(not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2)
|
|
|
|
|
(cl-subseq time 0 2)))))
|
|
|
|
|
|
|
|
|
|
(defun org-compile-file (source process ext &optional err-msg log-buf spec)
|
|
|
|
|
"Compile a SOURCE file using PROCESS.
|
|
|
|
|
|
|
|
|
|
PROCESS is either a function or a list of shell commands, as
|
|
|
|
|
strings. EXT is a file extension, without the leading dot, as
|
|
|
|
|
a string. It is used to check if the process actually succeeded.
|
|
|
|
|
|
|
|
|
|
PROCESS must create a file with the same base name and directory
|
|
|
|
|
as SOURCE, but ending with EXT. The function then returns its
|
|
|
|
|
filename. Otherwise, it raises an error. The error message can
|
|
|
|
|
then be refined by providing string ERR-MSG, which is appended to
|
|
|
|
|
the standard message.
|
|
|
|
|
|
|
|
|
|
If PROCESS is a function, it is called with a single argument:
|
|
|
|
|
the SOURCE file.
|
|
|
|
|
|
|
|
|
|
If it is a list of commands, each of them is called using
|
|
|
|
|
`shell-command'. By default, in each command, %b, %f, %F, %o and
|
|
|
|
|
%O are replaced with, respectively, SOURCE base name, name, full
|
|
|
|
|
name, directory and absolute output file name. It is possible,
|
|
|
|
|
however, to use more place-holders by specifying them in optional
|
|
|
|
|
argument SPEC, as an alist following the pattern
|
|
|
|
|
|
|
|
|
|
(CHARACTER . REPLACEMENT-STRING).
|
|
|
|
|
|
|
|
|
|
When PROCESS is a list of commands, optional argument LOG-BUF can
|
|
|
|
|
be set to a buffer or a buffer name. `shell-command' then uses
|
|
|
|
|
it for output."
|
|
|
|
|
(let* ((base-name (file-name-base source))
|
|
|
|
|
(full-name (file-truename source))
|
|
|
|
|
(out-dir (or (file-name-directory source) "./"))
|
|
|
|
|
(output (expand-file-name (concat base-name "." ext) out-dir))
|
|
|
|
|
(time (current-time))
|
|
|
|
|
(err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
|
|
|
|
|
(save-window-excursion
|
|
|
|
|
(pcase process
|
|
|
|
|
((pred functionp) (funcall process (shell-quote-argument source)))
|
|
|
|
|
((pred consp)
|
|
|
|
|
(let ((log-buf (and log-buf (get-buffer-create log-buf)))
|
|
|
|
|
(spec (append spec
|
|
|
|
|
`((?b . ,(shell-quote-argument base-name))
|
|
|
|
|
(?f . ,(shell-quote-argument source))
|
|
|
|
|
(?F . ,(shell-quote-argument full-name))
|
|
|
|
|
(?o . ,(shell-quote-argument out-dir))
|
|
|
|
|
(?O . ,(shell-quote-argument output))))))
|
|
|
|
|
(dolist (command process)
|
|
|
|
|
(shell-command (format-spec command spec) log-buf))
|
|
|
|
|
(when log-buf (with-current-buffer log-buf (compilation-mode)))))
|
|
|
|
|
(_ (error "No valid command to process %S%s" source err-msg))))
|
|
|
|
|
;; Check for process failure. Output file is expected to be
|
|
|
|
|
;; located in the same directory as SOURCE.
|
|
|
|
|
(unless (org-file-newer-than-p output time)
|
|
|
|
|
(error (format "File %S wasn't produced%s" output err-msg)))
|
|
|
|
|
output))
|
|
|
|
|
|
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
|
|
|
|
|
;;; Indentation
|
|
|
|
|
|
2021-08-30 21:18:41 +00:00
|
|
|
|
(defun org-do-remove-indentation (&optional n skip-fl)
|
2018-04-29 10:09:34 +00:00
|
|
|
|
"Remove the maximum common indentation from the buffer.
|
|
|
|
|
When optional argument N is a positive integer, remove exactly
|
2021-08-30 21:18:41 +00:00
|
|
|
|
that much characters from indentation, if possible. When
|
|
|
|
|
optional argument SKIP-FL is non-nil, skip the first
|
|
|
|
|
line. Return nil if it fails."
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(catch :exit
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
;; Find maximum common indentation, if not specified.
|
|
|
|
|
(let ((n (or n
|
|
|
|
|
(let ((min-ind (point-max)))
|
|
|
|
|
(save-excursion
|
2021-08-30 21:18:41 +00:00
|
|
|
|
(when skip-fl (forward-line))
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(while (re-search-forward "^[ \t]*\\S-" nil t)
|
2019-09-16 16:42:59 +00:00
|
|
|
|
(let ((ind (current-indentation)))
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(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.
|
2021-08-30 21:18:41 +00:00
|
|
|
|
(when skip-fl (forward-line))
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
|
2017-10-17 08:11:21 +00:00
|
|
|
|
|
|
|
|
|
;;; Input
|
|
|
|
|
|
|
|
|
|
(defun org-read-function (prompt &optional allow-empty?)
|
|
|
|
|
"Prompt for a function.
|
|
|
|
|
If ALLOW-EMPTY? is non-nil, return nil rather than raising an
|
|
|
|
|
error when the user input is empty."
|
|
|
|
|
(let ((func (completing-read prompt obarray #'fboundp t)))
|
|
|
|
|
(cond ((not (string= func ""))
|
|
|
|
|
(intern func))
|
|
|
|
|
(allow-empty? nil)
|
|
|
|
|
(t (user-error "Empty input is not valid")))))
|
|
|
|
|
|
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
2021-02-23 20:47:29 +00:00
|
|
|
|
(declare-function org-time-stamp-inactive "org" (&optional arg))
|
|
|
|
|
|
2017-10-17 08:11:21 +00:00
|
|
|
|
(defun org-completing-read (&rest args)
|
|
|
|
|
"Completing-read with SPACE being a normal character."
|
|
|
|
|
(let ((enable-recursive-minibuffers t)
|
|
|
|
|
(minibuffer-local-completion-map
|
|
|
|
|
(copy-keymap minibuffer-local-completion-map)))
|
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
2021-02-23 20:47:29 +00:00
|
|
|
|
(define-key minibuffer-local-completion-map " " #'self-insert-command)
|
|
|
|
|
(define-key minibuffer-local-completion-map "?" #'self-insert-command)
|
2018-02-11 10:40:21 +00:00
|
|
|
|
(define-key minibuffer-local-completion-map (kbd "C-c !")
|
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
2021-02-23 20:47:29 +00:00
|
|
|
|
#'org-time-stamp-inactive)
|
2017-10-17 08:11:21 +00:00
|
|
|
|
(apply #'completing-read args)))
|
|
|
|
|
|
2020-12-16 21:15:39 +00:00
|
|
|
|
(defun org--mks-read-key (allowed-keys prompt navigation-keys)
|
2018-04-07 12:24:36 +00:00
|
|
|
|
"Read a key and ensure it is a member of ALLOWED-KEYS.
|
2020-12-16 21:15:39 +00:00
|
|
|
|
Enable keys to scroll the window if NAVIGATION-KEYS is set.
|
2018-04-07 12:24:36 +00:00
|
|
|
|
TAB, SPC and RET are treated equivalently."
|
2020-12-16 21:15:39 +00:00
|
|
|
|
(setq header-line-format (when navigation-keys "Use C-n, C-p, C-v, M-v to navigate."))
|
|
|
|
|
(let ((char-key (read-char-exclusive prompt)))
|
|
|
|
|
(if (and navigation-keys (memq char-key '(14 16 22 134217846)))
|
|
|
|
|
(progn
|
|
|
|
|
(org-scroll char-key)
|
|
|
|
|
(org--mks-read-key allowed-keys prompt navigation-keys))
|
|
|
|
|
(let ((key (char-to-string
|
|
|
|
|
(pcase char-key
|
|
|
|
|
((or ?\s ?\t ?\r) ?\t)
|
|
|
|
|
(char char)))))
|
|
|
|
|
(if (member key allowed-keys)
|
|
|
|
|
key
|
|
|
|
|
(message "Invalid key: `%s'" key)
|
|
|
|
|
(sit-for 1)
|
|
|
|
|
(org--mks-read-key allowed-keys prompt navigation-keys))))))
|
2018-04-07 12:24:36 +00:00
|
|
|
|
|
2018-04-07 10:58:51 +00:00
|
|
|
|
(defun org-mks (table title &optional prompt specials)
|
|
|
|
|
"Select a member of an alist with multiple keys.
|
|
|
|
|
|
|
|
|
|
TABLE is the alist which should contain entries where the car is a string.
|
|
|
|
|
There should be two types of entries.
|
|
|
|
|
|
|
|
|
|
1. prefix descriptions like (\"a\" \"Description\")
|
|
|
|
|
This indicates that `a' is a prefix key for multi-letter selection, and
|
|
|
|
|
that there are entries following with keys like \"ab\", \"ax\"...
|
|
|
|
|
|
|
|
|
|
2. Select-able members must have more than two elements, with the first
|
|
|
|
|
being the string of keys that lead to selecting it, and the second a
|
|
|
|
|
short description string of the item.
|
|
|
|
|
|
|
|
|
|
The command will then make a temporary buffer listing all entries
|
|
|
|
|
that can be selected with a single key, and all the single key
|
|
|
|
|
prefixes. When you press the key for a single-letter entry, it is selected.
|
|
|
|
|
When you press a prefix key, the commands (and maybe further prefixes)
|
|
|
|
|
under this key will be shown and offered for selection.
|
|
|
|
|
|
|
|
|
|
TITLE will be placed over the selection in the temporary buffer,
|
2018-05-03 07:25:56 +00:00
|
|
|
|
PROMPT will be used when prompting for a key. SPECIALS is an
|
2018-04-07 10:58:51 +00:00
|
|
|
|
alist with (\"key\" \"description\") entries. When one of these
|
|
|
|
|
is selected, only the bare key is returned."
|
|
|
|
|
(save-window-excursion
|
|
|
|
|
(let ((inhibit-quit t)
|
|
|
|
|
(buffer (org-switch-to-buffer-other-window "*Org Select*"))
|
|
|
|
|
(prompt (or prompt "Select: "))
|
2020-02-01 09:15:20 +00:00
|
|
|
|
case-fold-search
|
2018-04-07 10:58:51 +00:00
|
|
|
|
current)
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(catch 'exit
|
|
|
|
|
(while t
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(insert title "\n\n")
|
|
|
|
|
(let ((des-keys nil)
|
|
|
|
|
(allowed-keys '("\C-g"))
|
2018-04-07 12:24:36 +00:00
|
|
|
|
(tab-alternatives '("\s" "\t" "\r"))
|
2018-04-07 10:58:51 +00:00
|
|
|
|
(cursor-type nil))
|
|
|
|
|
;; Populate allowed keys and descriptions keys
|
|
|
|
|
;; available with CURRENT selector.
|
|
|
|
|
(let ((re (format "\\`%s\\(.\\)\\'"
|
|
|
|
|
(if current (regexp-quote current) "")))
|
|
|
|
|
(prefix (if current (concat current " ") "")))
|
|
|
|
|
(dolist (entry table)
|
|
|
|
|
(pcase entry
|
|
|
|
|
;; Description.
|
|
|
|
|
(`(,(and key (pred (string-match re))) ,desc)
|
|
|
|
|
(let ((k (match-string 1 key)))
|
|
|
|
|
(push k des-keys)
|
2018-04-07 12:24:36 +00:00
|
|
|
|
;; Keys ending in tab, space or RET are equivalent.
|
|
|
|
|
(if (member k tab-alternatives)
|
|
|
|
|
(push "\t" allowed-keys)
|
|
|
|
|
(push k allowed-keys))
|
2018-04-07 10:58:51 +00:00
|
|
|
|
(insert prefix "[" k "]" "..." " " desc "..." "\n")))
|
|
|
|
|
;; Usable entry.
|
|
|
|
|
(`(,(and key (pred (string-match re))) ,desc . ,_)
|
|
|
|
|
(let ((k (match-string 1 key)))
|
|
|
|
|
(insert prefix "[" k "]" " " desc "\n")
|
|
|
|
|
(push k allowed-keys)))
|
|
|
|
|
(_ nil))))
|
|
|
|
|
;; Insert special entries, if any.
|
|
|
|
|
(when specials
|
|
|
|
|
(insert "----------------------------------------------------\
|
|
|
|
|
---------------------------\n")
|
|
|
|
|
(pcase-dolist (`(,key ,description) specials)
|
|
|
|
|
(insert (format "[%s] %s\n" key description))
|
|
|
|
|
(push key allowed-keys)))
|
|
|
|
|
;; Display UI and let user select an entry or
|
|
|
|
|
;; a sub-level prefix.
|
|
|
|
|
(goto-char (point-min))
|
2020-12-14 00:37:25 +00:00
|
|
|
|
(org-fit-window-to-buffer)
|
2020-12-16 21:15:39 +00:00
|
|
|
|
(message "") ; With this line the prompt appears in
|
2021-09-29 07:22:47 +00:00
|
|
|
|
; the minibuffer. Else keystrokes may
|
|
|
|
|
; appear, which is spurious.
|
2020-12-16 21:15:39 +00:00
|
|
|
|
(let ((pressed (org--mks-read-key
|
|
|
|
|
allowed-keys prompt
|
|
|
|
|
(not (pos-visible-in-window-p (1- (point-max)))))))
|
2018-04-07 10:58:51 +00:00
|
|
|
|
(setq current (concat current pressed))
|
|
|
|
|
(cond
|
|
|
|
|
((equal pressed "\C-g") (user-error "Abort"))
|
|
|
|
|
;; Selection is a prefix: open a new menu.
|
|
|
|
|
((member pressed des-keys))
|
|
|
|
|
;; Selection matches an association: return it.
|
|
|
|
|
((let ((entry (assoc current table)))
|
|
|
|
|
(and entry (throw 'exit entry))))
|
|
|
|
|
;; Selection matches a special entry: return the
|
|
|
|
|
;; selection prefix.
|
|
|
|
|
((assoc current specials) (throw 'exit current))
|
|
|
|
|
(t (error "No entry available")))))))
|
|
|
|
|
(when buffer (kill-buffer buffer))))))
|
2017-10-17 08:11:21 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
|
|
|
|
|
;;; 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)
|
|
|
|
|
|
2021-09-29 07:14:43 +00:00
|
|
|
|
(defun org-plist-delete-all (plist props)
|
|
|
|
|
"Delete all elements in PROPS from PLIST."
|
|
|
|
|
(dolist (e props plist)
|
|
|
|
|
(setq plist (org-plist-delete plist e))))
|
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(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)))))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; 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)))
|
|
|
|
|
|
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
2021-02-23 20:47:29 +00:00
|
|
|
|
(defmacro org-dlet (binders &rest body)
|
|
|
|
|
"Like `let*' but using dynamic scoping."
|
|
|
|
|
(declare (indent 1) (debug let))
|
|
|
|
|
(let ((vars (mapcar (lambda (binder)
|
|
|
|
|
(if (consp binder) (car binder) binder))
|
|
|
|
|
binders)))
|
|
|
|
|
`(progn
|
|
|
|
|
(with-no-warnings
|
|
|
|
|
,@(mapcar (lambda (var) `(defvar ,var)) vars))
|
|
|
|
|
(let* ,binders ,@body))))
|
|
|
|
|
|
|
|
|
|
(defmacro org-pushnew-to-end (val var)
|
|
|
|
|
"Like `cl-pushnew' but pushes to the end of the list.
|
|
|
|
|
Uses `equal' for comparisons.
|
|
|
|
|
|
|
|
|
|
Beware: this performs O(N) memory allocations, so if you use it in a loop, you
|
|
|
|
|
get an unnecessary O(N²) space complexity, so you're usually better off using
|
|
|
|
|
`cl-pushnew' (with a final `reverse' if you care about the order of elements)."
|
|
|
|
|
(declare (debug (form gv-place)))
|
|
|
|
|
(let ((v (make-symbol "v")))
|
|
|
|
|
`(let ((,v ,val))
|
|
|
|
|
(unless (member ,v ,var)
|
|
|
|
|
(setf ,var (append ,var (list ,v)))))))
|
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(defun org-eval (form)
|
|
|
|
|
"Eval FORM and return result."
|
|
|
|
|
(condition-case error
|
2021-02-22 16:54:17 +00:00
|
|
|
|
(eval form t)
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(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.
|
2019-09-20 22:27:53 +00:00
|
|
|
|
The number of levels is controlled by `org-inlinetask-min-level'."
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(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)))))
|
|
|
|
|
|
2020-04-30 09:18:11 +00:00
|
|
|
|
(defun org--line-empty-p (n)
|
|
|
|
|
"Is the Nth next line empty?
|
|
|
|
|
Counts the current line as N = 1 and the previous line as N = 0;
|
|
|
|
|
see `beginning-of-line'."
|
|
|
|
|
(and (not (bobp))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(beginning-of-line n)
|
|
|
|
|
(looking-at-p "[ \t]*$"))))
|
|
|
|
|
|
|
|
|
|
(defun org-previous-line-empty-p ()
|
|
|
|
|
"Is the previous line a blank line?
|
|
|
|
|
When NEXT is non-nil, check the next line instead."
|
|
|
|
|
(org--line-empty-p 0))
|
|
|
|
|
|
|
|
|
|
(defun org-next-line-empty-p ()
|
|
|
|
|
"Is the previous line a blank line?
|
|
|
|
|
When NEXT is non-nil, check the next line instead."
|
|
|
|
|
(org--line-empty-p 2))
|
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
|
2018-06-19 20:42:11 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
;;; 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)))))
|
|
|
|
|
|
|
|
|
|
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
2022-01-16 07:28:08 +00:00
|
|
|
|
;;; Overlays and text properties
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
|
|
|
|
(defun org-overlay-display (ovl text &optional face evap)
|
|
|
|
|
"Make overlay OVL display TEXT with face FACE."
|
|
|
|
|
(overlay-put ovl 'display text)
|
Many small code improvements
* lisp/org-capture.el (org-capture-member): Make obsolete; the old
definition was identical to ‘org-capture-get’ anyway.
(org-capture-mode-map): Move the calls to ‘define-key’ up to where the
variable is defined.
(org-capture-mode-hook): Small docstring tweak.
(org-capture-mode): Fix typo in mode lighter.
(org-capture-set-target-location, org-capture-place-item):
(org-capture-place-plain-text, org-capture-narrow):
(org-capture-empty-lines-after):
(org-capture-import-remember-templates): ‘if’ without else -> ‘when’
* lisp/org-colview.el (org-columns-edit-value): Change an error to a
user-error.
(org-columns-uncompile-format): Improve docstring.
* lisp/org-compat.el (org-remove-from-invisibility-spec): Make
obsolete, the underlying emacs function exists since 1997, commit 31aa282e.
(org-in-invisibility-spec-p, org-count-lines): ‘if’ without else -> ‘when’.
* lisp/org-element.el (org-element-swap-A-B):
* lisp/org-entities.el (org-entities-create-table):
* lisp/org-list.el (org-insert-item):
* lisp/org-macs.el (org-with-point-at, org-base-buffer):
(org-preserve-local-variables, org-overlay-display):
(org-overlay-before-string): ‘if’ without else -> ‘when’.
* lisp/org-eshell.el (org-eshell-open): Fix docstring typo.
* lisp/org-pcomplete.el (pcomplete/org-mode/file-option/language):
(pcomplete/org-mode/file-option/startup):
(pcomplete/org-mode/file-option/options):
(pcomplete/org-mode/file-option/infojs_opt):
(pcomplete/org-mode/link, pcomplete/org-mode/tex):
(pcomplete/org-mode/todo, pcomplete/org-mode/searchhead):
(pcomplete/org-mode/tag, pcomplete/org-mode/prop): Avoid the formerly
misspelled ‘pcomplete-uniqify-list’ function. It has a defalias in
emacs >= 27; we add our own for older emacsen.
(pcomplete/org-mode/file-option/bind): ‘if’ without else -> ‘when’.
* lisp/org-protocol.el (org-protocol-capture):
(org-protocol-convert-query-to-plist): ‘if’ without else -> ‘when’.
(org-protocol-do-capture): Pacify byte compiler, simplify conditional
logic.
* lisp/org-table.el (org-table-create-with-table.el): Simplify conditional
logic.
(org-table-create, org-table-convert-region, org-table-next-field):
(org-table-beginning-of-field, org-table-end-of-field):
* lisp/org-w3m.el (org-w3m-copy-for-org-mode): ‘if’ without else ->
‘when’.
* lisp/org.el (org-babel-do-load-languages, org-previous-link):
(org-refile): Use ‘(foo ...)’ instead of ‘(funcall 'foo ...)’.
(org-add-log-note): Convert a long cond into a cl-case.
(org-priority): Improve docstring, show a deprecation warning if the
‘show’ argument is passed (which was previously silently ignored).
Also, use ?\s instead of ?\ as a character literal for space.
(org-fast-tag-insert): Fix docstring typo.
(org-fill-element): ‘if’ without else -> ‘when’.
(org-on-target-p): Remove ancient compatibility alias.
2018-05-10 01:02:35 +00:00
|
|
|
|
(when face (overlay-put ovl 'face face))
|
|
|
|
|
(when evap (overlay-put ovl 'evaporate t)))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
|
|
|
|
(defun org-overlay-before-string (ovl text &optional face evap)
|
|
|
|
|
"Make overlay OVL display TEXT with face FACE."
|
Many small code improvements
* lisp/org-capture.el (org-capture-member): Make obsolete; the old
definition was identical to ‘org-capture-get’ anyway.
(org-capture-mode-map): Move the calls to ‘define-key’ up to where the
variable is defined.
(org-capture-mode-hook): Small docstring tweak.
(org-capture-mode): Fix typo in mode lighter.
(org-capture-set-target-location, org-capture-place-item):
(org-capture-place-plain-text, org-capture-narrow):
(org-capture-empty-lines-after):
(org-capture-import-remember-templates): ‘if’ without else -> ‘when’
* lisp/org-colview.el (org-columns-edit-value): Change an error to a
user-error.
(org-columns-uncompile-format): Improve docstring.
* lisp/org-compat.el (org-remove-from-invisibility-spec): Make
obsolete, the underlying emacs function exists since 1997, commit 31aa282e.
(org-in-invisibility-spec-p, org-count-lines): ‘if’ without else -> ‘when’.
* lisp/org-element.el (org-element-swap-A-B):
* lisp/org-entities.el (org-entities-create-table):
* lisp/org-list.el (org-insert-item):
* lisp/org-macs.el (org-with-point-at, org-base-buffer):
(org-preserve-local-variables, org-overlay-display):
(org-overlay-before-string): ‘if’ without else -> ‘when’.
* lisp/org-eshell.el (org-eshell-open): Fix docstring typo.
* lisp/org-pcomplete.el (pcomplete/org-mode/file-option/language):
(pcomplete/org-mode/file-option/startup):
(pcomplete/org-mode/file-option/options):
(pcomplete/org-mode/file-option/infojs_opt):
(pcomplete/org-mode/link, pcomplete/org-mode/tex):
(pcomplete/org-mode/todo, pcomplete/org-mode/searchhead):
(pcomplete/org-mode/tag, pcomplete/org-mode/prop): Avoid the formerly
misspelled ‘pcomplete-uniqify-list’ function. It has a defalias in
emacs >= 27; we add our own for older emacsen.
(pcomplete/org-mode/file-option/bind): ‘if’ without else -> ‘when’.
* lisp/org-protocol.el (org-protocol-capture):
(org-protocol-convert-query-to-plist): ‘if’ without else -> ‘when’.
(org-protocol-do-capture): Pacify byte compiler, simplify conditional
logic.
* lisp/org-table.el (org-table-create-with-table.el): Simplify conditional
logic.
(org-table-create, org-table-convert-region, org-table-next-field):
(org-table-beginning-of-field, org-table-end-of-field):
* lisp/org-w3m.el (org-w3m-copy-for-org-mode): ‘if’ without else ->
‘when’.
* lisp/org.el (org-babel-do-load-languages, org-previous-link):
(org-refile): Use ‘(foo ...)’ instead of ‘(funcall 'foo ...)’.
(org-add-log-note): Convert a long cond into a cl-case.
(org-priority): Improve docstring, show a deprecation warning if the
‘show’ argument is passed (which was previously silently ignored).
Also, use ?\s instead of ?\ as a character literal for space.
(org-fast-tag-insert): Fix docstring typo.
(org-fill-element): ‘if’ without else -> ‘when’.
(org-on-target-p): Remove ancient compatibility alias.
2018-05-10 01:02:35 +00:00
|
|
|
|
(when face (org-add-props text nil 'face face))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
(overlay-put ovl 'before-string text)
|
Many small code improvements
* lisp/org-capture.el (org-capture-member): Make obsolete; the old
definition was identical to ‘org-capture-get’ anyway.
(org-capture-mode-map): Move the calls to ‘define-key’ up to where the
variable is defined.
(org-capture-mode-hook): Small docstring tweak.
(org-capture-mode): Fix typo in mode lighter.
(org-capture-set-target-location, org-capture-place-item):
(org-capture-place-plain-text, org-capture-narrow):
(org-capture-empty-lines-after):
(org-capture-import-remember-templates): ‘if’ without else -> ‘when’
* lisp/org-colview.el (org-columns-edit-value): Change an error to a
user-error.
(org-columns-uncompile-format): Improve docstring.
* lisp/org-compat.el (org-remove-from-invisibility-spec): Make
obsolete, the underlying emacs function exists since 1997, commit 31aa282e.
(org-in-invisibility-spec-p, org-count-lines): ‘if’ without else -> ‘when’.
* lisp/org-element.el (org-element-swap-A-B):
* lisp/org-entities.el (org-entities-create-table):
* lisp/org-list.el (org-insert-item):
* lisp/org-macs.el (org-with-point-at, org-base-buffer):
(org-preserve-local-variables, org-overlay-display):
(org-overlay-before-string): ‘if’ without else -> ‘when’.
* lisp/org-eshell.el (org-eshell-open): Fix docstring typo.
* lisp/org-pcomplete.el (pcomplete/org-mode/file-option/language):
(pcomplete/org-mode/file-option/startup):
(pcomplete/org-mode/file-option/options):
(pcomplete/org-mode/file-option/infojs_opt):
(pcomplete/org-mode/link, pcomplete/org-mode/tex):
(pcomplete/org-mode/todo, pcomplete/org-mode/searchhead):
(pcomplete/org-mode/tag, pcomplete/org-mode/prop): Avoid the formerly
misspelled ‘pcomplete-uniqify-list’ function. It has a defalias in
emacs >= 27; we add our own for older emacsen.
(pcomplete/org-mode/file-option/bind): ‘if’ without else -> ‘when’.
* lisp/org-protocol.el (org-protocol-capture):
(org-protocol-convert-query-to-plist): ‘if’ without else -> ‘when’.
(org-protocol-do-capture): Pacify byte compiler, simplify conditional
logic.
* lisp/org-table.el (org-table-create-with-table.el): Simplify conditional
logic.
(org-table-create, org-table-convert-region, org-table-next-field):
(org-table-beginning-of-field, org-table-end-of-field):
* lisp/org-w3m.el (org-w3m-copy-for-org-mode): ‘if’ without else ->
‘when’.
* lisp/org.el (org-babel-do-load-languages, org-previous-link):
(org-refile): Use ‘(foo ...)’ instead of ‘(funcall 'foo ...)’.
(org-add-log-note): Convert a long cond into a cl-case.
(org-priority): Improve docstring, show a deprecation warning if the
‘show’ argument is passed (which was previously silently ignored).
Also, use ?\s instead of ?\ as a character literal for space.
(org-fast-tag-insert): Fix docstring typo.
(org-fill-element): ‘if’ without else -> ‘when’.
(org-on-target-p): Remove ancient compatibility alias.
2018-05-10 01:02:35 +00:00
|
|
|
|
(when evap (overlay-put ovl 'evaporate t)))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
|
|
|
|
(defun org-find-overlays (prop &optional pos delete)
|
|
|
|
|
"Find all overlays specifying PROP at POS or point.
|
|
|
|
|
If DELETE is non-nil, delete all those overlays."
|
|
|
|
|
(let (found)
|
|
|
|
|
(dolist (ov (overlays-at (or pos (point))) found)
|
|
|
|
|
(cond ((not (overlay-get ov prop)))
|
|
|
|
|
(delete (delete-overlay ov))
|
|
|
|
|
(t (push ov found))))))
|
|
|
|
|
|
2022-01-16 07:28:08 +00:00
|
|
|
|
(defun org-find-text-property-region (pos prop)
|
|
|
|
|
"Find a region around POS containing same non-nil value of PROP text property.
|
|
|
|
|
Return nil when PROP is not set at POS."
|
|
|
|
|
(let* ((beg (and (get-text-property pos prop) pos))
|
|
|
|
|
(end beg))
|
|
|
|
|
(when beg
|
|
|
|
|
(unless (or (equal beg (point-min))
|
|
|
|
|
(not (eq (get-text-property beg prop)
|
|
|
|
|
(get-text-property (1- beg) prop))))
|
|
|
|
|
(setq beg (previous-single-property-change pos prop nil (point-min))))
|
|
|
|
|
(unless (or (equal end (point-max))
|
|
|
|
|
;; (not (eq (get-text-property end prop)
|
|
|
|
|
;; (get-text-property (1+ end) prop)))
|
|
|
|
|
)
|
|
|
|
|
(setq end (next-single-property-change pos prop nil (point-max))))
|
|
|
|
|
(cons beg end))))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
2018-01-20 14:52:11 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
;;; Regexp matching
|
2018-01-20 14:52:11 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(defsubst org-pos-in-match-range (pos n)
|
|
|
|
|
(and (match-beginning n)
|
|
|
|
|
(<= (match-beginning n) pos)
|
|
|
|
|
(>= (match-end n) pos)))
|
2018-01-20 14:52:11 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(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)))
|
2018-01-20 14:52:11 +00:00
|
|
|
|
|
2021-05-18 14:31:39 +00:00
|
|
|
|
(defun org-url-p (s)
|
|
|
|
|
"Non-nil if string S is a URL."
|
|
|
|
|
(require 'ffap)
|
2021-09-01 14:33:39 +00:00
|
|
|
|
(and ffap-url-regexp (string-match-p ffap-url-regexp s)))
|
2018-01-20 14:52:11 +00:00
|
|
|
|
|
2017-09-18 19:24:23 +00:00
|
|
|
|
|
|
|
|
|
;;; String manipulation
|
|
|
|
|
|
2018-03-13 08:26:53 +00:00
|
|
|
|
(defun org-string< (a b)
|
2021-10-05 03:43:14 +00:00
|
|
|
|
(string-collate-lessp a b))
|
2018-03-13 08:26:53 +00:00
|
|
|
|
|
|
|
|
|
(defun org-string<= (a b)
|
2021-10-05 03:43:14 +00:00
|
|
|
|
(or (string= a b) (string-collate-lessp a b)))
|
2018-03-13 08:26:53 +00:00
|
|
|
|
|
|
|
|
|
(defun org-string>= (a b)
|
2021-10-05 03:43:14 +00:00
|
|
|
|
(not (string-collate-lessp a b)))
|
2018-03-13 08:26:53 +00:00
|
|
|
|
|
|
|
|
|
(defun org-string> (a b)
|
|
|
|
|
(and (not (string= a b))
|
2021-10-05 03:43:14 +00:00
|
|
|
|
(not (string-collate-lessp a b))))
|
2018-03-13 08:26:53 +00:00
|
|
|
|
|
|
|
|
|
(defun org-string<> (a b)
|
|
|
|
|
(not (string= a b)))
|
|
|
|
|
|
2017-09-18 19:07:13 +00:00
|
|
|
|
(defsubst org-trim (s &optional keep-lead)
|
|
|
|
|
"Remove whitespace at the beginning and the end of string S.
|
|
|
|
|
When optional argument KEEP-LEAD is non-nil, removing blank lines
|
|
|
|
|
at the beginning of the string does not affect leading indentation."
|
|
|
|
|
(replace-regexp-in-string
|
|
|
|
|
(if keep-lead "\\`\\([ \t]*\n\\)+" "\\`[ \t\n\r]+") ""
|
|
|
|
|
(replace-regexp-in-string "[ \t\n\r]+\\'" "" s)))
|
|
|
|
|
|
2010-07-20 05:54:11 +00:00
|
|
|
|
(defun org-string-nw-p (s)
|
2015-02-26 14:14:40 +00:00
|
|
|
|
"Return S if S is a string containing a non-blank character.
|
|
|
|
|
Otherwise, return nil."
|
2010-07-20 05:54:11 +00:00
|
|
|
|
(and (stringp s)
|
2016-06-23 08:00:00 +00:00
|
|
|
|
(string-match-p "[^ \r\t\n]" s)
|
2010-07-20 05:54:11 +00:00
|
|
|
|
s))
|
|
|
|
|
|
2017-10-22 13:34:26 +00:00
|
|
|
|
(defun org-reverse-string (string)
|
|
|
|
|
"Return the reverse of STRING."
|
|
|
|
|
(apply #'string (nreverse (string-to-list string))))
|
|
|
|
|
|
2017-07-27 11:39:52 +00:00
|
|
|
|
(defun org-split-string (string &optional separators)
|
|
|
|
|
"Splits STRING into substrings at SEPARATORS.
|
|
|
|
|
|
|
|
|
|
SEPARATORS is a regular expression. When nil, it defaults to
|
|
|
|
|
\"[ \f\t\n\r\v]+\".
|
|
|
|
|
|
2017-11-15 17:58:44 +00:00
|
|
|
|
Unlike `split-string', matching SEPARATORS at the beginning and
|
|
|
|
|
end of string are ignored."
|
2017-07-27 11:39:52 +00:00
|
|
|
|
(let ((separators (or separators "[ \f\t\n\r\v]+")))
|
2018-07-18 17:06:25 +00:00
|
|
|
|
(if (not (string-match separators string)) (list string)
|
|
|
|
|
(let ((i (match-end 0))
|
|
|
|
|
(results
|
|
|
|
|
(and (/= 0 (match-beginning 0)) ;skip leading separator
|
|
|
|
|
(list (substring string 0 (match-beginning 0))))))
|
|
|
|
|
(while (string-match separators string i)
|
|
|
|
|
(push (substring string i (match-beginning 0))
|
|
|
|
|
results)
|
|
|
|
|
(setq i (match-end 0)))
|
|
|
|
|
(nreverse (if (= i (length string))
|
|
|
|
|
results ;skip trailing separator
|
|
|
|
|
(cons (substring string i) results)))))))
|
2017-07-27 11:39:52 +00:00
|
|
|
|
|
2022-01-23 05:35:53 +00:00
|
|
|
|
(defun org--string-from-props (s property beg end)
|
|
|
|
|
"Return the visible part of string S.
|
|
|
|
|
Visible part is determined according to text PROPERTY, which is
|
|
|
|
|
either `invisible' or `display'. BEG and END are 0-indices
|
|
|
|
|
delimiting S."
|
|
|
|
|
(let ((width 0)
|
|
|
|
|
(cursor beg))
|
|
|
|
|
(while (setq beg (text-property-not-all beg end property nil s))
|
|
|
|
|
(let* ((next (next-single-property-change beg property s end))
|
2022-01-29 10:28:11 +00:00
|
|
|
|
(spec (get-text-property beg property s))
|
2022-01-23 05:35:53 +00:00
|
|
|
|
(value
|
|
|
|
|
(pcase property
|
|
|
|
|
(`invisible
|
2022-01-29 10:28:11 +00:00
|
|
|
|
;; If `invisible' property means text is to be
|
|
|
|
|
;; invisible, return 0. Otherwise return nil so as
|
|
|
|
|
;; to resume search.
|
2022-01-23 05:35:53 +00:00
|
|
|
|
(and (or (eq t buffer-invisibility-spec)
|
|
|
|
|
(assoc-string spec buffer-invisibility-spec))
|
|
|
|
|
0))
|
|
|
|
|
(`display
|
|
|
|
|
(pcase spec
|
|
|
|
|
(`nil nil)
|
|
|
|
|
(`(space . ,props)
|
|
|
|
|
(let ((width (plist-get props :width)))
|
|
|
|
|
(and (wholenump width) width)))
|
|
|
|
|
(`(image . ,_)
|
|
|
|
|
(and (fboundp 'image-size)
|
|
|
|
|
(ceiling (car (image-size spec)))))
|
|
|
|
|
((pred stringp)
|
|
|
|
|
;; Displayed string could contain invisible parts,
|
|
|
|
|
;; but no nested display.
|
|
|
|
|
(org--string-from-props spec 'invisible 0 (length spec)))
|
|
|
|
|
(_
|
|
|
|
|
;; Un-handled `display' value. Ignore it.
|
|
|
|
|
;; Consider the original string instead.
|
|
|
|
|
nil)))
|
|
|
|
|
(_ (error "Unknown property: %S" property)))))
|
|
|
|
|
(when value
|
|
|
|
|
(cl-incf width
|
|
|
|
|
;; When looking for `display' parts, we still need
|
|
|
|
|
;; to look for `invisible' property elsewhere.
|
|
|
|
|
(+ (cond ((eq property 'display)
|
|
|
|
|
(org--string-from-props s 'invisible cursor beg))
|
|
|
|
|
((= cursor beg) 0)
|
|
|
|
|
(t (string-width (substring s cursor beg))))
|
|
|
|
|
value))
|
|
|
|
|
(setq cursor next))
|
|
|
|
|
(setq beg next)))
|
|
|
|
|
(+ width
|
|
|
|
|
;; Look for `invisible' property in the last part of the
|
|
|
|
|
;; string. See above.
|
|
|
|
|
(cond ((eq property 'display)
|
|
|
|
|
(org--string-from-props s 'invisible cursor end))
|
|
|
|
|
((= cursor end) 0)
|
|
|
|
|
(t (string-width (substring s cursor end)))))))
|
|
|
|
|
|
|
|
|
|
(defun org--string-width-1 (string)
|
|
|
|
|
"Return width of STRING when displayed in the current buffer.
|
|
|
|
|
Unlike `string-width', this function takes into consideration
|
|
|
|
|
`invisible' and `display' text properties. It supports the
|
|
|
|
|
latter in a limited way, mostly for combinations used in Org.
|
|
|
|
|
Results may be off sometimes if it cannot handle a given
|
|
|
|
|
`display' value."
|
|
|
|
|
(org--string-from-props string 'display 0 (length string)))
|
|
|
|
|
|
2022-01-15 07:57:02 +00:00
|
|
|
|
(defun org-string-width (string &optional pixels)
|
2017-07-28 10:15:47 +00:00
|
|
|
|
"Return width of STRING when displayed in the current buffer.
|
2022-01-15 07:57:02 +00:00
|
|
|
|
Return width in pixels when PIXELS is non-nil."
|
2022-01-23 05:35:53 +00:00
|
|
|
|
(if (and (version< emacs-version "28") (not pixels))
|
|
|
|
|
;; FIXME: Fallback to old limited version, because
|
|
|
|
|
;; `window-pixel-width' is buggy in older Emacs.
|
|
|
|
|
(org--string-width-1 string)
|
|
|
|
|
;; Wrap/line prefix will make `window-text-pizel-size' return too
|
|
|
|
|
;; large value including the prefix.
|
|
|
|
|
(remove-text-properties 0 (length string)
|
2022-04-24 05:51:13 +00:00
|
|
|
|
'(wrap-prefix t line-prefix t)
|
2022-01-23 05:35:53 +00:00
|
|
|
|
string)
|
2022-04-24 05:51:13 +00:00
|
|
|
|
;; Face should be removed to make sure that all the string symbols
|
|
|
|
|
;; are using default face with constant width. Constant char width
|
|
|
|
|
;; is critical to get right string width from pixel width (not needed
|
|
|
|
|
;; when PIXELS are requested though).
|
|
|
|
|
(unless pixels
|
|
|
|
|
(remove-text-properties 0 (length string) '(face t) string))
|
2022-01-23 05:35:53 +00:00
|
|
|
|
(let (;; We need to remove the folds to make sure that folded table
|
|
|
|
|
;; alignment is not messed up.
|
|
|
|
|
(current-invisibility-spec
|
|
|
|
|
(or (and (not (listp buffer-invisibility-spec))
|
|
|
|
|
buffer-invisibility-spec)
|
|
|
|
|
(let (result)
|
|
|
|
|
(dolist (el buffer-invisibility-spec)
|
|
|
|
|
(unless (or (memq el
|
|
|
|
|
'(org-fold-drawer
|
|
|
|
|
org-fold-block
|
|
|
|
|
org-fold-outline))
|
|
|
|
|
(and (listp el)
|
|
|
|
|
(memq (car el)
|
|
|
|
|
'(org-fold-drawer
|
|
|
|
|
org-fold-block
|
|
|
|
|
org-fold-outline))))
|
|
|
|
|
(push el result)))
|
|
|
|
|
result)))
|
|
|
|
|
(current-char-property-alias-alist char-property-alias-alist))
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(setq-local display-line-numbers nil)
|
|
|
|
|
(setq-local buffer-invisibility-spec
|
|
|
|
|
(if (listp current-invisibility-spec)
|
|
|
|
|
(mapcar (lambda (el)
|
|
|
|
|
;; Consider elipsis to have 0 width.
|
|
|
|
|
;; It is what Emacs 28+ does, but we have
|
|
|
|
|
;; to force it in earlier Emacs versions.
|
|
|
|
|
(if (and (consp el) (cdr el))
|
|
|
|
|
(list (car el))
|
|
|
|
|
el))
|
|
|
|
|
current-invisibility-spec)
|
|
|
|
|
current-invisibility-spec))
|
|
|
|
|
(setq-local char-property-alias-alist
|
|
|
|
|
current-char-property-alias-alist)
|
|
|
|
|
(let (pixel-width symbol-width)
|
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(setf (buffer-string) string)
|
|
|
|
|
(setq pixel-width
|
2022-01-15 07:57:02 +00:00
|
|
|
|
(if (get-buffer-window (current-buffer))
|
|
|
|
|
(car (window-text-pixel-size
|
|
|
|
|
nil (line-beginning-position) (point-max)))
|
|
|
|
|
(set-window-buffer nil (current-buffer))
|
|
|
|
|
(car (window-text-pixel-size
|
2022-01-23 05:35:53 +00:00
|
|
|
|
nil (line-beginning-position) (point-max)))))
|
|
|
|
|
(unless pixels
|
|
|
|
|
(setf (buffer-string) "a")
|
|
|
|
|
(setq symbol-width
|
|
|
|
|
(if (get-buffer-window (current-buffer))
|
|
|
|
|
(car (window-text-pixel-size
|
|
|
|
|
nil (line-beginning-position) (point-max)))
|
|
|
|
|
(set-window-buffer nil (current-buffer))
|
|
|
|
|
(car (window-text-pixel-size
|
|
|
|
|
nil (line-beginning-position) (point-max)))))))
|
|
|
|
|
(if pixels
|
|
|
|
|
pixel-width
|
|
|
|
|
(/ pixel-width symbol-width)))))))
|
2017-07-27 13:23:31 +00:00
|
|
|
|
|
2010-06-25 07:00:19 +00:00
|
|
|
|
(defun org-not-nil (v)
|
2010-06-26 05:54:07 +00:00
|
|
|
|
"If V not nil, and also not the string \"nil\", then return V.
|
|
|
|
|
Otherwise return nil."
|
|
|
|
|
(and v (not (equal v "nil")) v))
|
2010-06-25 07:00:19 +00:00
|
|
|
|
|
2017-09-18 19:24:23 +00:00
|
|
|
|
(defun org-unbracket-string (pre post string)
|
|
|
|
|
"Remove PRE/POST from the beginning/end of STRING.
|
|
|
|
|
Both PRE and POST must be pre-/suffixes of STRING, or neither is
|
2018-11-10 07:58:31 +00:00
|
|
|
|
removed. Return the new string. If STRING is nil, return nil."
|
|
|
|
|
(declare (indent 2))
|
|
|
|
|
(and string
|
|
|
|
|
(if (and (string-prefix-p pre string)
|
|
|
|
|
(string-suffix-p post string))
|
|
|
|
|
(substring string (length pre) (- (length post)))
|
|
|
|
|
string)))
|
2008-03-22 15:52:18 +00:00
|
|
|
|
|
2018-10-06 07:40:33 +00:00
|
|
|
|
(defun org-strip-quotes (string)
|
2018-11-10 07:58:31 +00:00
|
|
|
|
"Strip double quotes from around STRING, if applicable.
|
|
|
|
|
If STRING is nil, return nil."
|
2018-10-06 07:40:33 +00:00
|
|
|
|
(org-unbracket-string "\"" "\"" string))
|
|
|
|
|
|
2017-09-18 19:24:23 +00:00
|
|
|
|
(defsubst org-current-line-string (&optional to-here)
|
2018-10-06 07:44:35 +00:00
|
|
|
|
"Return current line, as a string.
|
|
|
|
|
If optional argument TO-HERE is non-nil, return string from
|
|
|
|
|
beginning of line up to point."
|
|
|
|
|
(buffer-substring (line-beginning-position)
|
|
|
|
|
(if to-here (point) (line-end-position))))
|
2008-03-22 15:52:18 +00:00
|
|
|
|
|
2017-10-22 13:34:26 +00:00
|
|
|
|
(defun org-shorten-string (s maxlength)
|
|
|
|
|
"Shorten string S so that it is no longer than MAXLENGTH characters.
|
|
|
|
|
If the string is shorter or has length MAXLENGTH, just return the
|
|
|
|
|
original string. If it is longer, the functions finds a space in the
|
|
|
|
|
string, breaks this string off at that locations and adds three dots
|
|
|
|
|
as ellipsis. Including the ellipsis, the string will not be longer
|
|
|
|
|
than MAXLENGTH. If finding a good breaking point in the string does
|
|
|
|
|
not work, the string is just chopped off in the middle of a word
|
|
|
|
|
if necessary."
|
|
|
|
|
(if (<= (length s) maxlength)
|
|
|
|
|
s
|
|
|
|
|
(let* ((n (max (- maxlength 4) 1))
|
2020-01-28 19:19:24 +00:00
|
|
|
|
(re (concat "\\`\\(.\\{1," (number-to-string n)
|
|
|
|
|
"\\}[^ ]\\)\\([ ]\\|\\'\\)")))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
(if (string-match re s)
|
|
|
|
|
(concat (match-string 1 s) "...")
|
|
|
|
|
(concat (substring s 0 (max (- maxlength 3) 0)) "...")))))
|
|
|
|
|
|
|
|
|
|
(defun org-remove-tabs (s &optional width)
|
|
|
|
|
"Replace tabulators in S with spaces.
|
|
|
|
|
Assumes that s is a single line, starting in column 0."
|
|
|
|
|
(setq width (or width tab-width))
|
|
|
|
|
(while (string-match "\t" s)
|
|
|
|
|
(setq s (replace-match
|
|
|
|
|
(make-string
|
|
|
|
|
(- (* width (/ (+ (match-beginning 0) width) width))
|
|
|
|
|
(match-beginning 0)) ?\ )
|
|
|
|
|
t t s)))
|
|
|
|
|
s)
|
|
|
|
|
|
|
|
|
|
(defun org-wrap (string &optional width lines)
|
|
|
|
|
"Wrap string to either a number of lines, or a width in characters.
|
|
|
|
|
If WIDTH is non-nil, the string is wrapped to that width, however many lines
|
|
|
|
|
that costs. If there is a word longer than WIDTH, the text is actually
|
|
|
|
|
wrapped to the length of that word.
|
|
|
|
|
IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
|
|
|
|
|
many lines, whatever width that takes.
|
|
|
|
|
The return value is a list of lines, without newlines at the end."
|
|
|
|
|
(let* ((words (split-string string))
|
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
2021-02-23 20:47:29 +00:00
|
|
|
|
(maxword (apply #'max (mapcar #'org-string-width words)))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
w ll)
|
|
|
|
|
(cond (width
|
|
|
|
|
(org--do-wrap words (max maxword width)))
|
|
|
|
|
(lines
|
|
|
|
|
(setq w maxword)
|
|
|
|
|
(setq ll (org--do-wrap words maxword))
|
|
|
|
|
(if (<= (length ll) lines)
|
|
|
|
|
ll
|
|
|
|
|
(setq ll words)
|
|
|
|
|
(while (> (length ll) lines)
|
|
|
|
|
(setq w (1+ w))
|
|
|
|
|
(setq ll (org--do-wrap words w)))
|
|
|
|
|
ll))
|
|
|
|
|
(t (error "Cannot wrap this")))))
|
|
|
|
|
|
|
|
|
|
(defun org--do-wrap (words width)
|
|
|
|
|
"Create lines of maximum width WIDTH (in characters) from word list WORDS."
|
|
|
|
|
(let (lines line)
|
|
|
|
|
(while words
|
|
|
|
|
(setq line (pop words))
|
|
|
|
|
(while (and words (< (+ (length line) (length (car words))) width))
|
|
|
|
|
(setq line (concat line " " (pop words))))
|
|
|
|
|
(setq lines (push line lines)))
|
|
|
|
|
(nreverse lines)))
|
|
|
|
|
|
|
|
|
|
(defun org-remove-indentation (code &optional n)
|
|
|
|
|
"Remove maximum common indentation in string CODE and return it.
|
|
|
|
|
N may optionally be the number of columns to remove. Return CODE
|
|
|
|
|
as-is if removal failed."
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(insert code)
|
|
|
|
|
(if (org-do-remove-indentation n) (buffer-string) code)))
|
|
|
|
|
|
2019-03-03 22:46:32 +00:00
|
|
|
|
(defun org-fill-template (template alist)
|
|
|
|
|
"Find each %key of ALIST in TEMPLATE and replace it."
|
|
|
|
|
(let ((case-fold-search nil))
|
|
|
|
|
(dolist (entry (sort (copy-sequence alist)
|
2022-04-06 21:02:19 +00:00
|
|
|
|
; Sort from longest key to shortest, so that
|
|
|
|
|
; "noweb-ref" and "tangle-mode" get processed
|
|
|
|
|
; before "noweb" and "tangle", respectively.
|
|
|
|
|
(lambda (a b) (< (length (car b)) (length (car a))))))
|
2019-03-03 22:46:32 +00:00
|
|
|
|
(setq template
|
|
|
|
|
(replace-regexp-in-string
|
|
|
|
|
(concat "%" (regexp-quote (car entry)))
|
|
|
|
|
(or (cdr entry) "") template t t)))
|
|
|
|
|
template))
|
2008-03-22 15:52:18 +00:00
|
|
|
|
|
2019-03-03 22:48:07 +00:00
|
|
|
|
(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.
|
|
|
|
|
The sequences in STRING may contain normal field width and padding information,
|
|
|
|
|
for example \"%-5s\". Replacements happen in the sequence given by TABLE,
|
|
|
|
|
so values can contain further %-escapes if they are define later in TABLE."
|
|
|
|
|
(let ((tbl (copy-alist table))
|
|
|
|
|
(case-fold-search nil)
|
|
|
|
|
(pchg 0)
|
|
|
|
|
re rpl)
|
|
|
|
|
(dolist (e tbl)
|
|
|
|
|
(setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
|
|
|
|
|
(when (and (cdr e) (string-match re (cdr e)))
|
|
|
|
|
(let ((sref (substring (cdr e) (match-beginning 0) (match-end 0)))
|
|
|
|
|
(safe "SREF"))
|
|
|
|
|
(add-text-properties 0 3 (list 'sref sref) safe)
|
|
|
|
|
(setcdr e (replace-match safe t t (cdr e)))))
|
|
|
|
|
(while (string-match re string)
|
|
|
|
|
(setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s")
|
|
|
|
|
(cdr e)))
|
|
|
|
|
(setq string (replace-match rpl t t string))))
|
|
|
|
|
(while (setq pchg (next-property-change pchg string))
|
|
|
|
|
(let ((sref (get-text-property pchg 'sref string)))
|
|
|
|
|
(when (and sref (string-match "SREF" string pchg))
|
|
|
|
|
(setq string (replace-match sref t t string)))))
|
|
|
|
|
string))
|
|
|
|
|
|
2017-09-18 19:24:23 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
;;; Text properties
|
2008-04-03 15:58:13 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
|
|
|
|
|
rear-nonsticky t mouse-map t fontified t
|
|
|
|
|
org-emphasis t)
|
|
|
|
|
"Properties to remove when a string without properties is wanted.")
|
2018-01-23 08:48:01 +00:00
|
|
|
|
|
2022-01-29 07:32:08 +00:00
|
|
|
|
(defvar org-fold-core--force-fontification)
|
|
|
|
|
(defmacro org-with-forced-fontification (&rest body)
|
|
|
|
|
"Run BODY forcing fontification of folded regions."
|
|
|
|
|
(declare (debug (form body)) (indent 1))
|
|
|
|
|
`(unwind-protect
|
|
|
|
|
(progn
|
|
|
|
|
(setq org-fold-core--force-fontification t)
|
|
|
|
|
,@body)
|
|
|
|
|
(setq org-fold-core--force-fontification nil)))
|
|
|
|
|
|
|
|
|
|
(defun org-buffer-substring-fontified (beg end)
|
|
|
|
|
"Return fontified region between BEG and END."
|
|
|
|
|
(when (bound-and-true-p jit-lock-mode)
|
|
|
|
|
(org-with-forced-fontification
|
2022-01-29 12:02:20 +00:00
|
|
|
|
(when (or (text-property-not-all beg end 'org-fold-core-fontified t)
|
|
|
|
|
(text-property-not-all beg end 'fontified t))
|
2022-01-29 07:32:08 +00:00
|
|
|
|
(save-match-data (font-lock-fontify-region beg end)))))
|
|
|
|
|
(buffer-substring beg end))
|
|
|
|
|
|
|
|
|
|
(defun org-looking-at-fontified (re)
|
|
|
|
|
"Call `looking-at' RE and make sure that the match is fontified."
|
|
|
|
|
(prog1 (looking-at re)
|
|
|
|
|
(when (bound-and-true-p jit-lock-mode)
|
|
|
|
|
(org-with-forced-fontification
|
2022-01-29 12:02:20 +00:00
|
|
|
|
(when (or (text-property-not-all
|
|
|
|
|
(match-beginning 0) (match-end 0)
|
|
|
|
|
'org-fold-core-fontified t)
|
|
|
|
|
(text-property-not-all
|
|
|
|
|
(match-beginning 0) (match-end 0)
|
|
|
|
|
'fontified t))
|
2022-01-29 07:32:08 +00:00
|
|
|
|
(save-match-data
|
|
|
|
|
(font-lock-fontify-region (match-beginning 0)
|
|
|
|
|
(match-end 0))))))))
|
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(defsubst org-no-properties (s &optional restricted)
|
|
|
|
|
"Remove all text properties from string S.
|
|
|
|
|
When RESTRICTED is non-nil, only remove the properties listed
|
|
|
|
|
in `org-rm-props'."
|
|
|
|
|
(if restricted (remove-text-properties 0 (length s) org-rm-props s)
|
|
|
|
|
(set-text-properties 0 (length s) nil s))
|
|
|
|
|
s)
|
|
|
|
|
(defun org-add-props (string plist &rest props)
|
|
|
|
|
"Add text properties to entire string, from beginning to end.
|
|
|
|
|
PLIST may be a list of properties, PROPS are individual properties and values
|
|
|
|
|
that will be added to PLIST. Returns the string that was modified."
|
|
|
|
|
(declare (indent 2))
|
|
|
|
|
(add-text-properties
|
|
|
|
|
0 (length string) (if props (append plist props) plist) string)
|
|
|
|
|
string)
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(defun org-make-parameter-alist (flat)
|
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
2021-02-23 20:47:29 +00:00
|
|
|
|
;; FIXME: "flat" is called a "plist"!
|
2018-04-29 10:09:34 +00:00
|
|
|
|
"Return alist based on FLAT.
|
|
|
|
|
FLAT is a list with alternating symbol names and values. The
|
|
|
|
|
returned alist is a list of lists with the symbol name in car and
|
* lisp/org-agenda.el: Use lexical-binding
- Removed the global (defvar date) and (defvar entry) so as not to
conflict with function arguments of that name. Instead I added such
`defvar`s in the body of each of the functions where it
seemed needed.
- I added some FIXMEs for some issues I found along the way.
- Added an `org-dlet` macro, just like I had done for `calendar-dlet`,
but I also use `defvar` "manually" at some places, when splitting an
existing `let` into a mix of `let`s and `dlet`s seemed too much trouble.
- Removed uses of `org-let and `org-let2` not only because I consider
them offensive to my sense of aesthetics but also because they're
basically incompatible with lexical scoping.
I replaced them with uses of `cl-progv` which are a bit more verbose.
Maybe we should define some `org-progv` macro on top of `cl-progv` to
make the code less verbose, but I didn't do that because I like the
fact that the current code makes uses of `eval` a bit more obvious
(since these behave differently with lexical scoping than with
lexical binding, it seemed worthwhile).
- Removed the use of `eval` in `org-store-agenda-views` which was only
placed there in order to use a macro before it's defined (it would
have been simpler/cleaner to just move that functions *after* the
macro, but with the new code the problem doesn't occur any more anyway).
- Replaced a few `(lambda...) with actual closures.
Detailed changes follow:
(date, entry): Don't declare as being globally dynbound.
(org-agenda-format-date-aligned): Remove unused var `weekyear`.
(org-agenda-mode): `run-mode-hooks` is always available nowadays.
(org-agenda-undo): Remove unused var `last-undo-buffer`.
(org-agenda): Rename arg to `keys` and then dyn-bind it as `org-keys`.
Remove unused vars `buf` and `key`.
(org-agenda): Use `pcase` and `cl-progv` instead of `org-let`.
(org-let, org-let2): Mark as obsolete.
(org-agenda-run-series): Use `cl-progv` instead of `org-let` and `org-let2`.
(org-agenda-run-series): New function.
(org--batch-agenda): New function extracted from `org-batch-agenda`.
(org-batch-agenda): Use it.
(org--batch-agenda-csv): New function extracted from `org-batch-agenda-csv`.
(org-batch-agenda-csv): Use it.
(org--batch-store-agenda-views): New function, extracted from
`org-batch-store-agenda-views`.
(org-store-agenda-views, org-batch-store-agenda-views): Use it.
(org--batch-store-agenda-views): Use `cl-progv` instead of
`org-eval-in-environment`.
(org-agenda-write): Use `cl-progv` instead of `org-let`.
Use `with-current-buffer`.
(org-agenda-filter-any): Use `cl-some` instead of `eval`.
(org-agenda-list): Remove unused var `e`.
(org-search-view): η-reduce.
(crm-separator): Declare var.
(org-agenda-skip-if): Remove unused var `beg`.
(org-agenda-list-stuck-projects): Use a closure rather than `(lambda..).
(diary-modify-entry-list-string-function, diary-file-name-prefix)
(diary-display-function): Declare vars.
(org-diary): Declare `date` and `entry` as dynbound.
(org-agenda-get-day-entries): Use `org-dlet`.
(org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled, org-agenda-get-blocks):
Declare `date` as dynbound.
(org-agenda-get-sexps, org-class): Declare `date` and `entry` as dynbound.
(org-agenda-format-item): Declare the vars mentioned in
`org-compile-prefix-format` as dyn-bound.
Also binding `extra`, suggested by Kyle Meyer <kyle@kyleam.com>.
(org-compile-prefix-format): Remove unused var `e`.
Use `member` rather than or+equal.
(org-set-sorting-strategy): Minor simplification.
(org-entries-lessp): Use `org-dlet`.
(org-agenda-redo): Declare var `org-agenda-tag-filter-while-redo`.
(org-agenda-redo): Use `cl-progv` rather than `org-let`.
(org-agenda-filter): Remove unused var `rpl-fn`.
Use `org-pushnew-to-end` to replace `add-to-list` on lexical var.
(org-agenda-filter-by-tag): Remove unused var `n`.
(org-agenda-filter-apply): Use `org-dlet`.
(org-agenda-compute-starting-span): Remove unused var `dg`.
(org-agenda-forward-block): Remove unused var `pos`.
(org-archive-from-agenda): Declare var.
(org-agenda-refile): Remove unused var `pos`.
(org-agenda-headline-snapshot-before-repeat): Declare var.
(org-agenda-todo): Remove redundant use of `bound-and-true-p`.
(org-agenda-add-note): Remove unused var `hdmarker` and unused `arg`.
(org-agenda-change-all-lines): Remove unused var `pl`.
(org-agenda-priority): Remove unused var `marker`.
(org-agenda-set-effort): Remove unused var `newhead`.
(org-agenda-schedule): Remove unused var `type`.
(org-agenda-clock-cancel): Remove unused `arg`.
(org-agenda-execute-calendar-command): Use `org-dlet`.
(org-agenda-bulk-action): Use closures instead of `(lambda ...).
(org-agenda-show-the-flagging-note): Remove unused vars `heading` and
`newhead`.
(org-agenda-remove-flag): Avoid `setq`.
* testing/org-test.el (org--compile-when): New macro.
(org-test-jump): Use it so compilation doesn't fail or generate broken
code when `jump` is not available.
* testing/lisp/test-org-src.el:
* testing/lisp/test-org-attach.el:
* testing/lisp/test-org-agenda.el:
* testing/lisp/test-ob-java.el: Pass explicit filename to `require`
so as not to rely on ".../testing" being in `load-path` during compilation.
* lisp/org-num.el: Require` org`.
* lisp/org-macs.el (org-eval-in-environment): Declare obsolete.
(org-dlet, org-pushnew-to-end): New macros.
* doc/Makefile (org.texi, orgguide.texi, %_letter.tex): Simplify quoting.
* contrib/lisp/ob-sclang.el: Don't crash compilation when `sclang`
is not available.
* contrib/lisp/ob-clojure-literate.el: Don't crash compilation when `cider`
is not available.
* contrib/lisp/ob-arduino.el: Don't crash compilation when `arduino-mode`
is not available.
* .gitignore: Add files generated during `make packages/org`.
2021-02-23 20:47:29 +00:00
|
|
|
|
the value in cadr."
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(when flat
|
|
|
|
|
(cons (list (car flat) (cadr flat))
|
|
|
|
|
(org-make-parameter-alist (cddr flat)))))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(defsubst org-get-at-bol (property)
|
|
|
|
|
"Get text property PROPERTY at the beginning of line."
|
|
|
|
|
(get-text-property (point-at-bol) property))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(defun org-get-at-eol (property n)
|
|
|
|
|
"Get text property PROPERTY at the end of line less N characters."
|
|
|
|
|
(get-text-property (- (point-at-eol) n) property))
|
2017-10-22 13:34:26 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(defun org-find-text-property-in-string (prop s)
|
|
|
|
|
"Return the first non-nil value of property PROP in string S."
|
|
|
|
|
(or (get-text-property 0 prop s)
|
|
|
|
|
(get-text-property (or (next-single-property-change 0 prop s) 0)
|
|
|
|
|
prop s)))
|
2008-04-04 21:44:48 +00:00
|
|
|
|
|
2022-01-16 07:34:37 +00:00
|
|
|
|
;; FIXME: move to org-fold?
|
|
|
|
|
(defun org-invisible-p--text-properties (&optional pos folding-only)
|
|
|
|
|
"Non-nil if the character after POS is invisible.
|
|
|
|
|
If POS is nil, use `point' instead. When optional argument
|
|
|
|
|
FOLDING-ONLY is non-nil, only consider invisible parts due to
|
|
|
|
|
folding of a headline, a block or a drawer, i.e., not because of
|
|
|
|
|
fontification."
|
|
|
|
|
(let ((value (invisible-p (or pos (point)))))
|
|
|
|
|
(cond ((not value) nil)
|
|
|
|
|
(folding-only (org-fold-folded-p (or pos (point))))
|
|
|
|
|
(t value))))
|
|
|
|
|
(defun org-invisible-p--overlays (&optional pos folding-only)
|
2018-04-29 10:09:34 +00:00
|
|
|
|
"Non-nil if the character after POS is invisible.
|
2020-01-11 19:05:07 +00:00
|
|
|
|
If POS is nil, use `point' instead. When optional argument
|
|
|
|
|
FOLDING-ONLY is non-nil, only consider invisible parts due to
|
|
|
|
|
folding of a headline, a block or a drawer, i.e., not because of
|
|
|
|
|
fontification."
|
|
|
|
|
(let ((value (get-char-property (or pos (point)) 'invisible)))
|
|
|
|
|
(cond ((not value) nil)
|
2020-07-03 19:50:46 +00:00
|
|
|
|
(folding-only (memq value '(org-hide-block outline)))
|
2022-01-16 07:34:37 +00:00
|
|
|
|
(t (and (invisible-p (or pos (point))) value)))))
|
|
|
|
|
(defsubst org-invisible-p (&optional pos folding-only)
|
|
|
|
|
"Non-nil if the character after POS is invisible.
|
|
|
|
|
If POS is nil, use `point' instead. When optional argument
|
|
|
|
|
FOLDING-ONLY is non-nil, only consider invisible parts due to
|
|
|
|
|
folding of a headline, a block or a drawer, i.e., not because of
|
|
|
|
|
fontification."
|
|
|
|
|
(if (eq org-fold-core-style 'text-properties)
|
|
|
|
|
(org-invisible-p--text-properties pos folding-only)
|
|
|
|
|
(org-invisible-p--overlays pos folding-only)))
|
2010-08-27 14:18:32 +00:00
|
|
|
|
|
2022-04-01 00:02:38 +00:00
|
|
|
|
(defun org-truly-invisible-p ()
|
2018-04-29 10:09:34 +00:00
|
|
|
|
"Check if point is at a character currently not visible.
|
|
|
|
|
This version does not only check the character property, but also
|
|
|
|
|
`visible-mode'."
|
|
|
|
|
(unless (bound-and-true-p visible-mode)
|
|
|
|
|
(org-invisible-p)))
|
2011-03-05 10:01:28 +00:00
|
|
|
|
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(defun org-invisible-p2 ()
|
|
|
|
|
"Check if point is at a character currently not visible.
|
|
|
|
|
If the point is at EOL (and not at the beginning of a buffer too),
|
|
|
|
|
move it back by one char before doing this check."
|
2017-09-18 19:24:23 +00:00
|
|
|
|
(save-excursion
|
2018-04-29 10:09:34 +00:00
|
|
|
|
(when (and (eolp) (not (bobp)))
|
|
|
|
|
(backward-char 1))
|
|
|
|
|
(org-invisible-p)))
|
2009-07-19 07:42:22 +00:00
|
|
|
|
|
2022-01-16 07:34:37 +00:00
|
|
|
|
(defun org-region-invisible-p (beg end)
|
|
|
|
|
"Check if region if completely hidden."
|
|
|
|
|
(org-with-wide-buffer
|
|
|
|
|
(and (org-invisible-p beg)
|
|
|
|
|
(org-invisible-p (org-fold-next-visibility-change beg end)))))
|
|
|
|
|
|
|
|
|
|
(defun org-find-visible--overlays ()
|
2021-09-16 10:32:43 +00:00
|
|
|
|
"Return closest visible buffer position, or `point-max'."
|
2020-01-11 19:15:30 +00:00
|
|
|
|
(if (org-invisible-p)
|
|
|
|
|
(next-single-char-property-change (point) 'invisible)
|
|
|
|
|
(point)))
|
2022-01-16 07:34:37 +00:00
|
|
|
|
(defun org-find-visible--text-properties ()
|
|
|
|
|
"Return closest visible buffer position, or `point-max'."
|
|
|
|
|
(if (org-invisible-p)
|
|
|
|
|
(org-fold-next-visibility-change (point))
|
|
|
|
|
(point)))
|
|
|
|
|
(defsubst org-find-visible ()
|
|
|
|
|
"Return closest visible buffer position, or `point-max'."
|
|
|
|
|
(if (eq org-fold-core-style 'text-properties)
|
|
|
|
|
(org-find-visible--text-properties)
|
|
|
|
|
(org-find-visible--overlays)))
|
2020-01-11 19:15:30 +00:00
|
|
|
|
|
2022-01-16 07:34:37 +00:00
|
|
|
|
(defun org-find-invisible--overlays ()
|
2021-09-16 10:32:43 +00:00
|
|
|
|
"Return closest invisible buffer position, or `point-max'."
|
2020-01-11 19:15:30 +00:00
|
|
|
|
(if (org-invisible-p)
|
|
|
|
|
(point)
|
|
|
|
|
(next-single-char-property-change (point) 'invisible)))
|
2022-01-16 07:34:37 +00:00
|
|
|
|
(defun org-find-invisible--text-properties ()
|
|
|
|
|
"Return closest invisible buffer position, or `point-max'."
|
|
|
|
|
(if (org-invisible-p)
|
|
|
|
|
(point)
|
|
|
|
|
(org-fold-next-visibility-change (point))))
|
|
|
|
|
(defsubst org-find-invisible ()
|
|
|
|
|
"Return closest invisible buffer position, or `point-max'."
|
|
|
|
|
(if (eq org-fold-core-style 'text-properties)
|
|
|
|
|
(org-find-invisible--text-properties)
|
|
|
|
|
(org-find-invisible--overlays)))
|
2020-01-11 19:15:30 +00:00
|
|
|
|
|
2018-04-17 14:06:09 +00:00
|
|
|
|
|
|
|
|
|
;;; 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
|
2019-08-23 22:11:07 +00:00
|
|
|
|
(float-time (apply #'encode-time (org-parse-time-string s)))
|
2019-02-23 02:32:31 +00:00
|
|
|
|
(error 0)))
|
|
|
|
|
(t 0)))
|
2018-04-17 14:06:09 +00:00
|
|
|
|
|
|
|
|
|
(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))))
|
|
|
|
|
|
2018-04-29 08:26:41 +00:00
|
|
|
|
(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.
|
|
|
|
|
|
2018-12-28 20:23:00 +00:00
|
|
|
|
Throw an error if S does not contain a valid Org time string.
|
|
|
|
|
Note that the first match for YYYY-MM-DD will be used (e.g.,
|
|
|
|
|
\"-52000-02-03\" will be taken as \"2000-02-03\").
|
2018-04-29 08:26:41 +00:00
|
|
|
|
|
|
|
|
|
This should be a lot faster than the `parse-time-string'."
|
2018-07-01 21:25:56 +00:00
|
|
|
|
(unless (string-match org-ts-regexp0 s)
|
|
|
|
|
(error "Not an Org time string: %s" s))
|
|
|
|
|
(list 0
|
2018-07-01 22:18:44 +00:00
|
|
|
|
(cond ((match-beginning 8) (string-to-number (match-string 8 s)))
|
2018-07-01 21:25:56 +00:00
|
|
|
|
(nodefault nil)
|
|
|
|
|
(t 0))
|
2018-07-01 22:18:44 +00:00
|
|
|
|
(cond ((match-beginning 7) (string-to-number (match-string 7 s)))
|
2018-07-01 21:25:56 +00:00
|
|
|
|
(nodefault nil)
|
|
|
|
|
(t 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))
|
2018-04-29 08:26:41 +00:00
|
|
|
|
|
2018-04-17 14:06:09 +00:00
|
|
|
|
(defun org-matcher-time (s)
|
2018-06-28 20:40:01 +00:00
|
|
|
|
"Interpret a time comparison value S as a floating point time.
|
|
|
|
|
|
|
|
|
|
S can be an Org time stamp, a modifier, e.g., \"<+2d>\", or the
|
|
|
|
|
following special strings: \"<now>\", \"<today>\",
|
|
|
|
|
\"<tomorrow>\", and \"<yesterday>\".
|
|
|
|
|
|
|
|
|
|
Return 0. if S is not recognized as a valid value."
|
2018-04-17 14:06:09 +00:00
|
|
|
|
(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)
|
2021-01-05 00:48:55 +00:00
|
|
|
|
(+ (if (string= (match-string 2 s) "h") (float-time) today)
|
2018-04-17 14:06:09 +00:00
|
|
|
|
(* (string-to-number (match-string 1 s))
|
|
|
|
|
(cdr (assoc (match-string 2 s)
|
2021-01-05 00:48:55 +00:00
|
|
|
|
'(("h" . 3600.0)
|
|
|
|
|
("d" . 86400.0) ("w" . 604800.0)
|
2018-04-17 14:06:09 +00:00
|
|
|
|
("m" . 2678400.0) ("y" . 31557600.0)))))))
|
2018-06-28 20:40:01 +00:00
|
|
|
|
((string-match org-ts-regexp0 s) (org-2ft s))
|
|
|
|
|
(t 0.)))))
|
2018-04-17 14:06:09 +00:00
|
|
|
|
|
2020-02-11 00:04:28 +00:00
|
|
|
|
(defun org-scroll (key &optional additional-keys)
|
|
|
|
|
"Receive KEY and scroll the current window accordingly.
|
|
|
|
|
When ADDITIONAL-KEYS is not nil, also include SPC and DEL in the
|
|
|
|
|
allowed keys for scrolling, as expected in the export dispatch
|
|
|
|
|
window."
|
2021-02-22 16:54:17 +00:00
|
|
|
|
(let ((scrlup (if additional-keys '(?\s ?\C-v) ?\C-v))
|
|
|
|
|
(scrldn (if additional-keys `(?\d ?\M-v) ?\M-v)))
|
|
|
|
|
(pcase key
|
|
|
|
|
(?\C-n (if (not (pos-visible-in-window-p (point-max)))
|
2021-09-29 07:22:47 +00:00
|
|
|
|
(ignore-errors (scroll-up 1))
|
|
|
|
|
(message "End of buffer")
|
|
|
|
|
(sit-for 1)))
|
2021-02-22 16:54:17 +00:00
|
|
|
|
(?\C-p (if (not (pos-visible-in-window-p (point-min)))
|
2021-09-29 07:22:47 +00:00
|
|
|
|
(ignore-errors (scroll-down 1))
|
|
|
|
|
(message "Beginning of buffer")
|
|
|
|
|
(sit-for 1)))
|
2021-02-22 16:54:17 +00:00
|
|
|
|
;; SPC or
|
|
|
|
|
((guard (memq key scrlup))
|
|
|
|
|
(if (not (pos-visible-in-window-p (point-max)))
|
|
|
|
|
(scroll-up nil)
|
|
|
|
|
(message "End of buffer")
|
|
|
|
|
(sit-for 1)))
|
|
|
|
|
;; DEL
|
|
|
|
|
((guard (memq key scrldn))
|
|
|
|
|
(if (not (pos-visible-in-window-p (point-min)))
|
|
|
|
|
(scroll-down nil)
|
|
|
|
|
(message "Beginning of buffer")
|
|
|
|
|
(sit-for 1))))))
|
2018-06-19 20:42:11 +00:00
|
|
|
|
|
|
|
|
|
(provide 'org-macs)
|
|
|
|
|
|
2020-02-18 22:37:24 +00:00
|
|
|
|
;; Local variables:
|
|
|
|
|
;; generated-autoload-file: "org-loaddefs.el"
|
|
|
|
|
;; End:
|
|
|
|
|
|
2008-03-22 15:52:18 +00:00
|
|
|
|
;;; org-macs.el ends here
|