* 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`.
This commit is contained in:
Stefan Monnier 2021-02-23 15:47:29 -05:00 committed by Kyle Meyer
parent 5263eff5a3
commit 129c33dddf
13 changed files with 541 additions and 417 deletions

6
.gitignore vendored
View File

@ -49,6 +49,12 @@ local*.mk
mk/x11idle mk/x11idle
ChangeLog ChangeLog
# Files generated during `make packages/org` in a clone of `elpa.git`.
/org-pkg.el
/org-autoloads.el
/lisp/org-autoloads.el
# texi2pdf --tidy # texi2pdf --tidy
doc/*.t2d doc/*.t2d

View File

@ -33,7 +33,7 @@
(require 'org) (require 'org)
(require 'ob) (require 'ob)
(require 'arduino-mode) (require 'arduino-mode nil t)
(defgroup ob-arduino nil (defgroup ob-arduino nil
"org-mode blocks for Arduino." "org-mode blocks for Arduino."

View File

@ -20,7 +20,7 @@
;;; Code: ;;; Code:
(require 'ob-clojure) (require 'ob-clojure)
(require 'cider) (require 'cider nil t)
(defgroup ob-clojure-literate nil (defgroup ob-clojure-literate nil
"Clojure's Org-mode Literate Programming." "Clojure's Org-mode Literate Programming."

View File

@ -60,7 +60,7 @@
(require 'org) (require 'org)
(require 'ob) (require 'ob)
(require 'sclang) (require 'sclang nil t)
(defgroup ob-sclang nil (defgroup ob-sclang nil
"org-mode blocks for SuperCollider SCLang." "org-mode blocks for SuperCollider SCLang."

View File

@ -28,9 +28,9 @@ guide:: orgguide.texi org-version.inc
endif endif
org.texi orgguide.texi: org-manual.org org-guide.org org.texi orgguide.texi: org-manual.org org-guide.org
$(BATCH) \ $(BATCH) \
--eval '(add-to-list '"'"'load-path "../lisp")' \ --eval '(add-to-list `load-path "../lisp")' \
--eval '(load "../mk/org-fixup.el")' \ --eval '(load "../mk/org-fixup.el")' \
--eval '(org-make-manuals)' --eval '(org-make-manuals)'
org-version.inc: org.texi org-version.inc: org.texi
@ -88,8 +88,8 @@ ifneq ($(SERVERMK),)
endif endif
%_letter.tex: %.tex %_letter.tex: %.tex
$(BATCH) \ $(BATCH) \
--eval '(add-to-list '"'"'load-path "../lisp")' \ --eval '(add-to-list `load-path "../lisp")' \
--eval '(load "org-compat.el")' \ --eval '(load "org-compat.el")' \
--eval '(load "../mk/org-fixup.el")' \ --eval '(load "../mk/org-fixup.el")' \
--eval '(org-make-letterformat "$(<F)" "$(@F)")' --eval '(org-make-letterformat "$(<F)" "$(@F)")'

File diff suppressed because it is too large Load Diff

View File

