mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

version 5.2.1 of org-index with speed improvements

This commit is contained in:
U-IHM-NOTEBOOK\Olli 2017-01-30 18:42:46 +01:00
parent 401eecb52c
commit def8a848ba
1 changed files with 136 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

226
contrib/lisp/org-index.el
View File

@ -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,80 +1410,103 @@ 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"))
;; 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)))))
(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
(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)
(setq ref-field (org-index--get-or-set-field 'ref))
(setq id-field (org-index--get-or-set-field 'id))
(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))
(forward-line 1)))
(setq org-index--nextref (format "%s%d%s" org-index--head (1+ org-index--maxrefnum) org-index--tail))
;; save position below hline
(org-index--go-below-hline)
;; go back to initial position
(goto-char initial-point))))
(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))
;; 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)))
(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)))
(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 ()
"Fast refresh of selected results of parsing index 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)