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.

1 files changed, 51 insertions, 49 deletions

diff --git a/lisp/org-id.el b/lisp/org-id.el
index 34720b7..9456b06 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -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
-		   (mapcar #'file-truename
-			   (append
-			    ;; 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
-			    org-id-files
-			    ;; function input
-			    files))))
-	   (nfiles (length files))
-	   ids seen-ids (ndup 0) (i 0) file-id-alist)
-      (with-temp-buffer
-	(delay-mode-hooks
-	  (org-mode)
-          (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 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.
+                    (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.
+                    org-id-files
+                    ;; Additional files from function call.
+                    files))))
+         (nfiles (length files))
+         (id-regexp
+	  (rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " ")))))
+         (seen-ids nil)
+         (ndup 0)
+         (i 0))
+    (dolist (file files)
+      (when (file-exists-p file)
+        (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))
-      (org-id-locations-save)
-      ;; now convert to a hash
-      (setq org-id-locations (org-id-alist-to-hash org-id-locations))
-      (when (> 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."
-	       nfiles (length org-id-files) (hash-table-count org-id-locations))
-      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 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 ()
   "Save `org-id-locations' in `org-id-locations-file'."