@ -172,7 +172,7 @@ because otherwise all these markers will point to nowhere."
,@body))) ,@body)))
(defmacro org-eval-in-environment (environment form) (defmacro org-eval-in-environment (environment form)
(declare (debug (form form)) (indent 1)) (declare (debug (form form)) (indent 1) (obsolete cl-progv "Mar 2021"))
`(eval (list 'let ,environment ',form))) `(eval (list 'let ,environment ',form)))
;;;###autoload ;;;###autoload
@ -366,15 +366,17 @@ error when the user input is empty."
(allow-empty? nil) (allow-empty? nil)
(t (user-error "Empty input is not valid"))))) (t (user-error "Empty input is not valid")))))
(declare-function org-time-stamp-inactive "org" (&optional arg))
(defun org-completing-read (&rest args) (defun org-completing-read (&rest args)
"Completing-read with SPACE being a normal character." "Completing-read with SPACE being a normal character."
(let ((enable-recursive-minibuffers t) (let ((enable-recursive-minibuffers t)
(minibuffer-local-completion-map (minibuffer-local-completion-map
(copy-keymap minibuffer-local-completion-map))) (copy-keymap minibuffer-local-completion-map)))
(define-key minibuffer-local-completion-map " " 'self-insert-command) (define-key minibuffer-local-completion-map " " #'self-insert-command)
(define-key minibuffer-local-completion-map "?" 'self-insert-command) (define-key minibuffer-local-completion-map "?" #'self-insert-command)
(define-key minibuffer-local-completion-map (kbd "C-c !") (define-key minibuffer-local-completion-map (kbd "C-c !")
'org-time-stamp-inactive) #'org-time-stamp-inactive)
(apply #'completing-read args))) (apply #'completing-read args)))
(defun org--mks-read-key (allowed-keys prompt navigation-keys) (defun org--mks-read-key (allowed-keys prompt navigation-keys)
@ -627,6 +629,30 @@ program is needed for, so that the error message can be more informative."
(let ((message-log-max nil)) (let ((message-log-max nil))
(apply #'message args))) (apply #'message args)))
(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)))))))
(defun org-eval (form) (defun org-eval (form)
"Eval FORM and return result." "Eval FORM and return result."
(condition-case error (condition-case error
@ -974,7 +1000,7 @@ IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
many lines, whatever width that takes. many lines, whatever width that takes.
The return value is a list of lines, without newlines at the end." The return value is a list of lines, without newlines at the end."
(let* ((words (split-string string)) (let* ((words (split-string string))
(maxword (apply 'max (mapcar 'org-string-width words))) (maxword (apply #'max (mapcar #'org-string-width words)))
w ll) w ll)
(cond (width (cond (width
(org--do-wrap words (max maxword width))) (org--do-wrap words (max maxword width)))
@ -1071,10 +1097,11 @@ that will be added to PLIST. Returns the string that was modified."
string) string)
(defun org-make-parameter-alist (flat) (defun org-make-parameter-alist (flat)
;; FIXME: "flat" is called a "plist"!
"Return alist based on FLAT. "Return alist based on FLAT.
FLAT is a list with alternating symbol names and values. The 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 returned alist is a list of lists with the symbol name in car and
the value in cdr." the value in cadr."
(when flat (when flat
(cons (list (car flat) (cadr flat)) (cons (list (car flat) (cadr flat))
(org-make-parameter-alist (cddr flat))))) (org-make-parameter-alist (cddr flat)))))

View File

@ -63,6 +63,7 @@
(require 'cl-lib) (require 'cl-lib)
(require 'org-macs) (require 'org-macs)
(require 'org) ;Otherwise `org-num--comment-re' burps on `org-comment-string'
(defvar org-comment-string) (defvar org-comment-string)
(defvar org-complex-heading-regexp) (defvar org-complex-heading-regexp)
@ -90,7 +91,7 @@ output."
(face :tag "Use face")) (face :tag "Use face"))
:safe (lambda (val) (or (null val) (facep val)))) :safe (lambda (val) (or (null val) (facep val))))
(defcustom org-num-format-function 'org-num-default-format (defcustom org-num-format-function #'org-num-default-format
"Function used to display numbering. "Function used to display numbering.
It is called with one argument, a list of numbers, and should It is called with one argument, a list of numbers, and should
return a string, or nil. When nil, no numbering is displayed. return a string, or nil. When nil, no numbering is displayed.

View File

@ -21,7 +21,7 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code: ;;; Code:
(require 'org-test) (require 'org-test "../testing/org-test")
(require 'ob-core) (require 'ob-core)
(defvar org-babel-temporary-directory ; from ob-core (defvar org-babel-temporary-directory ; from ob-core

View File

@ -23,7 +23,7 @@
;;; Code: ;;; Code:
(require 'org-test) (require 'org-test "../testing/org-test")
(require 'org-agenda) (require 'org-agenda)
(eval-and-compile (require 'cl-lib)) (eval-and-compile (require 'cl-lib))

View File

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(require 'org-test) (require 'org-test "../testing/org-test")
(require 'org-attach) (require 'org-attach)
(eval-and-compile (require 'cl-lib)) (eval-and-compile (require 'cl-lib))

View File

@ -21,7 +21,7 @@
;;; Code: ;;; Code:
(require 'org-test) (require 'org-test "../testing/org-test")

View File

@ -286,7 +286,15 @@ setting `pp-escape-newlines' to nil manually."
;;; Navigation Functions ;;; Navigation Functions
(when (featurep 'jump)
(defmacro org--compile-when (test &rest body)
(declare (debug t) (indent 1))
(let ((exp `(progn ,@body)))
(if (eval test t)
exp
`(when ,test (eval exp t)))))
(org--compile-when (featurep 'jump)
(defjump org-test-jump (defjump org-test-jump
(("lisp/\\1.el" . "testing/lisp/test-\\1.el") (("lisp/\\1.el" . "testing/lisp/test-\\1.el")
("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el") ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
@ -323,7 +331,8 @@ setting `pp-escape-newlines' to nil manually."
" (should-not nil)\n" " (should-not nil)\n"
" (should-error (error \"errr...\")))\n\n\n" " (should-error (error \"errr...\")))\n\n\n"
"(provide '" name ")\n\n" "(provide '" name ")\n\n"
";;; " file-name " ends here\n") full-path)) ";;; " file-name " ends here\n")
full-path))
(lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function))))) (lambda () ((lambda (res) (if (listp res) (car res) res)) (which-function)))))
(define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump) (define-key emacs-lisp-mode-map "\M-\C-j" 'org-test-jump)