mirrors/org-mode
0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-29 23:17:49 +00:00
Code 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

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