version 5.2.1 of org-index with speed improvements

contrib/lisp/org-index.el

@@ -3,7 +3,7 @@
 ;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
 
 ;; Author: Marc Ihm <org-index@2484.de>
-;; Version: 5.2.0
+;; Version: 5.2.1
 ;; Keywords: outlines index
 
 ;; This file is not part of GNU Emacs.
@@ -55,7 +55,8 @@
 ;;  - Add these lines to your .emacs:
 ;;
 ;;    (require 'org-index)
-;;    (global-set-key (kbd "C-c i") 'org-index-dispatch) ; this is optional
+;;    (global-set-key (kbd "C-c i") 'org-index-dispatch) ; this is optional but recommended
+;;    (org-index-prepare-when-idle)  ; this is optional, not needed initially; see its description
 ;;
 ;;  - Restart your Emacs to make these lines effective.
 ;;
@@ -86,9 +87,12 @@
 
 ;;; Change Log:
 
-;;   [2017-01-22 Su] Version 5.2.0
+;;   [2017-01-29 Su] Version 5.2.1
 ;;   - New command 'focus'
+;;   - Improved on speed by using the stored property "max-ref"
+;;   - Added org-index-prepare-when-idle
 ;;   - Fixed compatibility issue with emacs 24 (font-lock-ensure)
+;;   - Bugfixes
 ;;
 ;;   [2016-10-19 We] Version 5.1.4
 ;;   - Bugfixes
@@ -268,7 +272,6 @@ those pieces."
 
 ;; Variables to hold the configuration of the index table
 (defvar org-index--maxrefnum nil "Maximum number from reference table, e.g. 153.")
-(defvar org-index--nextref nil "Next reference, that can be used, e.g. 'R154'.")
 (defvar org-index--head nil "Header before number (e.g. 'R').")
 (defvar org-index--tail nil "Tail after number (e.g. '}' or ')'.")
 (defvar org-index--numcols nil "Number of columns in index table.")
@@ -296,7 +299,7 @@ those pieces."
 (defvar org-index--occur-stack nil "Stack with overlays for hiding lines.")
 (defvar org-index--occur-tail-overlay nil "Overlay to cover invisible lines.")
 (defvar org-index--occur-lines-collected 0 "Number of lines collected in occur buffer; helpful for tests.")
-(defvar org-index--last-sort nil "Last column, the index has been sorted after.")
+(defvar org-index--last-sort-assumed nil "Last column, the index has been sorted after (best guess).")
 (defvar org-index--sort-timer nil "Timer to sort index in correct order.")
 (defvar org-index--aligned nil "Remember for this Emacs session, if table has been aligned at least once.")
 (defvar org-index--edit-widgets nil "List of widgets used to edit.")
@@ -313,7 +316,7 @@ those pieces."
 (defconst org-index--valid-headings '(ref id created last-accessed count keywords category level yank tags) "All valid headings.")
 (defconst org-index--occur-buffer-name "*org-index-occur*" "Name of occur buffer.")
 (defconst org-index--edit-buffer-name "*org-index-edit*" "Name of edit buffer.")
-(defconst org-index--sort-idle-delay 300 "Delay in seconds after which buffer will sorted.")
+(defconst org-index--idle-delay 68 "Delay in seconds after which buffer will sorted or fontified.")
 (defvar org-index--short-help-text nil "Cache for result of `org-index--get-short-help-text.")
 (defvar org-index--shortcut-chars nil "Cache for result of `org-index--get-shortcut-chars.")
 
@@ -408,13 +411,15 @@ of subcommands to choose from:
 
   help: Show complete help text of org-index.
 
-  focus: [f] Return to focus-node; need to set-focus [F] before.
+  focus: [f] Return to focus-node; need to set-focus before.
     The focused node is a single and special node, the location
     of which is remembered and which can be found with a single
     key-sequence; it need not be part of the index though.  This
-    can be useful, if you mostly work in one node, but make
+    can be useful, if you mostly work in a single node, but make
     frequent excursions to others.
 
+  set-focus: [F] Set focus-node for command focus.
+
   short-help: [?] Show one-line description of each subcommand.
     I.e. show this list but only first sentence each.
 
@@ -482,11 +487,11 @@ interactive calls."
       ;;
 
       ;; lets assume, that it has been sorted this way (we try hard to make sure)
-      (unless org-index--last-sort (setq org-index--last-sort org-index-sort-by))
+      (unless org-index--last-sort-assumed (setq org-index--last-sort-assumed org-index-sort-by))
       ;; rearrange for index beeing sorted into default sort order after 300 secs of idle time
       (unless org-index--sort-timer
         (setq org-index--sort-timer
-              (run-with-idle-timer org-index--sort-idle-delay t 'org-index--sort-silent)))
+              (run-with-idle-timer org-index--idle-delay t 'org-index--sort-silent)))
 
 
       ;;
@@ -569,7 +574,7 @@ interactive calls."
       ;;
 
       ;; Arrange for beeing able to return
-      (when (and (memq command '(occur head index example sort maintain))
+      (when (and (memq command '(occur head index example sort maintain focus))
                  (not (string= (buffer-name) org-index--occur-buffer-name)))
         (org-mark-ring-push))
 
@@ -733,15 +738,16 @@ interactive calls."
 
        ((eq command 'ref)
 
-        (let (args)
+        (let (args newref)
 
           (setq args (org-index--collect-values-from-user org-index-edit-on-ref))
-          (setq args (plist-put args 'ref org-index--nextref))
+          (setq newref (org-index--get-save-maxref))
+          (setq args (plist-put args 'ref newref))
           (apply 'org-index--do-new-line args)
 
-          (setq kill-new-text org-index--nextref)
+          (setq kill-new-text newref)
 
-          (setq message-text (format "Added new row with ref '%s'" org-index--nextref))))
+          (setq message-text (format "Added new row with ref '%s'" newref))))
 
 
        ((eq command 'yank)
@@ -809,7 +815,7 @@ interactive calls."
                              ""))
                    (symbol-name sort)
                    org-index-sort-by
-                   org-index--sort-idle-delay
+                   org-index--idle-delay
                    (second groups-and-counts)
                    (symbol-name sort)
                    (third groups-and-counts))))
@@ -842,21 +848,22 @@ interactive calls."
         (if org-index--id-focused-node
             (let (marker)
               (setq marker (org-id-find org-index--id-focused-node 'marker))
-              (unless marker (error "Could not find focused node"))
+              (unless marker (error "Could not find focus-node"))
               (pop-to-buffer-same-window (marker-buffer marker))
               (goto-char (marker-position marker))
               (org-index--unfold-buffer)
               (move-marker marker nil)
-              (setq message-text "Moved to focused node"))
-          (setq message-text "No node is focused, use set-focus")))
+              (setq message-text "Jumped to focus-node"))
+          (setq message-text "No focus-node, use set-focus")))
 
        
        ((eq command 'set-focus)
         (let ((focus-id (org-id-get-create)))
-          (with-current-buffer org-index--buffer
+          (save-excursion
+            (set-buffer org-index--buffer)
             (org-entry-put org-index--point "id-focused-node" focus-id)
             (setq org-index--id-focused-node focus-id)
-            (setq message-text "Focus has been set on node"))))
+            (setq message-text "Focus has been set on current node"))))
 
        
        ((eq command 'maintain)
@@ -926,11 +933,11 @@ Optional argument KEYS-VALUES specifies content of new line."
 
   (let ((ref (plist-get keys-values 'ref)))
     (org-index--verify-id)
-    (org-index--parse-table)
+    (org-index--parse-table t)
     (if (not (memq ref  '(t nil)))
         (error "Column 'ref' accepts only 't' or 'nil'"))
     (when ref
-      (setq ref org-index--nextref)
+      (setq ref (org-index--get-save-maxref))
       (setq keys-values (plist-put keys-values 'ref ref)))
 
     (apply 'org-index--do-new-line keys-values)
@@ -1024,7 +1031,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
         (end-of-line)
         (insert " (this text)")
         (goto-char (point-min))
-        (unless (= (line-number-at-pos (point-max)) (length org-index--commands))
+        (unless (= (line-number-at-pos (point-max)) (1+ (length org-index--commands)))
           (error "Internal error, unable to properly extract one-line descriptions of subcommands"))
         (setq org-index--short-help-text (buffer-string)))))
 
@@ -1260,7 +1267,7 @@ argument VALUE specifies the value to search for."
     (error "Need a value to search for"))
   
   (org-index--verify-id)
-  (org-index--parse-table)
+  (org-index--parse-table t)
 
   (org-index--get-line column value))
 
@@ -1364,24 +1371,25 @@ Argument COLUMN and VALUE specify line to get."
   (setq org-index--within-occur (string= (buffer-name) org-index--occur-buffer-name)))
 
 
-(defun org-index--parse-table ()
+(defun org-index--parse-table (&optional no-reformat)
   "Parse content of index table."
 
   (let (ref-field
-        id-field
+        ref-num
         initial-point
         end-of-headings
         start-of-headings)
 
     (with-current-buffer org-index--buffer
 
-      (setq org-index--maxrefnum 0)
       (setq initial-point (point))
 
       (org-index--go-below-hline)
+      (unless no-reformat (org-reveal))
 
       ;; align and fontify table once for this emacs session
-      (unless org-index--aligned
+      (unless (or org-index--aligned no-reformat)
+        (message "Aligning and fontifying index table (once per emacs session)...")
         (org-table-align) ; needs to happen before fontification to be effective ?
         (let ((is-modified (buffer-modified-p))
               (below (point)))
@@ -1394,7 +1402,7 @@ Argument COLUMN and VALUE specify line to get."
 
       (org-index--go-below-hline)
       (beginning-of-line)
-
+      
       ;; get headings to display during occur
       (setq end-of-headings (point))
       (while (org-at-table-p) (forward-line -1))
@@ -1402,78 +1410,101 @@ Argument COLUMN and VALUE specify line to get."
       (setq start-of-headings (point))
       (setq org-index--headings-visible (substring-no-properties (org-index--copy-visible start-of-headings end-of-headings)))
       (setq org-index--headings (buffer-substring start-of-headings end-of-headings))
-
+      
       ;; count columns
       (org-table-goto-column 100)
       (setq org-index--numcols (- (org-table-current-column) 1))
-
+      
       ;; go to top of table
       (while (org-at-table-p)
         (forward-line -1))
       (forward-line)
-
+      
       ;; parse line of headings
       (org-index--parse-headings)
 
-      ;; parse list of flags
-      (goto-char org-index--point)
-
-      ;; Retrieve any decorations around the number within the first nonempty ref-field
+      ;; read property or go through table to find maximum number
       (goto-char org-index--below-hline)
-      (while (and (org-at-table-p)
-                  (not (setq ref-field (org-index--get-or-set-field 'ref))))
-        (forward-line))
-
+      (setq ref-field (or (org-entry-get org-index--point "max-ref")
+                          (org-index--migrate-maxref-to-property)))
+      
+      (unless org-index--head (org-index--get-decoration-from-ref-field ref-field))
+      (setq org-index--maxrefnum (org-index--extract-refnum ref-field))
+    
       ;; Get id of focused node (if any)
       (setq org-index--id-focused-node (org-entry-get nil "id-focused-node"))
 
-      ;; Some Checking
-      (unless ref-field
-        (org-index--report-index-error "Reference column is empty"))
-
-      (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
-        (org-index--report-index-error
-         "First reference in index table ('%s') does not contain a number" ref-field))
-
-      ;; These are the decorations used within the first ref of index
-      (setq org-index--head (match-string 1 ref-field))
-      (setq org-index--tail (match-string 3 ref-field))
-      (setq org-index--ref-regex (concat (regexp-quote org-index--head)
-                                         "\\([0-9]+\\)"
-                                         (regexp-quote org-index--tail)))
-      (setq org-index--ref-format (concat org-index--head "%d" org-index--tail))
+      ;; check, if the table still seems to be sorted mixed
+      (unless no-reformat
+        (goto-char org-index--below-hline)
+        (when (eq org-index-sort-by 'mixed)
+          (let (count-first-line count-second-line)
+            (setq count-first-line (string-to-number (concat (org-index--get-or-set-field 'count) " 0")))
+            (forward-line)
+            (setq count-second-line (string-to-number (concat (org-index--get-or-set-field 'count) " 0")))
+            (forward-line -1)
+            (if (and (string< (org-index--get-or-set-field 'last-accessed)
+                              (org-index--get-mixed-time))
+                     (< count-first-line count-second-line))
+                (org-index--do-sort-index org-index-sort-by)))))
+
+      ;; save position below hline
+      (org-index--go-below-hline)
+      ;; go back to initial position
+      (goto-char initial-point))))
 
-      ;; check if the table still seems to be sorted mixed
-      (goto-char org-index--below-hline)
-      (when (eq org-index-sort-by 'mixed)
-          (org-index--go-below-hline)
-          (if (string< (org-index--get-or-set-field 'last-accessed)
-                       (org-index--get-mixed-time))
-              (org-index--do-sort-index org-index-sort-by)))
-      
-      ;; Go through table to find maximum number and do some checking
-      (let ((refnum 0))
 
-        (while (org-at-table-p)
+(defun org-index--get-decoration-from-ref-field (ref-field)
+  (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
+    (org-index--report-index-error
+     "Reference in index table ('%s') does not contain a number" ref-field))
 
-          (setq ref-field (org-index--get-or-set-field 'ref))
-          (setq id-field (org-index--get-or-set-field 'id))
+  ;; These are the decorations used within the first ref of index
+  (setq org-index--head (match-string 1 ref-field))
+  (setq org-index--tail (match-string 3 ref-field))
+  (setq org-index--ref-regex (concat (regexp-quote org-index--head)
+                                     "\\([0-9]+\\)"
+                                     (regexp-quote org-index--tail)))
+  (setq org-index--ref-format (concat org-index--head "%d" org-index--tail)))
 
-          (if ref-field
-              (if (string-match org-index--ref-regex ref-field)
-                  ;; grab number
-                  (setq refnum (string-to-number (match-string 1 ref-field)))
-                (kill-whole-line)
-                (message "Removing line from index-table whose ref does not contain a number")))
 
-          ;; check, if higher ref
-          (if (> refnum org-index--maxrefnum) (setq org-index--maxrefnum refnum))
+(defun org-index--extract-refnum (ref-field)
+  (unless (string-match org-index--ref-regex ref-field)
+    (org-index--report-index-error
+     "Reference '%s' is not formatted properly (does not match '%s')" ref-field org-index--ref-regex))
+  (string-to-number (match-string 1 ref-field)))
 
-          (forward-line 1)))
 
-      (setq org-index--nextref (format "%s%d%s" org-index--head (1+ org-index--maxrefnum) org-index--tail))
-      ;; go back to initial position
-      (goto-char initial-point))))
+(defun org-index--migrate-maxref-to-property ()
+  "One-time migration: No property; need to go through whole table once to find max"
+  (org-index--go-below-hline)
+  (let (ref-field ref)
+    (message "One-time migration to set index-property maxref...")
+    (unless org-index--maxrefnum (setq org-index--maxrefnum 0))
+    (while (org-at-table-p)
+      (setq ref-field (org-index--get-or-set-field 'ref))
+      (when ref-field
+        (unless org-index--head (org-index--get-decoration-from-ref-field ref-field))
+        (setq ref-num (org-index--extract-refnum ref-field))
+        (if (> ref-num org-index--maxrefnum) (setq org-index--maxrefnum ref-num)))
+      (forward-line))
+    (unless org-index--maxrefnum
+      (org-index--report-index-error "No reference found in property max-ref and none in index."))
+    (setq ref (org-index--get-save-maxref t))
+    (org-index--go-below-hline)
+    (message "Done.")
+    ref))          
+
+
+(defun org-index--get-save-maxref (&optional no-inc)
+  "Get next reference, increment number and store it in index"
+  (let (ref)
+    (unless no-inc (setq org-index--maxrefnum (1+ org-index--maxrefnum)))
+    (setq ref (format org-index--ref-format org-index--maxrefnum))
+    (save-excursion
+      (set-buffer org-index--buffer)
+      (org-entry-put org-index--point "max-ref" ref))
+    ref))
 
 
 (defun org-index--refresh-parse-table ()
@@ -1579,7 +1610,8 @@ Argument COLUMN and VALUE specify line to get."
           ;; restore modification state
           (set-buffer-modified-p is-modified)))
 
-        (setq org-index--last-sort sort))))
+      (setq org-index--last-sort-assumed sort)
+      (setq org-index--last-sort-actual sort))))
 
 
 (defun org-index--do-sort-lines (what)
@@ -1767,6 +1799,7 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin
     (with-current-buffer buffer
       (goto-char (point-max))
       (insert (format "* %s %s\n" firstref title))
+      (org-entry-put org-index--point "max-ref" firstref)
       (if temporary
           (insert "
   Below you find your temporary index table, which WILL NOT LAST LONGER
@@ -1997,7 +2030,7 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin
         ref-field
         key)
 
-    (unless sort (setq sort org-index--last-sort)) ; use default value
+    (unless sort (setq sort org-index--last-sort-assumed)) ; use default value
 
     (when (or with-ref
               (eq sort 'ref))
@@ -2188,7 +2221,7 @@ CREATE-REF and TAG-WITH-REF if given."
 
       (when (and create-ref
                  (not ref))
-        (setq ref org-index--nextref)
+        (setq ref (org-index--get-save-maxref))
         (setq args (plist-put args 'ref ref)))
 
       
@@ -2207,7 +2240,7 @@ CREATE-REF and TAG-WITH-REF if given."
                     (cons "Updated index line" nil))))
 
         ;; no id here, create new line in index
-        (if ref (setq ref (plist-put args 'ref org-index--nextref)))
+        (if ref (setq args (plist-put args 'ref ref)))
         (setq yank (apply 'org-index--do-new-line args))
 
         (setq ret
@@ -3015,13 +3048,26 @@ If OTHER in separate window."
   "Sort index for default column to remove any effects of temporary sorting."
   (save-excursion
     (org-index--verify-id)
-    (org-index--parse-table)
+    (org-index--parse-table t)
     (org-index--on nil nil
       (org-index--do-sort-index org-index-sort-by)
       (org-table-align)
       (remove-hook 'before-save-hook 'org-index--sort-silent))))
 
 
+(defun org-index--idle-prepare ()
+  "For parsing table when idle."
+  (org-index--verify-id)
+  (org-index--parse-table))
+
+
+(defun org-index-prepare-when-idle ()
+  "Optionally fontify and sort index-table when idle, so that first interactive call is faster.
+You only need this if your index has grown so large, that first invocation of org-index needs 
+a noticable amount of time."
+  (run-with-idle-timer org-index--idle-delay nil 'org-index--idle-prepare))
+
+
 (defun org-index--copy-visible (beg end)
   "Copy the visible parts of the region between BEG and END without adding it to `kill-ring'; copy of `org-copy-visible'."
   (let (snippets s)