org-index.el with new command 'focus'

This commit is contained in:
U-IHM-NOTEBOOK\Olli 2017-01-22 21:14:58 +01:00
parent 4696d6e71d
commit 5210de7f16
1 changed files with 154 additions and 114 deletions

View File

@ -3,7 +3,7 @@
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
;; Author: Marc Ihm <org-index@2484.de>
;; Version: 5.1.3
;; Version: 5.2.0
;; Keywords: outlines index
;; This file is not part of GNU Emacs.
@ -86,11 +86,18 @@
;;; Change Log:
;; [2017-01-22 Su] Version 5.2.0
;; - New command 'focus'
;; - Fixed compatibility issue with emacs 24 (font-lock-ensure)
;;
;; [2016-10-19 We] Version 5.1.4
;; - Bugfixes
;;
;; [2016-08-26 Fr] Version 5.1.3
;; - Offering help during query for subcommands
;; - Removed org-index-default-keybindings
;; - Renamed subcommand multi-occur to find-ref
;; - Subcommands add and need no longer be invoked from heading
;; - Subcommands add needs no longer be invoked from heading
;; - Many Bugfixes
;;
;; [2015-12-29 Tu] Version 5.0.2
@ -168,7 +175,7 @@
(require 'widget)
;; Version of this package
(defvar org-index-version "5.1.3" "Version of `org-index', format is major.minor.bugfix, where \"major\" are incompatible changes and \"minor\" are new features.")
(defvar org-index-version "5.2.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
@ -244,7 +251,7 @@ those pieces."
(const category)
(const keywords))))
(defcustom org-index-edit-on-yank '(yank keywords)
(defcustom org-index-edit-on-yank '(keywords yank)
"List of columns to edit when adding new text to yank."
:group 'org-index
:type '(repeat (choice
@ -274,6 +281,7 @@ those pieces."
(defvar org-index--saved-positions nil "Saved positions within current buffer and index buffer; filled by org-index--save-positions.")
(defvar org-index--headings nil "Headlines of index-table as a string.")
(defvar org-index--headings-visible nil "Visible part of headlines of index-table as a string.")
(defvar org-index--id-focused-node nil "Id of focused node (if any)")
;; Variables to hold context and state
(defvar org-index--last-fingerprint nil "Fingerprint of last line created.")
@ -301,7 +309,7 @@ those pieces."
(defvar org-index--minibuffer-saved-key nil "Temporarily save entry of minibuffer keymap.")
;; static information for this program package
(defconst org-index--commands '(occur add kill head ping index ref yank column edit help short-help example sort find-ref highlight maintain) "List of commands available.")
(defconst org-index--commands '(occur add kill head ping index ref yank column edit help short-help focus set-focus example sort find-ref highlight maintain) "List of commands available.")
(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.")
@ -328,9 +336,9 @@ if VALUE cannot be found."
(setq ,foundvar (org-index--go ,column ,value))
(when ,foundvar
(setq ,retvar (progn ,@body)))
(goto-char ,pointvar)
,retvar))))
@ -354,7 +362,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.1.3 of org-index.el.
This is version 5.2.0 of org-index.el.
The function `org-index' is the only interactive function of this
@ -378,7 +386,7 @@ of subcommands to choose from:
head: [h] Search for heading, by ref or from index line.
If invoked from within index table, go to associated
node (if any), otherwise ask for ref to search.
index: [i] Enter index table and maybe go to a specific reference.
Use `org-mark-ring-goto' (\\[org-mark-ring-goto]) to go back.
@ -400,6 +408,13 @@ 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.
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
frequent excursions to others.
short-help: [?] Show one-line description of each subcommand.
I.e. show this list but only first sentence each.
@ -483,7 +498,7 @@ interactive calls."
(unless (memq command org-index--commands)
(error "Unknown command '%s' passed as argument, valid choices are any of these symbols: %s"
command (mapconcat 'symbol-name org-index--commands ",")))
;; 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))
@ -498,7 +513,7 @@ interactive calls."
(if (and (not search-ref)
(numberp arg))
(setq search-ref (format "%s%d%s" org-index--head arg org-index--tail)))
;; These actions really need a search string and may even prompt for it
(when (memq command '(index head find-ref))
@ -508,12 +523,12 @@ interactive calls."
(if (org-at-table-p)
(setq search-ref (org-index--get-or-set-field 'ref)))
(if (and org-index--below-cursor
(string-match (concat "\\(" org-index--ref-regex "\\)")
org-index--below-cursor))
(setq search-ref (match-string 1 org-index--below-cursor)))))
;; If we still do not have a search string, ask user explicitly
(unless search-ref
(if (eq command 'index)
@ -540,15 +555,15 @@ interactive calls."
(org-at-table-p))))
(error "Command %s needs a reference number" command)))
;;
;; Command sort needs to know in advance, what to sort for
;;
(when (eq command 'sort)
(setq sort-what (intern (org-completing-read "You may sort:\n - index : your index table by various columns\n - region : the active region by contained reference\n - buffer : the whole current buffer\nPlease choose what to sort: " (list "index" "region" "buffer") nil t))))
;;
;; Enter table
;;
@ -573,18 +588,18 @@ interactive calls."
;;
(cond
((eq command 'help)
;; bring up help-buffer for this function
(describe-function 'org-index))
((eq command 'short-help)
(org-index--display-short-help))
((eq command 'find-ref)
;; Construct list of all org-buffers
@ -623,10 +638,10 @@ interactive calls."
(if (and org-index--within-index-node
(org-at-table-p))
(setq search-id (org-index--get-or-set-field 'id)))
(if (and (not search-id) search-ref)
(setq search-id (org-index--id-from-ref search-ref)))
(setq message-text
(if search-id
(org-index--find-id search-id)
@ -697,7 +712,7 @@ interactive calls."
(cl-incf moved-up))
(setq id (org-id-get))))
(if info
(progn
(setq message-text
@ -721,7 +736,6 @@ interactive calls."
(let (args)
(setq args (org-index--collect-values-from-user org-index-edit-on-ref))
(setq args (plist-put args 'category "yank"))
(setq args (plist-put args 'ref org-index--nextref))
(apply 'org-index--do-new-line args)
@ -739,7 +753,7 @@ interactive calls."
(plist-put args 'yank (replace-regexp-in-string "|" "\\vert" (plist-get args 'yank) nil 'literal)))
(setq args (plist-put args 'category "yank"))
(apply 'org-index--do-new-line args)
(setq message-text "Added new row with text to yank")))
@ -757,15 +771,15 @@ interactive calls."
(progn
(org-table-goto-column num)
(setq message-text (format "At column %s" (symbol-name col))))
(error (format "Column '%s' is not present" col))))
(error "Need to be in index table to go to a specific column")))
((eq command 'edit)
(setq message-text (org-index--do-edit)))
((eq command 'sort)
@ -786,7 +800,7 @@ interactive calls."
;; When saving index, it should again be sorted correctly
(with-current-buffer org-index--buffer
(add-hook 'before-save-hook 'org-index--sort-silent t))
(setq message-text
(format
(concat "Your index has been sorted temporarily by %s and will be sorted again by %s after %d seconds of idle time"
@ -823,10 +837,32 @@ interactive calls."
(setq message-text (format "Highlighted references in %s" where)))))))
((eq command 'focus)
(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"))
(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")))
((eq command 'set-focus)
(let ((focus-id (org-id-get-create)))
(with-current-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"))))
((eq command 'maintain)
(setq message-text (org-index--do-maintain)))
((eq command 'example)
(if (y-or-n-p "This assistant will help you to create a temporary index with detailed comments.\nDo you want to proceed ? ")
@ -835,7 +871,7 @@ interactive calls."
((not command) (setq message-text "No command given"))
(t (error "Unknown subcommand '%s'" command)))
@ -957,12 +993,12 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(setq height-after (window-height win))
(goto-char (point-min))
(end-of-line)
(insert
(insert
(if (> height-before height-after)
"."
(concat ", "
(substitute-command-keys "\\[scroll-other-window]")
" to scroll:")))
" to scroll:")))
(goto-char (point-min)))))
@ -988,7 +1024,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)) (1+ (length org-index--commands)))
(unless (= (line-number-at-pos (point-max)) (length org-index--commands))
(error "Internal error, unable to properly extract one-line descriptions of subcommands"))
(setq org-index--short-help-text (buffer-string)))))
@ -1016,7 +1052,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(setq org-index--context-node nil)
(setq org-index--context-occur nil)
;; change to index, if whithin occur
(if org-index--within-occur
(let ((pos (get-text-property (point) 'org-index-lbp)))
@ -1024,7 +1060,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(setq org-index--context-occur (cons (point) (org-index--line-in-canonical-form)))
(set-buffer org-index--buffer)
(goto-char pos))
;; change to index, if still not within
(if (not org-index--within-index-node)
(let ((id (org-id-get)))
@ -1033,7 +1069,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(unless (and id (org-index--go 'id id))
(setq org-index--context-node nil)
(error "This node is not in index")))))
;; retrieve current content of index line
(dolist (col (mapcar 'car (reverse org-index--columns)))
(if (> (length (symbol-name col)) maxlen)
@ -1048,7 +1084,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(set-keymap-parent buffer-keymap widget-keymap)
(define-key buffer-keymap (kbd "C-c C-c") 'org-index--edit-c-c-c-c)
(define-key buffer-keymap (kbd "C-c C-k") 'org-index--edit-c-c-c-k)
(setq field-keymap (make-sparse-keymap))
(set-keymap-parent field-keymap widget-field-keymap)
(define-key field-keymap (kbd "C-c C-c") 'org-index--edit-c-c-c-c)
@ -1078,7 +1114,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(forward-char (+ maxlen 2))
(use-local-map buffer-keymap)
"Editing a single line from index"))
(defun org-index--edit-c-c-c-c ()
"Function to invoked on C-c C-c in Edit buffer."
@ -1086,12 +1122,12 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(let ((obuf (get-buffer org-index--occur-buffer-name))
val line)
;; Time might have passed
(org-index--refresh-parse-table)
(with-current-buffer org-index--buffer
;; check, if buffer has become stale
(save-excursion
(goto-char (car org-index--context-index))
@ -1125,7 +1161,7 @@ Optional argument WITH-SHORT-HELP displays help screen upfront."
(delete-region (line-beginning-position) (line-end-position))
(insert line)
(put-text-property (line-beginning-position) (line-end-position)
'org-index-lbp (cdr org-index--context-index))))
'org-index-lbp (car org-index--context-index))))
(error "Occur buffer and index buffer do not match any longer"))
(message "Occur buffer has gone, cannot switch back."))
(setq org-index--context-occur nil))
@ -1194,7 +1230,7 @@ Optional argument KEYS-VALUES specifies content of new line."
;; remember fingerprint to be able to return
(setq org-index--last-fingerprint (org-index--get-or-set-field 'fingerprint))
;; get column to yank
(setq yank (org-index--get-or-set-field org-index-yank-after-add))
@ -1217,12 +1253,12 @@ retrieves the value of the count-column for reference number 12.
Argument COLUMN is a symbol, either ref or id,
argument VALUE specifies the value to search for."
;; check arguments
(unless (memq column '(ref id))
(error "Argument column can only be 'ref' or 'id'"))
(unless (memq column '(ref id keywords 'yank))
(error "Argument column can only be 'ref', 'id', 'keywords' or 'yank'"))
(unless value
(error "Need a value to search for"))
(org-index--verify-id)
(org-index--parse-table)
@ -1265,22 +1301,22 @@ Argument COLUMN and VALUE specify line to get."
;; Accept single char commands or switch to reading a sequence of digits
(let (char prompt search-ref search-id search-fingerprint)
;; start with short prompt but give more help on next iteration
(setq prompt "Please specify, where to go in index (0-9,.,space,backspace,return or ? for short help) - ")
;; read one character
(while (not (memq char (append (number-sequence ?0 ?9) (list ?\d ?\b ?\r ?\j ?\s ?.))))
(setq char (read-char prompt))
(setq prompt "Go to specific position in index table. Digits specify a reference number, <space> goes to top of index, <backspace> or <delete> to last line created and <return> or `.' to index line of current node. Please choose - "))
(if (memq char (number-sequence ?0 ?9))
;; read rest of digits
(setq search-ref (read-from-minibuffer "Search reference number: " (char-to-string char))))
;; decode single chars
(if (memq char '(?\r ?\n ?.)) (setq search-id (org-id-get)))
(if (memq char '(?\d ?\b)) (setq search-fingerprint org-index--last-fingerprint))
(list search-ref search-id search-fingerprint)))
@ -1388,6 +1424,9 @@ Argument COLUMN and VALUE specify line to get."
(not (setq ref-field (org-index--get-or-set-field 'ref))))
(forward-line))
;; 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"))
@ -1411,7 +1450,7 @@ Argument COLUMN and VALUE specify line to get."
(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))
@ -1451,7 +1490,7 @@ Argument COLUMN and VALUE specify line to get."
(let ((check-what) (max-mini-window-height 1.0) message-text)
(setq check-what (intern (org-completing-read "These checks and fixes are available:\n - statistics : compute statistics about index table\n - check : check ids by visiting their nodes\n - duplicates : check index for duplicate rows (ref or id)\n - clean : remove obsolete property org-index-id\n - update : update content of index lines, with an id \nPlease choose: " (list "statistics" "check" "duplicates" "clean" "update") nil t nil nil "statistics")))
(message nil)
(cond
((eq check-what 'check)
(setq message-text (or (org-index--check-ids)
@ -1472,7 +1511,7 @@ Argument COLUMN and VALUE specify line to get."
(org-entry-delete (point) "org-index-ref")))
nil 'agenda)
(setq message-text (format "Removed property 'org-index-ref' from %d lines" lines))))
((eq check-what 'update)
(if (y-or-n-p "Updating your index will overwrite certain columns with content from the associated heading and category. If unsure, you may try this for a single, already existing line of your index by invoking `add'. Are you SURE to proceed for ALL INDEX LINES ? ")
(setq message-text (org-index--update-all-lines))
@ -1523,7 +1562,7 @@ Argument COLUMN and VALUE specify line to get."
(org-table-kill-row))
(forward-line 1)
(setq bottom (point))
;; sort lines
(save-restriction
(narrow-to-region top bottom)
@ -1701,7 +1740,7 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin
(setq title (read-from-minibuffer "Please enter the title of the index node (leave empty for default 'index'): "))
(if (string= title "") (setq title "index"))
(while (progn
(setq firstref (read-from-minibuffer "Please enter your first reference-number. This is an integer number preceeded by some and optionally followed by some non-numeric chars; e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose (leave empty for default 'R1'): "))
(if (string= firstref "") (setq firstref "R1"))
@ -2067,7 +2106,7 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin
(mapc (lambda (x) (if (and (> (cdr x) 1)
(car x))
(setq duplicates (cons (car x) duplicates)))) counts)
duplicates))
@ -2119,7 +2158,7 @@ CREATE-REF and TAG-WITH-REF if given."
(unless (or org-index--within-index-node
org-index--within-occur)
(org-back-to-heading))
;; try to do the same things from within index and from outside
(if org-index--within-index-node
@ -2152,7 +2191,7 @@ CREATE-REF and TAG-WITH-REF if given."
(setq ref org-index--nextref)
(setq args (plist-put args 'ref ref)))
(if id-from-index
;; already have an id in index, find it and update fields
(progn
@ -2179,7 +2218,7 @@ CREATE-REF and TAG-WITH-REF if given."
(cons
"Added new index line"
nil)))))
(org-index--restore-positions)
ret))
@ -2187,42 +2226,42 @@ CREATE-REF and TAG-WITH-REF if given."
(defun org-index--check-ids ()
"Check, that ids really point to a node."
(let ((lines 0)
id ids marker)
(goto-char org-index--below-hline)
(catch 'problem
(while (org-at-table-p)
(when (setq id (org-index--get-or-set-field 'id))
;; check for double ids
(when (member id ids)
(org-table-goto-column (org-index--column-num 'id))
(throw 'problem "This id appears twice in index; please use command 'maintain' to check for duplicate ids"))
(cl-incf lines)
(setq ids (cons id ids))
;; check, if id is valid
(setq marker (org-id-find id t))
(unless marker
(org-table-goto-column (org-index--column-num 'id))
(throw 'problem "This id cannot be found")))
(forward-line))
(goto-char org-index--below-hline)
nil)))
(defun org-index--update-all-lines ()
"Update all lines of index at once."
(let ((lines 0)
id ref kvs)
;; check for double ids
(or
(org-index--check-ids)
@ -2230,7 +2269,7 @@ CREATE-REF and TAG-WITH-REF if given."
(progn
(goto-char org-index--below-hline)
(while (org-at-table-p)
;; update single line
(when (setq id (org-index--get-or-set-field 'id))
(setq ref (org-index--get-or-set-field 'ref))
@ -2246,35 +2285,35 @@ CREATE-REF and TAG-WITH-REF if given."
(defun org-index--collect-values-for-add-update (id &optional silent category)
"Collect values for adding or updating line specified by ID, do not ask if SILENT, use CATEGORY, if given."
(let ((args (list 'id id))
content)
(dolist (col (mapcar 'car org-index--columns))
(setq content "")
(cond
((eq col 'keywords)
(if org-index-copy-heading-to-keywords
(setq content (nth 4 (org-heading-components))))
;; Shift ref and timestamp ?
(if org-index-strip-ref-and-date-from-heading
(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)))))))
((eq col 'category)
(setq content (or category org-index--category-before)))
((eq col 'level)
(setq content (number-to-string (org-outline-level))))
((eq col 'tags)
(setq content (org-get-tags-string))))
(unless (string= content "")
(setq args (plist-put args col content))))
@ -2287,7 +2326,7 @@ CREATE-REF and TAG-WITH-REF if given."
(defun org-index--collect-values-for-add-update-remote (id)
"Wrap `org-index--collect-values-for-add-update' by prior moving to remote node identified by ID."
(let (marker point args)
(setq marker (org-id-find id t))
@ -2302,20 +2341,20 @@ CREATE-REF and TAG-WITH-REF if given."
(defun org-index--collect-values-from-user (cols &optional defaults)
"Collect values for adding a new yank-line.
"Collect values for adding a new line.
Argument COLS gives list of columns to edit.
Optional argument DEFAULTS gives default values."
(let (content args)
(dolist (col cols)
(setq content "")
(setq content (read-from-minibuffer
(format "Enter text for column '%s': " (symbol-name col))
(plist-get col defaults)))
(unless (string= content "")
(setq args (plist-put args col content))))
args))
@ -2337,7 +2376,7 @@ Optional argument DEFAULTS gives default values."
(unless (or org-index--within-index-node
org-index--within-occur)
(org-back-to-heading))
;; Collect information: What should be deleted ?
(if (or org-index--within-occur
org-index--within-index-node)
@ -2362,7 +2401,7 @@ Optional argument DEFAULTS gives default values."
(unless pos-in-index (error "This node is not in index")))
;; Remark: Current buffer is not certain here, but we have all the information to delete
;; Delete from node
(when id
(let ((m (org-id-find id 'marker)))
@ -2382,7 +2421,7 @@ Optional argument DEFAULTS gives default values."
(goto-char pos-in-index)
(setq chars-deleted-index (length (delete-and-extract-region (line-beginning-position) (line-beginning-position 2))))
(setq text-deleted-from (cons "index" text-deleted-from))
;; Delete from occur only if we started there, accept that it will be stale otherwise
(if org-index--within-occur
(let ((inhibit-read-only t))
@ -2478,7 +2517,7 @@ Return t or nil, leave point on line or at top of table, needs to be in buffer i
(defun org-index--find-id (id &optional other)
"Perform command head: Find node with REF or ID and present it.
If OTHER in separate window."
(let (message marker)
(setq marker (org-id-find id t))
@ -2490,7 +2529,7 @@ If OTHER in separate window."
(progn
(pop-to-buffer (marker-buffer marker)))
(pop-to-buffer-same-window (marker-buffer marker)))
(goto-char marker)
(org-reveal t)
(org-show-entry)
@ -2524,7 +2563,7 @@ If OTHER in separate window."
key-sequence
key-sequence-raw)
;; make and show buffer
(if (get-buffer org-index--occur-buffer-name)
(kill-buffer org-index--occur-buffer-name))
@ -2541,7 +2580,7 @@ If OTHER in separate window."
;; reset stack and overlays
(setq org-index--occur-stack nil)
(setq org-index--occur-tail-overlay nil)
;; narrow to table rows and one line before
(goto-char org-index--below-hline)
(forward-line 0)
@ -2566,7 +2605,7 @@ If OTHER in separate window."
"Normal keys add to search word; <space> or <comma> start additional word; <backspace> erases last char, <C-backspace> last word; <return> jumps to heading, <tab> jumps to heading in other window, <S-return> jumps to matching line in index; all other keys end search." these-commands "\n"))
'face 'org-agenda-dimmed-todo-face)
org-index--headings)))
;; insert overlays for help text and to cover unsearched lines
(setq help-overlay (make-overlay (point-min) begin))
(overlay-put help-overlay 'display (car help-text))
@ -2596,7 +2635,7 @@ If OTHER in separate window."
(setq key-sequence nil)
(setq key nil)
(setq key-sequence-raw nil)))
(cond
@ -2628,11 +2667,11 @@ If OTHER in separate window."
;; free top list of overlays and remove list
(setq lines-found (or (org-index--unhide) lines-wanted))
(move-overlay org-index--occur-tail-overlay
(if org-index--occur-stack (cdr (assq :end-of-visible (car org-index--occur-stack)))
(if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack)))
(point-max))
(point-max))
;; highlight shorter word
(unless (= (length word) 0)
(highlight-regexp (regexp-quote word) 'isearch))
@ -2662,17 +2701,17 @@ If OTHER in separate window."
;; 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))
(move-overlay org-index--occur-tail-overlay
(if org-index--occur-stack (cdr (assq :end-of-visible (car org-index--occur-stack)))
(if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack)))
(point-max))
(point-max))
(goto-char begin)
;; highlight longer word
(highlight-regexp (regexp-quote word) 'isearch)
@ -2687,12 +2726,12 @@ If OTHER in separate window."
(unless (string= key "C-g")
(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
;; copy visible lines
(let ((lines-collected 0)
@ -2717,7 +2756,7 @@ If OTHER in separate window."
all-lines))
(setq all-lines-lbp (cons lbp all-lines-lbp)))
(forward-line 1))
(kill-buffer org-index--occur-buffer-name) ; cannot keep this buffer; might become stale soon
;; create new buffer
@ -2732,12 +2771,13 @@ If OTHER in separate window."
(if (= lines-collected lines-wanted)
(insert "\n(more lines omitted)\n")))
(setq org-index--occur-lines-collected lines-collected)
(org-mode)
(setq truncate-lines t)
(if all-lines (org-index--align-and-fontify-current-line (length all-lines)))
(font-lock-ensure)
(font-lock-flush)
(when (fboundp 'font-lock-ensure)
(font-lock-ensure)
(font-lock-flush))
(when all-lines-lbp
(while (not (org-at-table-p))
(forward-line -1))
@ -2767,7 +2807,7 @@ If OTHER in separate window."
(length all-lines))
'face 'org-agenda-dimmed-todo-face))
org-index--headings)))
(overlay-put org-index--occur-help-overlay 'display (car org-index--occur-help-text))
;; highlight words
@ -2790,7 +2830,7 @@ If OTHER in separate window."
(define-key keymap (kbd "<tab>")
(lambda () (interactive)
(message (org-index--occur-action t))))
(define-key keymap (kbd "SPC")
(lambda () (interactive)
(org-index--refresh-parse-table)
@ -2807,7 +2847,7 @@ If OTHER in separate window."
(let ((inhibit-read-only t))
(org-index--get-or-set-field 'count (number-to-string count)))
(message "Incremented count to %d" count))))
(define-key keymap (kbd "<S-return>")
(lambda () (interactive)
(let ((pos (get-text-property (point) 'org-index-lbp)))
@ -2824,7 +2864,7 @@ If OTHER in separate window."
(org-index--refresh-parse-table)
(setq-local org-index--occur-help-text (cons (cdr org-index--occur-help-text) (car org-index--occur-help-text)))
(overlay-put org-index--occur-help-overlay 'display (car org-index--occur-help-text))))
(use-local-map keymap))))
@ -2916,7 +2956,7 @@ If OTHER in separate window."
(forward-line 1)
(setq end-of-visible (point))
(cl-incf lines-found)))
;; put new list on top of stack
(setq org-index--occur-stack
(cons (list (cons :overlays overlays)
@ -2933,11 +2973,11 @@ If OTHER in separate window."
;; delete overlays and make visible again
(mapc (lambda (y)
(delete-overlay y))
(cdr (assq :overlays (car org-index--occur-stack))))
(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 (assq :lines (car org-index--occur-stack))))))
(if org-index--occur-stack (cdr (assoc :lines (car org-index--occur-stack))))))
(defun org-index--test-words (words)