org-id: Speedup, minor functional change and fix

* org-id-update-id-locations

Major speedup and minor functionality change.  This function is more
predictable now since local open files are not considered.  Providing
files as arguments to the function does no longer override other
files.  They are instead seen as a complement.

* org-id-add-location

Don't add duplicates.

* org-id-hash-to-alist

Fixed function, previously didn't do its job correctly.
This commit is contained in:
Gustav Wikström 2019-08-01 22:41:43 +02:00
parent 3ea2dde570
commit 9865e6bd8b
1 changed files with 51 additions and 74 deletions

View File

@ -446,81 +446,56 @@ and time is the usual three-integer representation of time."
Store the relation between files and corresponding IDs. Store the relation between files and corresponding IDs.
This will scan all agenda files, all associated archives, and all 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 these files instead." When FILES is given, scan also these files."
(interactive) (interactive)
(if (not org-id-track-globally) (if (not 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* ((org-id-search-archives (let* ((files (delete-dups
(or org-id-search-archives (mapcar #'file-truename
(and (symbolp org-id-extra-files) (append
(symbol-value org-id-extra-files) ;; Agenda files and all associated archives
(member 'agenda-archives org-id-extra-files)))) (org-agenda-files t org-id-search-archives)
(files ;; Explicit extra files
(or files (unless (symbolp org-id-extra-files)
(append org-id-extra-files)
;; Agenda files and all associated archives ;; All files known to have IDs
(org-agenda-files t org-id-search-archives) org-id-files
;; Explicit extra files ;; function input
(if (symbolp org-id-extra-files) files))))
(symbol-value org-id-extra-files) (nfiles (length files))
org-id-extra-files) ids seen-ids (ndup 0) (i 0) file-id-alist)
;; Files associated with live Org buffers (with-temp-buffer
(delq nil (delay-mode-hooks
(mapcar (lambda (b) (org-mode)
(with-current-buffer b (dolist (file files)
(and (derived-mode-p 'org-mode) (buffer-file-name)))) (unless silent
(buffer-list))) (setq i (1+ i))
;; All files known to have IDs (message "Finding ID locations (%d/%d files): %s"
org-id-files))) i nfiles file))
org-agenda-new-buffers (when (file-exists-p file)
file nfiles tfile ids reg found id seen (ndup 0)) (insert-file-contents file nil nil nil 'replace)
(when (member 'agenda-archives files) (setq ids (org-map-entries
(setq files (delq 'agenda-archives (copy-sequence files)))) (lambda ()
(setq nfiles (length files)) (org-entry-get (point) "ID"))
(while (setq file (pop files)) "ID<>\"\""))
(unless silent (dolist (id ids)
(message "Finding ID locations (%d/%d files): %s" (if (member id seen-ids)
(- nfiles (length files)) nfiles file)) (progn
(setq tfile (file-truename file)) (message "Duplicate ID \"%s\"" id)
(when (and (file-exists-p file) (not (member tfile seen))) (setq ndup (1+ ndup)))
(push tfile seen) (push id seen-ids)))
(setq ids nil) (when ids
(with-current-buffer (org-get-agenda-file-buffer file) (setq file-id-alist (cons (cons (abbreviate-file-name file) ids)
(save-excursion file-id-alist)))))))
(save-restriction (setq org-id-locations file-id-alist)
(widen)
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$"
nil t)
(setq id (match-string-no-properties 1))
(if (member id found)
(progn
(message "Duplicate ID \"%s\", also in file %s"
id (or (car (delq
nil
(mapcar
(lambda (x)
(if (member id (cdr x))
(car x)))
reg)))
(buffer-file-name)))
(when (= ndup 0)
(ding)
(sit-for 2))
(setq ndup (1+ ndup)))
(push id found)
(push id ids)))
(push (cons (abbreviate-file-name file) ids) reg))))))
(org-release-buffers org-agenda-new-buffers)
(setq org-agenda-new-buffers nil)
(setq org-id-locations reg)
(setq org-id-files (mapcar 'car org-id-locations)) (setq org-id-files (mapcar 'car org-id-locations))
(org-id-locations-save) ;; this function can also handle the alist form (org-id-locations-save)
;; now convert to a hash ;; now convert to a hash
(setq org-id-locations (org-id-alist-to-hash org-id-locations)) (setq org-id-locations (org-id-alist-to-hash org-id-locations))
(if (> ndup 0) (when (> ndup 0)
(message "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup) (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
(message "%d unique files scanned for IDs" (length org-id-files))) (message "%d files scanned, %d files contains IDs and in total %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 () (defun org-id-locations-save ()
@ -552,10 +527,12 @@ When FILES is given, scan these files instead."
(defun org-id-add-location (id file) (defun org-id-add-location (id file)
"Add the ID with location FILE to the database of ID locations." "Add the ID with location FILE to the database of ID locations."
;; Only if global tracking is on, and when the buffer has a file ;; Only if global tracking is on, and when the buffer has a file
(when (and org-id-track-globally id file) (let ((afile (abbreviate-file-name file)))
(unless org-id-locations (org-id-locations-load)) (when (and org-id-track-globally id file)
(puthash id (abbreviate-file-name file) org-id-locations) (unless org-id-locations (org-id-locations-load))
(add-to-list 'org-id-files (abbreviate-file-name file)))) (puthash id afile org-id-locations)
(unless (member afile org-id-files)
(add-to-list 'org-id-files afile)))))
(unless noninteractive (unless noninteractive
(add-hook 'kill-emacs-hook 'org-id-locations-save)) (add-hook 'kill-emacs-hook 'org-id-locations-save))
@ -565,7 +542,7 @@ When FILES is given, scan these files instead."
(let (res x) (let (res x)
(maphash (maphash
(lambda (k v) (lambda (k v)
(if (setq x (member v res)) (if (setq x (assoc v res))
(setcdr x (cons k (cdr x))) (setcdr x (cons k (cdr x)))
(push (list v k) res))) (push (list v k) res)))
hash) hash)