0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-30 01:27:53 +00:00

id: Faster `org-id-update-id-locations'

* lisp/org-id.el (org-id-update-id-locations): Do not copy contents of
files in order to parse them.
This commit is contained in:
Nicolas Goaziou 2020-05-14 22:48:17 +02:00
parent 4a727d2cfc
commit 37a5020bbe

View file

@ -485,56 +485,58 @@ This will scan all agenda files, all associated archives, and all
files currently mentioned in `org-id-locations'. files currently mentioned in `org-id-locations'.
When FILES is given, scan also these files." When FILES is given, scan also these files."
(interactive) (interactive)
(if (not org-id-track-globally) (unless org-id-track-globally
(error "Please turn on `org-id-track-globally' if you want to track IDs") (error "Please turn on `org-id-track-globally' if you want to track IDs"))
(let* ((files (delete-dups (setq org-id-locations nil)
(let* ((files
(delete-dups
(mapcar #'file-truename (mapcar #'file-truename
(append (append
;; Agenda files and all associated archives ;; Agenda files and all associated archives.
(org-agenda-files t org-id-search-archives) (org-agenda-files t org-id-search-archives)
;; Explicit extra files ;; Explicit extra files.
(unless (symbolp org-id-extra-files) (unless (symbolp org-id-extra-files) org-id-extra-files)
org-id-extra-files) ;; All files known to have IDs.
;; All files known to have IDs
org-id-files org-id-files
;; function input ;; Additional files from function call.
files)))) files))))
(nfiles (length files)) (nfiles (length files))
ids seen-ids (ndup 0) (i 0) file-id-alist) (id-regexp
(with-temp-buffer (rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " ")))))
(delay-mode-hooks (seen-ids nil)
(org-mode) (ndup 0)
(i 0))
(dolist (file files) (dolist (file files)
(unless silent
(setq i (1+ i))
(message "Finding ID locations (%d/%d files): %s"
i nfiles file))
(when (file-exists-p file) (when (file-exists-p file)
(insert-file-contents file nil nil nil 'replace) (unless silent
(setq ids (delq nil (cl-incf i)
(org-map-entries (message "Finding ID locations (%d/%d files): %s" i nfiles file))
(lambda () (with-current-buffer (find-file-noselect file t)
(org-entry-get (point) "ID")) (let ((ids nil)
"ID<>\"\""))) (case-fold-search t))
(dolist (id ids) (org-with-point-at 1
(if (member id seen-ids) (while (re-search-forward id-regexp nil t)
(progn (when (org-at-property-p)
(message "Duplicate ID \"%s\"" id) (push (org-entry-get (point) "ID") ids)))
(setq ndup (1+ ndup)))
(push id seen-ids)))
(when ids (when ids
(setq file-id-alist (cons (cons (abbreviate-file-name file) ids) (push (cons (abbreviate-file-name file) ids)
file-id-alist))))))) org-id-locations)
(setq org-id-locations file-id-alist) (dolist (id ids)
(setq org-id-files (mapcar 'car org-id-locations)) (cond
((not (member id seen-ids)) (push id seen-ids))
(silent nil)
(t
(message "Duplicate ID %S" id)
(cl-incf ndup))))))))))
(setq org-id-files (mapcar #'car org-id-locations))
(org-id-locations-save) (org-id-locations-save)
;; now convert to a hash ;; Now convert to a hash table.
(setq org-id-locations (org-id-alist-to-hash org-id-locations)) (setq org-id-locations (org-id-alist-to-hash org-id-locations))
(when (> ndup 0) (when (and (not silent) (> ndup 0))
(warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)) (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
(message "%d files scanned, %d files contains IDs and in total %d IDs found." (message "%d files scanned, %d files contains IDs, and %d IDs found."
nfiles (length org-id-files) (hash-table-count org-id-locations)) nfiles (length org-id-files) (hash-table-count org-id-locations))
org-id-locations))) org-id-locations))
(defun org-id-locations-save () (defun org-id-locations-save ()
"Save `org-id-locations' in `org-id-locations-file'." "Save `org-id-locations' in `org-id-locations-file'."