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)))
(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)
"Process a SEXP diary ENTRY for date D."
(require 'diary-lib)
;; `org-anniversary' and alike expect ENTRY and DATE to be bound
;; dynamically.
(let* ((sexp `(let ((entry ,entry)
(date ',d))
,(car (read-from-string sexp))))
;; FIXME: Do not use (eval ... t) in the following sexp as
;; diary vars are still using dynamic scope.
(result (if calendar-debug-sexp (eval sexp)
(condition-case nil
(eval sexp)
(error
(beep)
(message "Bad sexp at line %d in %s: %s"
(org-current-line)
(buffer-file-name) sexp)
(sleep-for 2))))))
(cond ((stringp result) (split-string result "; "))
((and (consp result)
(not (consp (cdr result)))
(stringp (cdr result)))
(cdr result))
((and (consp result)
(stringp (car result)))
result)
(result entry))))
(or (gethash (list sexp entry d) org--diary-sexp-entry-cache)
(puthash (list sexp entry d)
(let* ((sexp `(let ((entry ,entry)
(date ',d))
,(car (read-from-string sexp))))
;; FIXME: Do not use (eval ... t) in the following sexp as
;; diary vars are still using dynamic scope.
(result (if calendar-debug-sexp (eval sexp)
(condition-case nil
(eval sexp)
(error
(beep)
(message "Bad sexp at line %d in %s: %s"
(org-current-line)
(buffer-file-name) sexp)
(sleep-for 2))))))
(cond ((stringp result) (split-string result "; "))
((and (consp result)
(not (consp (cdr result)))
(stringp (cdr result)))
(cdr result))
((and (consp result)
(stringp (car result)))
result)
(result entry)))
org--diary-sexp-entry-cache)))
(defun org-diary-to-ical-string (frombuf)
"Get iCalendar entries from diary entries in buffer FROMBUF.