summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorU-IHM-NOTEBOOK\Olli <marc@ihm.name>2017-09-04 21:02:31 +0200
committerU-IHM-NOTEBOOK\Olli <marc@ihm.name>2017-09-04 21:02:31 +0200
commitdd490b431bf47edf10424c968ec91ae93ae7f2f2 (patch)
tree6dad251615b48958be2deba4f0bf75226f5ef885
parentb792e281681962679585090be9e35de47c317402 (diff)
downloadorg-mode-dd490b431bf47edf10424c968ec91ae93ae7f2f2.tar.gz
updated org-index to version 5.5
-rw-r--r--contrib/lisp/org-index.el344
1 files changed, 198 insertions, 146 deletions
diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el
index 69eedb4..9fb8809 100644
--- a/contrib/lisp/org-index.el
+++ b/contrib/lisp/org-index.el
@@ -1,9 +1,9 @@
-;;; org-index.el --- A personal adaptive index for org
+;;; org-index.el --- A personal adaptive index for org -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
;; Author: Marc Ihm <org-index@2484.de>
-;; Version: 5.4.1
+;; Version: 5.5.0
;; Keywords: outlines index
;; This file is not part of GNU Emacs.
@@ -85,11 +85,17 @@
;;; Change Log:
-;; [2017-05-27 Sa] Version 5.4.1
+;; [2017-09-03 So] Version 5.5.0
+;; - In occur: case-sensitive search for upcase letters
+;; - Better handling of nested focus nodes
+;; - Bugfixes
+;;
+;; [2017-06-06 Tu] Version 5.4.2
;; - Dedicated submenu for focus operations
;; - Occur accepts a numeric argument as a day span
;; - New customization `org-index-clock-into-focus'
;; - Fixed delay after choosing an index line
+;; - (Re)introduced lexical binding
;; - Bugfixes
;;
;; [2017-03-26 Su] Version 5.3.0
@@ -191,7 +197,7 @@
(require 'widget)
;; Version of this package
-(defvar org-index-version "5.4.1" "Version of `org-index', format is major.minor.bugfix, where \"major\" are incompatible changes and \"minor\" are new features.")
+(defvar org-index-version "5.5.0" "Version of `org-index', format is major.minor.bugfix, where \"major\" are incompatible changes and \"minor\" are new features.")
;; customizable options
(defgroup org-index nil
@@ -307,7 +313,6 @@ those pieces."
:type 'boolean)
;; 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--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.")
@@ -338,6 +343,7 @@ those pieces."
(defvar org-index--occur-lines-collected 0 "Number of lines collected in occur buffer; helpful for tests.")
(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--inhibit-sort-idle nil "If set, index will not be sorted in idle background.")
(defvar org-index--aligned 0 "For this Emacs session: remember number of table lines aligned.")
(defvar org-index--align-interactive most-positive-fixnum "Number of rows to align in ‘org-index--parse-table’.")
(defvar org-index--edit-widgets nil "List of widgets used to edit.")
@@ -351,7 +357,8 @@ those pieces."
(defvar org-index--minibuffer-saved-key nil "Temporarily save entry of minibuffer keymap.")
(defvar org-index--after-focus-timer nil "Timer to clock in or update focused node after a delay.")
(defvar org-index--after-focus-context nil "Context for after focus action.")
-(defvar org-index--set-focus-time nil "Last time-value, when focus has been set.")
+(defvar org-index--this-command nil "Subcommand, that is currently excecuted.")
+(defvar org-index--last-command nil "Subcommand, that hast been excecuted last.")
;; static information for this program package
(defconst org-index--commands '(occur add kill head ping index ref yank column edit help short-help focus example sort find-ref highlight maintain) "List of commands available.")
@@ -368,7 +375,7 @@ those pieces."
The value returned is the value of the last form in BODY or nil,
if VALUE cannot be found."
(declare (indent 2) (debug t))
- (let ((pointvar (make-symbol "point")) ; avoid clash with same-named variables in body
+ (let ((pointvar (make-symbol "point"))
(foundvar (make-symbol "found"))
(retvar (make-symbol "ret")))
`(save-current-buffer
@@ -407,7 +414,7 @@ for its index table.
To start building up your index, use subcommands 'add', 'ref' and
'yank' to create entries and use 'occur' to find them.
-This is version 5.4.1 of org-index.el.
+This is version 5.5.0 of org-index.el.
The function `org-index' is the only interactive function of this
@@ -516,6 +523,7 @@ interactive calls."
kill-new-text ; text that will be appended to kill ring
message-text) ; text that will be issued as an explanation
+
(catch 'new-index
;;
@@ -557,6 +565,8 @@ interactive calls."
;; read command; if requested display help in read-loop
(setq org-index--display-short-help (eq command 'short-help))
(setq command (org-index--read-command))
+ (setq org-index--last-command org-index--this-command)
+ (setq org-index--this-command command)
(if org-index--prefix-arg (setq arg (or arg '(4))))
(setq org-index--display-short-help nil))
@@ -985,11 +995,9 @@ Optional argument KEYS-VALUES specifies content of new line."
ref))
-(defun org-index--read-command (&optional with-short-help)
- "Read subcommand for ‘org-index’ from minibuffer.
-Optional argument WITH-SHORT-HELP displays help screen upfront."
+(defun org-index--read-command ()
+ "Read subcommand for ‘org-index’ from minibuffer."
(let (minibuffer-scroll-window
- minibuffer-setup-fun
command)
(setq org-index--short-help-displayed nil)
(setq org-index--prefix-arg nil)
@@ -1008,7 +1016,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(remove-hook 'minibuffer-setup-hook 'org-index--minibuffer-setup-function)
(remove-hook 'minibuffer-exit-hook 'org-index--minibuffer-exit-function)
(unless (string= command (downcase command))
- (setq command (downcase command))
+ (if command (setq command (downcase command)))
(setq org-index--prefix-arg '(4)))
(setq command (intern command))
(when org-index--short-help-displayed
@@ -1044,11 +1052,9 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(princ (org-index--get-short-help-text)))
(with-current-buffer org-index--short-help-buffer-name
(let ((inhibit-read-only t)
- height-before height-after win)
+ win)
(setq win (get-buffer-window))
- (setq height-before (window-height win))
(shrink-window-if-larger-than-buffer win)
- (setq height-after (window-height win))
(goto-char (point-min))
(end-of-line)
(goto-char (point-min)))))
@@ -1101,51 +1107,51 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(defun org-index--goto-focus ()
"Goto focus node, one after the other."
(if org-index--ids-focused-nodes
- (let (last-id next-id here-id recent marker)
- (setq recent (or (not org-index--set-focus-time)
- (< (- (float-time (current-time))
- (float-time org-index--set-focus-time))
- org-index--after-focus-delay)))
+ (let (this-id target-id following-id last-id again explain marker)
+ (setq again (and (eq this-command last-command)
+ (eq org-index--this-command org-index--last-command)))
(setq last-id (or org-index--id-last-goto-focus
(car (last org-index--ids-focused-nodes))))
- (setq here-id (org-id-get))
- (setq next-id
- (if (and recent
- here-id
- (string= here-id last-id))
- (car (or (cdr-safe (member last-id
- (append org-index--ids-focused-nodes
- org-index--ids-focused-nodes)))
- org-index--ids-focused-nodes))
- last-id))
- (unless (setq marker (org-id-find next-id 'marker))
- (setq org-index--id-last-goto-focus nil)
- (error "Could not find focus-node with id %s" next-id))
-
- (pop-to-buffer-same-window (marker-buffer marker))
- (goto-char (marker-position marker))
- (org-index--unfold-buffer)
- (move-marker marker nil)
- (setq org-index--set-focus-time (current-time))
+ (setq this-id (org-id-get))
+ (setq following-id (car (or (cdr-safe (member last-id
+ (append org-index--ids-focused-nodes
+ org-index--ids-focused-nodes)))
+ org-index--ids-focused-nodes)))
+ (if again
+ (progn
+ (setq target-id following-id)
+ (setq explain "Jumped to next"))
+ (setq target-id last-id)
+ (setq explain "Jumped back to current"))
+
+ (if (member target-id (org-index--ids-up-to-top))
+ (setq explain "Staying below current")
+ (unless (setq marker (org-id-find target-id 'marker))
+ (setq org-index--id-last-goto-focus nil)
+ (error "Could not find focus-node with id %s" target-id))
+
+ (pop-to-buffer-same-window (marker-buffer marker))
+ (goto-char (marker-position marker))
+ (org-index--unfold-buffer)
+ (move-marker marker nil))
+
(when org-index-clock-into-focus
(if org-index--after-focus-timer (cancel-timer org-index--after-focus-timer))
- (setq org-index--after-focus-context
- (cons (point-marker)
- next-id))
+ (setq org-index--after-focus-context target-id)
(setq org-index--after-focus-timer
(run-at-time org-index--after-focus-delay nil
(lambda ()
- (if org-index-clock-into-focus
- (with-current-buffer (marker-buffer (car org-index--after-focus-context))
- (org-with-point-at (marker-position (car org-index--after-focus-context)))
- (org-clock-in)))
- (org-index--update-line (cdr org-index--after-focus-context) t)
- (move-marker (car org-index--after-focus-context) nil)
- (setq org-index--after-focus-context nil)))))
- (setq org-index--id-last-goto-focus next-id)
+ (if org-index--after-focus-context
+ (if org-index-clock-into-focus
+ (save-excursion
+ (org-id-goto org-index--after-focus-context)
+ (org-clock-in)))
+ (org-index--update-line org-index--after-focus-context t)
+ (setq org-index--after-focus-context nil))))))
+ (setq org-index--id-last-goto-focus target-id)
(if (cdr org-index--ids-focused-nodes)
- (format "Jumped %s focus-node (out of %d)"
- (if recent "to next" "back to current")
+ (format "%s focus node (out of %d)"
+ explain
(length org-index--ids-focused-nodes))
"Jumped to single focus-node"))
"No nodes in focus, use set-focus"))
@@ -1153,7 +1159,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(defun org-index--more-focus-commands ()
"More commands for handling focused nodes."
- (let (id text char prompt)
+ (let (id text more-text char prompt ids-up-to-top)
(setq prompt "Please specify action on the list focused nodes: set, append, delete (s,a,d or ? for short help) - ")
(while (not (memq char (list ?s ?a ?d)))
@@ -1167,16 +1173,31 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(setq org-index--ids-focused-nodes (list id))
(setq org-index--id-last-goto-focus id)
(if org-index-clock-into-focus (org-clock-in))
- "Focus has been set on current node (1 node in focus)")
+ "Focus has been set on current node%s (1 node in focus)")
((eq char ?a)
(setq id (org-id-get-create))
(unless (member id org-index--ids-focused-nodes)
+ ;; remove any children, that are already in list of focused nodes
+ (setq org-index--ids-focused-nodes
+ (delete nil (mapcar (lambda (x)
+ (if (member id (org-with-point-at (org-id-find x t)
+ (org-index--ids-up-to-top)))
+ (progn
+ (setq more-text ", removing its children")
+ nil)
+ x))
+ org-index--ids-focused-nodes)))
+ ;; remove parent, if already in list of focused nodes
+ (setq ids-up-to-top (org-index--ids-up-to-top))
+ (when (seq-intersection ids-up-to-top org-index--ids-focused-nodes)
+ (setq org-index--ids-focused-nodes (seq-difference org-index--ids-focused-nodes ids-up-to-top))
+ (setq more-text (concat more-text ", replacing its parent")))
(setq org-index--ids-focused-nodes (cons id org-index--ids-focused-nodes)))
(setq org-index--id-last-goto-focus id)
(setq org-index--id-last-goto-focus id)
(if org-index-clock-into-focus (org-clock-in))
- "Current node has been appended to list of focused nodes (%d node%s in focus)")
+ "Current node has been appended to list of focused nodes%s (%d node%s in focus)")
((eq char ?d)
(setq id (org-id-get))
@@ -1188,13 +1209,36 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
org-index--id-last-goto-focus))
(setq org-index--ids-focused-nodes (delete id org-index--ids-focused-nodes))
(setq org-index--id-last-goto-focus nil)
- "Current node has been removed from list of focused nodes (%d node%s in focus)")
- "Current node has not been in list of focused nodes (%d node%s in focus)"))))
+ "Current node has been removed from list of focused nodes%s (%d node%s in focus)")
+ "Current node has not been in list of focused nodes%s (%d node%s in focus)"))))
(with-current-buffer org-index--buffer
(org-entry-put org-index--point "ids-focused-nodes" (string-join org-index--ids-focused-nodes " ")))
- (format text (length org-index--ids-focused-nodes) (if (cdr org-index--ids-focused-nodes) "s" ""))))
+ (format text (or more-text "") (length org-index--ids-focused-nodes) (if (cdr org-index--ids-focused-nodes) "s" ""))))
+
+
+(defun org-index--ids-up-to-top ()
+ "Get list of all ids from current node up to top level"
+ (when (string= major-mode "org-mode")
+ (let (ancestors id level start-level)
+ (save-excursion
+ (ignore-errors
+ (outline-back-to-heading)
+ (setq id (org-id-get))
+ (if id (setq ancestors (cons id ancestors)))
+ (setq start-level (org-outline-level))
+ (if (<= start-level 1)
+ nil
+ (while (> start-level 1)
+ (setq level start-level)
+ (while (>= level start-level)
+ (outline-previous-heading)
+ (setq level (org-outline-level)))
+ (setq start-level level)
+ (setq id (org-id-get))
+ (if id (setq ancestors (cons id ancestors))))
+ ancestors))))))
(defun org-index--do-edit ()
@@ -1264,6 +1308,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(beginning-of-line)
(forward-char (+ maxlen 2))
(use-local-map buffer-keymap)
+ (setq org-index--inhibit-sort-idle t)
"Editing a single line from index"))
@@ -1324,6 +1369,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
;; clean up
(kill-buffer org-index--edit-buffer-name)
+ (setq org-index--inhibit-sort-idle nil)
(setq org-index--context-index nil)
(setq org-index--edit-widgets nil)
(beginning-of-line)
@@ -1520,9 +1566,7 @@ Argument COLUMN and VALUE specify line to get."
Optional argument NUM-LINES-TO-FORMAT limits formatting effort and duration.
Optional argument CHECK-SORT-MIXED triggers resorting if mixed and stale."
- (let (ref-field
- ref-num
- initial-point
+ (let (initial-point
end-of-headings
start-of-headings)
@@ -1592,11 +1636,10 @@ Optional argument CHECK-SORT-MIXED triggers resorting if mixed and stale."
;; read property or go through table to find maximum number
(goto-char org-index--below-hline)
- (setq ref-field (or (org-entry-get org-index--point "max-ref")
- (org-index--migrate-maxref-to-property)))
+ (setq max-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))
+ (unless org-index--head (org-index--get-decoration-from-ref-field max-ref-field))
;; Get ids of focused node (if any)
(setq org-index--ids-focused-nodes (split-string (or (org-entry-get nil "ids-focused-nodes") "")))
@@ -1634,33 +1677,35 @@ Optional argument CHECK-SORT-MIXED triggers resorting if mixed and stale."
(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-num ref)
+ (let ((max-ref-num 0)
+ ref-field ref-num 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)))
+ (if (> ref-num max-ref-num) (setq max-ref-num ref-num)))
(forward-line))
- (unless org-index--maxrefnum
+ (unless (> max-ref-num 0)
(org-index--report-index-error "No reference found in property max-ref and none in index"))
- (setq ref (org-index--get-save-maxref t))
+ (setq ref-field (format org-index--ref-format max-ref-num))
(org-index--go-below-hline)
+ (org-entry-put org-index--point "max-ref" ref-field)
(message "Done.")
- ref))
+ ref-field))
(defun org-index--get-save-maxref (&optional no-inc)
"Get next reference, increment number and store it in index.
Optional argument NO-INC skips automatic increment on maxref."
- (let (ref)
- (unless no-inc (setq org-index--maxrefnum (1+ org-index--maxrefnum)))
- (setq ref (format org-index--ref-format org-index--maxrefnum))
+ (let (ref-field)
(with-current-buffer org-index--buffer
- (org-entry-put org-index--point "max-ref" ref))
- ref))
+ (setq ref-field (org-entry-get org-index--point "max-ref"))
+ (unless no-inc
+ (setq ref-field (format org-index--ref-format (1+ (org-index--extract-refnum ref-field))))
+ (org-entry-put org-index--point "max-ref" ref-field)))
+ ref-field))
(defun org-index--refresh-parse-table ()
@@ -2444,7 +2489,7 @@ CREATE-REF and TAG-WITH-REF if given."
"Update all lines of index at once."
(let ((lines 0)
- id ref kvs)
+ id kvs)
;; check for double ids
(or
@@ -2456,7 +2501,6 @@ CREATE-REF and TAG-WITH-REF if given."
;; update single line
(when (setq id (org-index--get-or-set-field 'id))
- (setq ref (org-index--get-or-set-field 'ref))
(setq kvs (org-index--collect-values-for-add-update-remote id))
(org-index--write-fields kvs)
(cl-incf lines))
@@ -2484,7 +2528,7 @@ CREATE-REF and TAG-WITH-REF if given."
;; Shift ref and timestamp ?
(if org-index-strip-ref-and-date-from-heading
- (dotimes (i 2)
+ (dotimes (_i 2)
(if (or (string-match (concat "^\\s-*" org-index--ref-regex) content)
(string-match (concat "^\\s-*" org-ts-regexp-both) content))
(setq content (substring content (match-end 0)))))))
@@ -2666,8 +2710,9 @@ Optional argument DEFAULTS gives default values."
"Delete any reference from list of tags."
(let (new-tags)
(mapc (lambda (tag)
- (unless (string-match org-index--ref-regex tag)
- (setq new-tags (cons tag new-tags) )))
+ (unless (or (string-match org-index--ref-regex tag)
+ (string= tag ""))
+ (setq new-tags (cons tag new-tags))))
(org-get-tags))
(org-set-tags-to new-tags)))
@@ -2737,7 +2782,6 @@ If OTHER in separate window."
(prompt "Search for: ")
(these-commands " NOTE: If you invoke the subcommands edit (`e') or kill (`C-c i k') from within this buffer, the index is updated accordingly")
(lines-wanted (window-body-height))
- (lines-found 0) ; number of lines found
words ; list words that should match
occur-buffer
begin ; position of first line
@@ -2746,7 +2790,6 @@ If OTHER in separate window."
done ; true, if loop is done
in-c-backspace ; true, while processing C-backspace
help-overlay ; Overlay with help text
- last-point ; Last position before end of search
initial-frame ; Frame when starting occur
key ; input from user in various forms
key-sequence
@@ -2764,8 +2807,6 @@ If OTHER in separate window."
;; avoid modifying direct buffer
(setq buffer-read-only t)
(toggle-truncate-lines 1)
- (setq font-lock-keywords-case-fold-search t)
- (setq case-fold-search t)
;; reset stack and overlays
(setq org-index--occur-stack nil)
@@ -2802,15 +2843,12 @@ If OTHER in separate window."
;; do not enter loop if number of days is requested
(when days
(goto-char begin)
- (setq lines-found (org-index--hide-with-overlays (cons word words) lines-wanted days))
- (move-overlay org-index--occur-tail-overlay
- (if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack)))
- (point-max))
- (point-max))
+ (org-index--hide-with-overlays (cons word words) lines-wanted days)
+ (move-overlay org-index--occur-tail-overlay (org-index--occur-end-of-visible) (point-max))
(goto-char begin)
(setq done t))
-
+
;; main loop
(while (not done)
@@ -2853,9 +2891,6 @@ If OTHER in separate window."
(setq words (cdr words))
(setq in-c-backspace nil))
- ;; unhighlight longer match
- (unhighlight-regexp (regexp-quote word))
-
;; some chars are left; shorten word
(setq word (substring word 0 -1))
(when (= (length word) 0) ; when nothing left, use next word from list
@@ -2864,16 +2899,11 @@ If OTHER in separate window."
(setq in-c-backspace nil))
;; free top list of overlays and remove list
- (setq lines-found (or (org-index--unhide) lines-wanted))
+ (org-index--unhide)
(move-overlay org-index--occur-tail-overlay
- (if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack)))
- (point-max))
+ (org-index--occur-end-of-visible)
(point-max))
-
- ;; highlight shorter word
- (unless (= (length word) 0)
- (highlight-regexp (regexp-quote word) 'isearch))
-
+
;; make sure, point is still visible
(goto-char begin)))
@@ -2893,26 +2923,18 @@ If OTHER in separate window."
((and (= (length key) 1)
(aref printable-chars (elt key 0))) ; any printable char: add to current search word
- ;; unhighlight short word
- (unless (= (length word) 0)
- (unhighlight-regexp (regexp-quote word)))
-
;; add to word
(setq word (concat word key))
;; make overlays to hide lines, that do not match longer word any more
(goto-char begin)
- (setq lines-found (org-index--hide-with-overlays (cons word words) lines-wanted days))
+ (org-index--hide-with-overlays (cons word words) lines-wanted days)
(move-overlay org-index--occur-tail-overlay
- (if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack)))
- (point-max))
+ (org-index--occur-end-of-visible)
(point-max))
(goto-char begin)
- ;; highlight longer word
- (highlight-regexp (regexp-quote word) 'isearch)
-
;; make sure, point is on a visible line
(line-move -1 t)
(line-move 1 t))
@@ -2925,9 +2947,6 @@ If OTHER in separate window."
(setq unread-command-events (listify-key-sequence key-sequence-raw))
(message key))
- ;; postprocessing
- (setq last-point (point))
-
;; For performance reasons do not show matching lines for rest of table. So no code here.
;; make permanent copy
@@ -2937,6 +2956,8 @@ If OTHER in separate window."
(setq cursor-type t)
(goto-char begin)
+ (let ((inhibit-read-only t))
+ (put-text-property begin (org-table-end) 'face nil))
;; collect all visible lines
(while (and (not (eobp))
@@ -3009,9 +3030,9 @@ If OTHER in separate window."
(overlay-put org-index--occur-help-overlay 'display (car org-index--occur-help-text))
;; highlight words
- (setq case-fold-search t)
- (setq font-lock-keywords-case-fold-search t)
- (mapc (lambda (w) (unless (or (not w) (string= w "")) (highlight-regexp (regexp-quote w) 'isearch)))
+ (mapc (lambda (w) (unless (or (not w) (string= w ""))
+ (let ((case-fold-search (not (string= w (downcase w)))))
+ (highlight-regexp (regexp-quote w) 'isearch))))
(cons word words))
(setq buffer-read-only t)
@@ -3070,6 +3091,13 @@ If OTHER in separate window."
(use-local-map keymap))))
+(defun org-index--occur-end-of-visible ()
+ "End of visible stretch during occur"
+ (if org-index--occur-stack
+ (cdr (assoc :end-of-visible (car org-index--occur-stack)))
+ (point-max)))
+
+
(defun org-index--occur-test-stale (pos)
"Test, if current line in occur buffer has become stale at POS."
(let (here there)
@@ -3123,12 +3151,12 @@ If OTHER in separate window."
(defun org-index--hide-with-overlays (words lines-wanted days)
- "Hide text that is currently visible and does not match WORDS by creating overlays;
+ "Hide lines that are currently visible and do not match WORDS;
leave LINES-WANTED lines visible.
Argument DAYS hides older lines."
(let ((lines-found 0)
(end-of-visible (point))
- overlay overlays start matched)
+ overlay overlays start matched places all-places)
;; main loop
(while (and (not (eobp))
@@ -3143,6 +3171,7 @@ Argument DAYS hides older lines."
;; find stretch of lines, that are currently visible but should be invisible now
(setq matched nil)
+ (setq places nil)
(setq start (point))
(while (and (not (eobp))
(not (and
@@ -3158,10 +3187,12 @@ Argument DAYS hides older lines."
days)
(setq matched t))) ; for its side effect
t))
- (not (and (org-index--test-words words)
+ (not (and (setq places (org-index--test-words words))
(setq matched t))))) ; for its side effect
(forward-line 1))
+ (setq all-places (append places all-places))
+
;; create overlay to hide this stretch
(when (< start (point)) ; avoid creating an empty overlay
(setq overlay (make-overlay start (point)))
@@ -3170,6 +3201,11 @@ Argument DAYS hides older lines."
;; skip and count line, that matched
(when matched
+ (let ((inhibit-read-only t) (lbp (line-beginning-position)))
+ (put-text-property lbp (line-end-position) 'face nil)
+ (while places
+ (put-text-property (caar places) (+ (caar places) (cdar places)) 'face 'isearch)
+ (setq places (cdr places))))
(forward-line 1)
(setq end-of-visible (point))
(cl-incf lines-found)))
@@ -3178,7 +3214,8 @@ Argument DAYS hides older lines."
(setq org-index--occur-stack
(cons (list (cons :overlays overlays)
(cons :end-of-visible end-of-visible)
- (cons :lines lines-found))
+ (cons :lines lines-found)
+ (cons :places all-places))
org-index--occur-stack))
lines-found))
@@ -3186,26 +3223,40 @@ Argument DAYS hides older lines."
(defun org-index--unhide ()
"Unhide text that does has been hidden by `org-index--hide-with-overlays'."
- (when org-index--occur-stack
- ;; delete overlays and make visible again
- (mapc (lambda (y)
- (delete-overlay y))
- (cdr (assoc :overlays (car org-index--occur-stack))))
- ;; remove from stack
- (setq org-index--occur-stack (cdr org-index--occur-stack))
- ;; return number of lines, that are now visible
- (if org-index--occur-stack (cdr (assoc :lines (car org-index--occur-stack))))))
+ (let (places)
+ (when org-index--occur-stack
+ ;; delete overlays and make visible again
+ (mapc (lambda (y)
+ (delete-overlay y))
+ (cdr (assoc :overlays (car org-index--occur-stack))))
+ ;; remove latest highlights
+ (setq places (cdr (assoc :places (car org-index--occur-stack))))
+ (while places
+ (let ((inhibit-read-only t))
+ (put-text-property (caar places) (+ (caar places) (cdar places)) 'face nil))
+ (setq places (cdr places)))
+ ;; remove top of stack
+ (setq org-index--occur-stack (cdr org-index--occur-stack))
+ ;; redo older highlights
+ (setq places (cdr (assoc :places (car org-index--occur-stack))))
+ (while places
+ (let ((inhibit-read-only t))
+ (put-text-property (caar places) (+ (caar places) (cdar places)) 'face 'isearch))
+ (setq places (cdr places))))))
(defun org-index--test-words (words)
"Test current line for match against WORDS."
- (let (line)
- (setq line (downcase (buffer-substring (line-beginning-position) (line-beginning-position 2))))
+ (let ((lbp (line-beginning-position))
+ line dc-line places index)
+ (setq line (buffer-substring lbp (line-beginning-position 2)))
+ (setq dc-line (downcase line))
(catch 'not-found
- (dolist (w words)
- (or (cl-search w line)
- (throw 'not-found nil)))
- t)))
+ (dolist (word words)
+ (if (setq index (cl-search word (if (string= word (downcase word)) dc-line line)))
+ (setq places (cons (cons (+ lbp index) (length word)) places))
+ (throw 'not-found nil)))
+ places)))
(defun org-index--create-new-line ()
@@ -3229,14 +3280,15 @@ Argument DAYS hides older lines."
(defun org-index--sort-silent ()
"Sort index for default column to remove any effects of temporary sorting."
- (save-excursion
- (org-index--verify-id)
- (org-index--parse-table)
- (with-current-buffer org-index--buffer
- (save-excursion
- (goto-char org-index--below-hline)
- (org-index--do-sort-index org-index-sort-by)
- (remove-hook 'before-save-hook 'org-index--sort-silent)))))
+ (unless org-index--inhibit-sort-idle
+ (save-excursion
+ (org-index--verify-id)
+ (org-index--parse-table)
+ (with-current-buffer org-index--buffer
+ (save-excursion
+ (goto-char org-index--below-hline)
+ (org-index--do-sort-index org-index-sort-by)
+ (remove-hook 'before-save-hook 'org-index--sort-silent))))))
(defun org-index--idle-prepare ()