tec/org-mode
tec/org-mode
1
0
Fork 0
forked from mirrors/org-mode
Code Pull requests Releases Activity

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

Browse source 
* 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
1 changed files with 51 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

100
lisp/org-id.el
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)
(mapcar #'file-truename (let* ((files
(append (delete-dups
;; Agenda files and all associated archives (mapcar #'file-truename
(org-agenda-files t org-id-search-archives) (append
;; Explicit extra files ;; Agenda files and all associated archives.
(unless (symbolp org-id-extra-files) (org-agenda-files t org-id-search-archives)
org-id-extra-files) ;; Explicit extra files.
;; All files known to have IDs (unless (symbolp org-id-extra-files) org-id-extra-files)
org-id-files ;; All files known to have IDs.
;; function input org-id-files
files)))) ;; Additional files from function call.
(nfiles (length files)) files))))
ids seen-ids (ndup 0) (i 0) file-id-alist) (nfiles (length files))
(with-temp-buffer (id-regexp
(delay-mode-hooks (rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " ")))))
(org-mode) (seen-ids nil)
(dolist (file files) (ndup 0)
(unless silent (i 0))
(setq i (1+ i)) (dolist (file files)
(message "Finding ID locations (%d/%d files): %s" (when (file-exists-p file)
i nfiles file)) (unless silent
(when (file-exists-p file) (cl-incf i)
(insert-file-contents file nil nil nil 'replace) (message "Finding ID locations (%d/%d files): %s" i nfiles file))
(setq ids (delq nil (with-current-buffer (find-file-noselect file t)
(org-map-entries (let ((ids nil)
(lambda () (case-fold-search t))
(org-entry-get (point) "ID")) (org-with-point-at 1
"ID<>\"\""))) (while (re-search-forward id-regexp nil t)
(dolist (id ids) (when (org-at-property-p)
(if (member id seen-ids) (push (org-entry-get (point) "ID") ids)))
(progn
(message "Duplicate ID \"%s\"" id)
(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
(org-id-locations-save) ((not (member id seen-ids)) (push id seen-ids))
;; now convert to a hash (silent nil)
(setq org-id-locations (org-id-alist-to-hash org-id-locations)) (t
(when (> ndup 0) (message "Duplicate ID %S" id)
(warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)) (cl-incf ndup))))))))))
(message "%d files scanned, %d files contains IDs and in total %d IDs found." (setq org-id-files (mapcar #'car org-id-locations))
nfiles (length org-id-files) (hash-table-count org-id-locations)) (org-id-locations-save)
org-id-locations))) ;; Now convert to a hash table.
(setq org-id-locations (org-id-alist-to-hash org-id-locations))
(when (and (not silent) (> ndup 0))
(warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
(message "%d files scanned, %d files contains IDs, and %d IDs found."
nfiles (length org-id-files) (hash-table-count 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'."