org-diary-sexp-entry: Cache results

* lisp/org.el (org--diary-sexp-entry-cache): New variable holding
cached return values of `org-diary-sexp-entry'.
(org-diary-sexp-entry): Use `org--diary-sexp-entry-cache'.
This commit is contained in:
Ihor Radchenko 2022-09-21 12:42:34 +08:00
parent c35a856048
commit 4075662c29
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 28 additions and 23 deletions

View File

@ -14425,34 +14425,39 @@ D may be an absolute day number, or a calendar-type list (month day year)."
(let ((hl (calendar-check-holidays org-agenda-current-date))) (let ((hl (calendar-check-holidays org-agenda-current-date)))
(and hl (mapconcat #'identity hl "; ")))) (and hl (mapconcat #'identity hl "; "))))
(defvar org--diary-sexp-entry-cache (make-hash-table :test #'equal)
"Hash table holding return values of `org-diary-sexp-entry'.")
(defun org-diary-sexp-entry (sexp entry d) (defun org-diary-sexp-entry (sexp entry d)
"Process a SEXP diary ENTRY for date D." "Process a SEXP diary ENTRY for date D."
(require 'diary-lib) (require 'diary-lib)
;; `org-anniversary' and alike expect ENTRY and DATE to be bound ;; `org-anniversary' and alike expect ENTRY and DATE to be bound
;; dynamically. ;; dynamically.
(let* ((sexp `(let ((entry ,entry) (or (gethash (list sexp entry d) org--diary-sexp-entry-cache)
(date ',d)) (puthash (list sexp entry d)
,(car (read-from-string sexp)))) (let* ((sexp `(let ((entry ,entry)
;; FIXME: Do not use (eval ... t) in the following sexp as (date ',d))
;; diary vars are still using dynamic scope. ,(car (read-from-string sexp))))
(result (if calendar-debug-sexp (eval sexp) ;; FIXME: Do not use (eval ... t) in the following sexp as
(condition-case nil ;; diary vars are still using dynamic scope.
(eval sexp) (result (if calendar-debug-sexp (eval sexp)
(error (condition-case nil
(beep) (eval sexp)
(message "Bad sexp at line %d in %s: %s" (error
(org-current-line) (beep)
(buffer-file-name) sexp) (message "Bad sexp at line %d in %s: %s"
(sleep-for 2)))))) (org-current-line)
(cond ((stringp result) (split-string result "; ")) (buffer-file-name) sexp)
((and (consp result) (sleep-for 2))))))
(not (consp (cdr result))) (cond ((stringp result) (split-string result "; "))
(stringp (cdr result))) ((and (consp result)
(cdr result)) (not (consp (cdr result)))
((and (consp result) (stringp (cdr result)))
(stringp (car result))) (cdr result))
result) ((and (consp result)
(result entry)))) (stringp (car result)))
result)
(result entry)))
org--diary-sexp-entry-cache)))
(defun org-diary-to-ical-string (frombuf) (defun org-diary-to-ical-string (frombuf)
"Get iCalendar entries from diary entries in buffer FROMBUF. "Get iCalendar entries from diary entries in buffer FROMBUF.