1 ;;; org-index.el --- A personal index for org and beyond
3 ;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
5 ;; Author: Marc Ihm <org-index@2484.de>
7 ;; Keywords: outlines index
9 ;; This file is not part of GNU Emacs.
13 ;; This program is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 3, or (at your option)
18 ;; This program is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
30 ;; Help to navigate org. Mark and find your favorite org-headings easily:
31 ;; Create and update an index table of references and links. This table is
32 ;; sorted by usage count, so that the builtin incremental occur presents
33 ;; often used entries first.
35 ;; References are essentially small numbers (e.g. "R237" or "-455-"), as
36 ;; created by this package; they are well suited to be used outside of
37 ;; org (e.g. within folder names). Links are normal org-mode links.
42 ;; - Add these lines to your .emacs (modify appropriately):
44 ;; (require 'org-index)
45 ;; (org-index-default-keybindings) ; optional
47 ;; - Restart your Emacs to make these lines effective.
49 ;; - Invoke `org-index', which will assist in creating your index
50 ;; table. The variable org-index-id will be persisted within your
51 ;; customization file (typically .emacs).
56 ;; See the documentation of `org-index', which can also be read
57 ;; by invoking `org-index' and choosing the help-command.
62 ;; The latest tested version of this file can always be found at:
64 ;; http://orgmode.org/w/org-mode.git?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD
68 ;; [2015-01-20 Mo] Version 3.1.1:
69 ;; - Bugfix for delete within occur
71 ;; [2015-01-19 Mo] Version 3.1.0:
72 ;; - Rewrote command "occur" with overlays in an indirect buffer
73 ;; - Removed function `org-index-copy-references-from-heading-to-property'
74 ;; - introduced variable org-index-version
76 ;; [2014-12-14 Su] Version 3.0.2:
77 ;; - Bugfixes in occur mode
78 ;; - New function `org-index-copy-references-from-heading-to-property'
80 ;; [2014-12-10 We] Version 3.0.1:
81 ;; - Bugfixes related with assistant
82 ;; - Fix for editing of category
84 ;; [2014-12-07 Sa] Version 3.0.0:
85 ;; - New commands "add" and "delete" to easily add and remove
86 ;; the current node to or from your index.
87 ;; - New command "example" to create an example index.
88 ;; - Moved flags to a list within the same node as the index table;
89 ;; this breaks compatibility to prior versions of the package.
90 ;; - Several new flags that are explained within index node.
91 ;; - Removed commands "reuse", "missing", "put", "goto",
92 ;; "update", "link", "fill", "unhighlight"
93 ;; - New function `org-index-default-keybindings'
95 ;; [2014-04-26 Sa] Version 2.4.3:
96 ;; - Some Bug fixes and enhancements for occur-command
97 ;; - Fixes for assistant to create index table
99 ;; [2014-02-01 Sa] Version 2.4.2:
100 ;; - Follow mode in occur-buffer
101 ;; - Reorder for x-columns
103 ;; [2014-01-02 Th] Version 2.4.0:
104 ;; - New command "put" to store a nodes reference in a property
105 ;; - New functions org-index-new-line and org-index-get-line
106 ;; offer access to org-index from other lisp programs
107 ;; - New flag p, new columns x1,x2 and x3
108 ;; - Major Code refactoring
109 ;; - Regression tests with ert
110 ;; - Lots of bug fixes
112 ;; [2013-10-04 Fr] Version 2.3.2:
113 ;; - Bug fix: index-table created by assistant is found after
114 ;; restart of emacs instead of invoking assistant again
116 ;; [2013-07-20 Sa] Version 2.3.0:
117 ;; - Renamed from "org-favtable" to "org-index"
118 ;; - Added an assistant to set up the index table
119 ;; - occur is now incremental, searching as you type
120 ;; - simplified the documentation and help-system
121 ;; - Saving keystrokes, as "+g237" is now valid input
124 ;; [2013-02-28 Th] Version 2.2.0:
125 ;; - Allowed shortcuts like "h237" for command "head" with argument "237"
126 ;; - Integrated with org-mark-ring-goto
128 ;; [2013-01-25 Fr] Version 2.1.0:
129 ;; - Added full support for links
130 ;; - New commands "statistics"
131 ;; - Renamed the package from "org-reftable" to "org-favtable"
132 ;; - Additional columns are required (e.g. "link"). Error messages will
135 ;; [2012-12-07 Fr] Version 2.0.0:
136 ;; - The format of the table of favorites has changed ! You need to bring
137 ;; your existing table into the new format by hand (which however is
138 ;; easy and explained below)
139 ;; - Reference table can be sorted after usage count or date of last access
140 ;; - Ask user explicitly, which command to invoke
141 ;; - Renamed the package from "org-refer-by-number" to "org-reftable"
143 ;; [2012-09-22 Sa] Version 1.5.0:
144 ;; - New command "sort" to sort a buffer or region by reference number
145 ;; - New commands "highlight" and "unhighlight" to mark references
147 ;; [2012-07-13 Fr] Version 1.4.0:
148 ;; - New command "head" to find a headline with a reference number
150 ;; [2012-04-28 Sa] Version 1.3.0:
151 ;; - New commands occur and multi-occur
152 ;; - All commands can now be invoked explicitly
153 ;; - New documentation
156 ;; [2011-12-10 Sa] Version 1.2.0:
157 ;; - Fixed a bug, which lead to a loss of newly created reference numbers
158 ;; - Introduced single and double prefix arguments
159 ;; - Started this Change Log
166 (defcustom org-index-id nil
167 "Id of the Org-mode node, which contains the index table."
171 ;; Version of this package
172 (defvar org-index-version
"3.1.1" "Version of `org-index', format is major.minor.bugfix, where \"major\" is a change in index-table and \"minor\" are new features.")
174 ;; Variables to hold the configuration of the index table
175 (defvar org-index--maxref nil
"Maximum number from reference table (e.g. \"153\").")
176 (defvar org-index--head nil
"Any header before number (e.g. \"R\").")
177 (defvar org-index--tail nil
"Tail after number (e.g. \"}\" or \")\".")
178 (defvar org-index--numcols nil
"Number of columns in index table.")
179 (defvar org-index--ref-regex nil
"Regular expression to match a reference.")
180 (defvar org-index--ref-format nil
"Format, that can print a reference.")
181 (defvar org-index--columns nil
"Columns of index-table.")
182 (defvar org-index--special-columns nil
"Columns with flags, that may appear only once.")
183 (defvar org-index--flagged-columns nil
"Columns with flags, that may appear multiple times.")
184 (defvar org-index--buffer nil
"Buffer of index table.")
185 (defvar org-index--point nil
"Position at start of headline of index table.")
186 (defvar org-index--below-hline nil
"Position of first cell in first line below hline.")
187 (defvar org-index--headings nil
"Headlines of index-table as a string.")
188 (defvar org-index-map nil
"Keymap for shortcuts for some commands of `org-index'. Can be activated and filled by org-index-default-keybings.")
190 ;; Variables to hold context and state
191 (defvar org-index--last-action nil
"Last action performed by `org-index'.")
192 (defvar org-index--text-to-yank nil
"Text, that can be yanked after call (mostly a reference).")
193 (defvar org-index--last-ref nil
"Last reference created or visited.")
194 (defvar org-index--point-before nil
"Point in buffer with index table.")
195 (defvar org-index--point-saved nil
"Saved point if we want to return.")
196 (defvar org-index--category-before nil
"Category of node before.")
197 (defvar org-index--silent nil
"Set to t, if user should not be queried.")
198 (defvar org-index--active-region nil
"Active region, initially. I.e. what has been marked.")
199 (defvar org-index--below-cursor nil
"Word below cursor.")
200 (defvar org-index--within-node nil
"True, if we are within node of the index table.")
201 (defvar org-index--active-window-index nil
"Active window with index table (if any).")
202 (defvar org-index--message-text nil
"Text that was issued as an explanation; helpful for regression tests.")
203 (defvar org-index--occur-help-text nil
"Text for help in occur buffer.")
204 (defvar org-index--occur-help-overlay nil
"Overlay for help in occur buffer.")
205 (defvar org-index--occur-stack nil
"Stack with overlays for hiding lines.")
206 (defvar org-index--occur-tail-overlay nil
"Overlay to cover invisible lines.")
208 ;; static information for this program package
209 (defconst org-index--commands
'(occur add delete head enter leave ref help example reorder sort multi-occur highlight statistics
) "List of commands available.")
210 (defconst org-index--required-flags
'(sort) "Flags that are required.")
211 (defconst org-index--single-flags
'(sort point-on-add yank-after-add
) "Flags, that may only appear once; these can appear as special-columns.")
212 (defconst org-index--multiple-flags
'(edit-on-add get-category-on-add get-heading-on-add
) "Flags, that might appear multiple times.")
213 (defconst org-index--all-flags
(append org-index--single-flags org-index--multiple-flags
) "All flags.")
214 (defconst org-index--valid-headings
'(ref link created last-accessed count keywords
) "All valid headings.")
215 (defconst org-index--required-headings org-index--valid-headings
"All required headings.")
216 (defconst org-index--occur-buffer-name
"*org-index-occur*" "Name of occur buffer.")
217 (defconst org-index--sample-flags
219 - columns-and-flags :: associate columns of index table with flags
223 - get-category-on-add
234 - all-columns-explained :: All columns of the index table and their meaning
235 - ref :: The reference number; will be generated automatically
236 - link :: link to the node, that this line represents
237 - created :: When has this entry been created ?
238 - last-accessed :: When has this entry been accessed last ?
239 - count :: How many times has this entry been picked ?
240 - keywords :: List of keywords, which may match your input during occur
241 - all-flags-explained :: All flags, that can be associated with columns
242 - sort :: Sort whole table after this column
243 - yank-after-add :: Let this column be yanked after picking this line
244 - edit-on-add :: Edit this line when adding a new one
245 - point-on-add :: Point will land here, when adding a new line
246 - get-category-on-add :: This column will receive the nodes category during add
247 - get-heading-on-add :: This column will receive the nodes heading during add"
248 "A sample string of flags.")
251 (defun org-index (&optional command search
)
252 "Mark and find your favorite things and org-locations easily:
253 Create and update an index table of references and links. When
254 searching, frequently used entries appear at the top and entering
255 some keywords narrows down to matching entries only, so that the
256 right one can be spotted easily.
258 References are essentially small numbers (e.g. \"R237\" or \"-455-\"),
259 as created by this package; they are well suited to be used
260 outside of org. Links are normal `org-mode' links.
263 This is version 3.1.1 of org-index.el .
266 The function `org-index' operates on a dedicated table, the index
267 table, which lives within its own Org-mode node. The table and
268 its containing node will be created, when you first invoke
269 `org-index'. The node will have some comments, describing the
270 columns of the index table and their associated flags. The index
271 table is found through the id of the containing node, which is
272 stored within the variable `org-index-id'.
275 The function `org-index' is the only interactive function of this
276 package and its main entry point; once invoked it asks, which of
277 it subcommands to execute:
279 occur: Incremental search, that shows matching lines from the
280 index table, updated after every keystroke. You may enter a
281 list of words seperated by space or comma (`,'), to select
282 lines that contain all of the given words.
284 add: Add the current node to your index, so that it can be
285 found through the subcommand \"occur\".
287 delete: Delete the current node from your index.
289 head: Ask for a reference number and search for an entry, which
290 either has this reference contained in its heading or within
291 its property org-index-ref.
293 enter: Enter index table and maybe go to a specific reference.
295 leave: Leave the index table and return to your previous location.
297 ref: Create a new reference.
299 help: Show this text.
301 example: Create a temporary index, that will not be saved, but
302 may serve as an example.
304 reorder: Temporarily reorder the index table, e.g. by count,
305 reference or last access.
307 sort: Sort a set of lines (either from the active region or the
308 whole buffer) by references found in each line.
310 multi-occur: Apply Emacs standard `multi-occur' operation on all
311 `org-mode' buffers to search for the given reference.
313 highlight: Highlight or unhiglight references in active region or buffer.
315 statistics : Show some statistics (e.g. minimum and maximum
316 reference) about index table.
318 If you invoke `org-index' for the first time, an assistant will be
319 invoked, that helps you to create your own, commented index.
321 Use `org-index-default-keybindings' to establish convenient
324 Optional argument COMMAND is a symbol naming the command to execute;
325 SEARCH specifies search string for commands that need one."
329 (let ((org-index--silent nil
) ; t, if user can be asked
330 prefix-arg
; prefix arg
331 link-id
; link of starting node, if required
332 guarded-search
; with guard against additional digits
333 search-ref
; search, if search is a reference
334 search-link
; search, if search is a link
335 reorder-once
; column to use for single time sorting
336 kill-new-text
; text that will be appended to kill ring
337 initial-ref-or-link
; initial position in index table
338 message-text
) ; text that will be issued as an explanation
342 ;; Initialize and parse
345 ;; creates index table, if necessary
346 (org-index--verify-id)
348 ;; Get configuration of index table
349 (org-index--parse-table)
351 ;; store context information
352 (org-index--retrieve-context)
356 ;; Find out, what we are supposed to do
359 (when (equal command
'(4))
360 (setq prefix-arg command
)
364 (unless (memq command org-index--commands
)
365 (error "Unknown command '%s' passed as argument, valid choices are any of these symbols: %s"
366 command
(mapconcat 'symbol-name org-index--commands
",")))
367 (let ((r (org-index--read-command))) ; query user if not from argument
368 (setq command
(car r
))
369 (setq reorder-once
(cdr r
))))
373 ;; Get search, if required
376 ;; These actions need a search string:
377 (when (memq command
'(enter head multi-occur
))
378 ;; Maybe we've got a search string from the arguments
379 (setq search
(org-index--get-or-read-search search command
))
382 (when (string-match org-index--ref-regex search
)
383 (setq search-ref search
)
384 (setq guarded-search
(org-index--make-guarded-search search
)))
385 (when (string-match "^[a-fA-F0-9]\\{8\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{12\\}$" search
)
386 (setq search-link search
))))
390 ;; Check for invalid combinations of arguments; try to be helpful
393 (when (and (eq command
'head
)
396 (error "Can do 'head' only for a reference or link (not '%s'), try 'occur' to search for text" search
))
400 ;; Sort and enter table
403 ;; Get link if required before moving in
404 (if (eq command
'add
)
405 (setq link-id
(org-id-get-create)))
407 ;; Save initial ref or link for later return
408 (if (and org-index--within-node
410 (setq initial-ref-or-link
411 (or (org-index--get-field 'ref
)
412 (org-index--get-field 'link
))))
414 ;; These commands enter index table only temporarily
415 (when (memq command
'(occur multi-occur statistics example
))
417 (set-buffer org-index--buffer
)
418 (goto-char org-index--point
)
421 (org-index--sort reorder-once
)
424 ;; These commands will leave user in index table after they are finished
425 (when (memq command
'(enter ref
))
427 ;; Support orgmode-standard of going back (buffer and position)
430 (pop-to-buffer-same-window org-index--buffer
)
431 (goto-char org-index--point
)
432 (org-index--unfold-buffer)
435 (org-index--sort reorder-once
)
438 ;; Remember position for leave
439 (if org-index--point-before
440 (setq org-index--point-saved org-index--point-before
)))
442 ;; prepare to return to initial position in index table
443 (when initial-ref-or-link
444 (while (and (org-at-table-p)
446 (string= initial-ref-or-link
(org-index--get-field 'ref
))
447 (string= initial-ref-or-link
(org-index--get-field 'link
)))))
449 ;; did not find ref, go back to top
450 (if (not (org-at-table-p)) (goto-char org-index--point
)))
454 ;; Actually do, what is requested
462 ;; bring up help-buffer for this function
463 (describe-function 'org-index
))
466 ((eq command
'multi-occur
)
468 (org-index--update-line search-ref
)
470 ;; Construct list of all org-buffers
471 (let (buff org-buffers
)
472 (dolist (buff (buffer-list))
474 (if (string= major-mode
"org-mode")
475 (setq org-buffers
(cons buff org-buffers
))))
478 (multi-occur org-buffers guarded-search
)
481 (if (get-buffer "*Occur*")
483 (setq message-text
(format "multi-occur for '%s'" search
))
485 (toggle-truncate-lines 1))
486 (setq message-text
(format "Did not find '%s'" search
)))))
491 (setq kill-new-text
(org-index--do-add link-id
)))
494 ((eq command
'delete
)
496 (org-index--do-delete))
502 (if (and org-index--within-node
504 (setq link
(org-index--get-field 'link
)))
506 (setq message-text
(org-index--do-head search-ref
(or link search-link
)))))
511 (setq kill-new-text org-index--text-to-yank
)
512 (setq org-index--text-to-yank nil
)
514 ;; If "leave" has been called two times in succession, make
515 ;; org-mark-ring-goto believe it has been called two times too
516 (if (eq org-index--last-action
'leave
)
517 (let ((this-command nil
) (last-command nil
))
518 (org-mark-ring-goto 1))
519 (org-mark-ring-goto))
521 ;; Return to saved position in index buffer
522 (when org-index--point-saved
523 ;; buffer displayed in window need to set point there first
524 (if (eq (window-buffer org-index--active-window-index
)
526 (set-window-point org-index--active-window-index
(marker-position org-index--point-saved
)))
527 ;; set position in buffer in any case and second
528 (with-current-buffer org-index--buffer
529 (goto-char org-index--point-saved
)))
530 (setq org-index--point-saved nil
))
535 (goto-char org-index--below-hline
)
538 ;; Go downward in table to requested reference
539 (setq message-text
(org-index--find-in-index search search-link
))
540 ;; simply go into table
541 (setq message-text
"At index table"))
548 (org-index--do-occur))
556 (setq new
(org-index--create-new-line (eq command
'ref
)))
558 ;; fill special columns with standard values
559 (org-table-goto-column (org-index--column-num 'ref
))
561 (setq org-index--last-ref new
)
565 ;; goto point-field or first empty one or first field
566 (if (org-index--special-column 'point-on-add
)
567 (org-table-goto-column (org-index--column-num (org-index--special-column 'point-on-add
)))
568 (unless (catch 'empty
569 (dotimes (col org-index--numcols
)
570 (org-table-goto-column (+ col
1))
571 (if (string= (org-trim (org-table-get-field)) "")
573 ;; none found, goto first
574 (org-table-goto-column 1)))
576 (if org-index--active-region
(setq kill-new-text org-index--active-region
))
577 (setq message-text
(format "Adding a new row with ref '%s'" new
))))
582 ;; sort lines according to contained reference
583 (let (begin end where
)
585 ;; either active region or whole buffer
586 (if (and transient-mark-mode
590 (setq begin
(region-beginning))
591 (setq end
(region-end))
592 (setq where
"region"))
594 (setq begin
(point-min))
595 (setq end
(point-max))
596 (setq where
"whole buffer")
598 (unless (y-or-n-p "Sort whole buffer? ")
599 (setq message-text
"Sort aborted")
600 (throw 'aborted nil
)))
604 (goto-char (point-min))
605 (narrow-to-region begin end
)
606 (sort-subr nil
'forward-line
'end-of-line
608 (if (looking-at (concat ".*"
609 (org-index--make-guarded-search org-index--ref-regex
'dont-quote
)))
610 (string-to-number (match-string 1))
612 (highlight-regexp org-index--ref-regex
'isearch
)
613 (setq message-text
(format "Sorted %s from character %d to %d, %d lines"
615 (count-lines begin end
)))))))
619 ((eq command
'highlight
)
621 (let ((where "buffer"))
624 (when (and transient-mark-mode
626 (narrow-to-region (region-beginning) (region-end))
627 (setq where
"region"))
631 (unhighlight-regexp org-index--ref-regex
)
632 (setq message-text
(format "Removed highlights for references in %s" where
)))
633 (highlight-regexp org-index--ref-regex
'isearch
)
634 (setq message-text
(format "Highlighted references in %s" where
)))))))
637 ((eq command
'statistics
)
639 (setq message-text
(org-index--do-statistics)))
642 ((eq command
'example
)
644 (if (y-or-n-p "This assistand will help you to create a temporary index with detailed comments.\nDo you want to proceed ? ")
645 (org-index--create-index t
)))
648 (t (error "This is a bug: unmatched case '%s'" command
)))
651 ;; remember what we have done for next time
652 (setq org-index--last-action command
)
654 ;; tell, what we have done and what can be yanked
655 (if kill-new-text
(setq kill-new-text
656 (substring-no-properties kill-new-text
)))
657 (if (string= kill-new-text
"") (setq kill-new-text nil
))
660 (if (and message-text kill-new-text
)
662 (if kill-new-text
"R" ""))
663 (if kill-new-text
(format "eady to yank '%s'" kill-new-text
) ""))))
664 (unless (string= m
"")
666 (setq org-index--message-text m
)))
667 (if kill-new-text
(kill-new kill-new-text
))))
670 (defun org-index-default-keybindings ()
671 "Set default keybindings for `org-index'.
673 Establish the common prefix key `C-c i' which is followed by the
674 first letter of a subcommand, so that `C-c i a' invokes the
675 subcommand \"add\". Subcommands available are occur, add, delete,
676 head, enter, leave and ref. As a special case `C-c i i' invokes
677 `org-index' to let you choose."
679 (define-prefix-command 'org-index-map
)
680 (global-set-key (kbd "C-c i") 'org-index-map
)
681 (define-key org-index-map
(kbd "i") (lambda () (interactive) (message nil
) (org-index)))
682 (define-key org-index-map
(kbd "o") (lambda () (interactive) (message nil
) (org-index 'occur
)))
683 (define-key org-index-map
(kbd "a") (lambda () (interactive) (message nil
) (org-index 'add
)))
684 (define-key org-index-map
(kbd "d") (lambda () (interactive) (message nil
) (org-index 'delete
)))
685 (define-key org-index-map
(kbd "h") (lambda () (interactive) (message nil
) (org-index 'head
)))
686 (define-key org-index-map
(kbd "e") (lambda () (interactive) (message nil
) (org-index 'enter
)))
687 (define-key org-index-map
(kbd "l") (lambda () (interactive) (message nil
) (org-index 'leave
)))
688 (define-key org-index-map
(kbd "r") (lambda () (interactive) (message nil
) (org-index 'ref
))))
691 (defun org-index-new-line (&rest keys-values
)
692 "Create a new line within the index table, returning its reference.
694 The function takes a varying number of argument pairs; each pair
695 is a symbol for an existing column heading followed by its value.
699 (org-index-new-line 'ref t 'link \"7f480c3e\")
701 Passing \"'ref t\" will make the function create a new reference
704 Optional argument KEYS-VALUES specifies content of new line."
706 (org-index--verify-id)
707 (org-index--parse-table)
709 (car (org-index--do-new-line keys-values
)))
712 (defun org-index--do-new-line (&rest keys-values
)
713 "Do the work for `org-index-new-line'.
714 Optional argument KEYS-VALUES specifies content of new line."
716 (let ((org-index--silent t
))
719 (org-index--retrieve-context)
720 (with-current-buffer org-index--buffer
721 (goto-char org-index--point
)
723 ;; check arguments early
724 (let ((kvs keys-values
)
730 (unless (memq v
'(t nil
))
731 (error "Column 'ref' accepts only \"t\" or \"nil\""))
732 (if (or (not (symbolp k
))
733 (and (symbolp v
) (not (eq v t
)) (not (eq v nil
))))
734 (error "Arguments must be alternation of key and value")))
735 (unless (org-index--column-num k
)
736 (error "Unknown column or column not defined in table: '%s'" (symbol-name k
)))
737 (setq kvs
(cddr kvs
))))
739 (if (and (not (plist-get keys-values
'ref
))
740 (not (stringp (plist-get keys-values
'link
))))
741 (error "Need a link when not creating a ref"))
745 (setq ref
(org-index--create-new-line (plist-get keys-values
'ref
)))
746 (plist-put keys-values
'ref
(or ref
""))
749 (let ((kvs keys-values
)
754 (setq n
(org-index--column-num k
))
755 (org-table-goto-column n
)
757 (setq kvs
(cddr kvs
))))
759 ;; get column to yank
760 (setq yank
(org-trim (org-table-get-field (org-index--column-num (org-index--special-column 'yank-after-add
)))))
766 (defun org-index-get-line (type value
)
767 "Retrieve an existing line within the index table by ref or link.
768 Return its contents as a property list.
770 The function `plist-get' may be used to retrieve specific elements
775 (plist-get (org-index-get-line 'ref \"R12\") 'count)
777 retrieves the value of the count-column for reference number 12.
779 Argument TYPE is a symbol, either ref or link,
780 argument VALUE specifies the value to search for."
782 (unless (memq type
'(ref link
))
783 (error "Argument can only be 'ref' or 'link'"))
785 (org-index--verify-id)
786 (org-index--parse-table)
788 (org-index--get-or-delete-line 'get type value
))
791 (defun org-index--get-or-delete-line (command type value
)
792 "Get or delete (according to COMMAND) a line by TYPE and VALUE."
793 (let ((org-index--silent t
)
797 (org-index--retrieve-context)
798 (with-current-buffer org-index--buffer
799 (goto-char org-index--point
)
801 (goto-char org-index--below-hline
)
802 (while (and (not found
)
804 (when (string= (org-index--get-field type
)
806 ;; found matching line
807 (if (eq command
'get
)
810 (if (and (numberp (cdr x
))
812 (setq found
(cons (car x
) (cons (or (org-index--get-field (car x
)) "") found
)))
813 )) (reverse org-index--columns
))
815 (let ((start (point)))
818 (delete-region start
(point)))))
823 (defun org-index--read-command ()
824 "Find out, what we are supposed to do."
826 (let (reorder-once ; Column to use for single time sorting
830 ;; Ask user, what to do
836 (mapcar 'symbol-name org-index--commands
)
840 (setq command
(intern input
))
842 ;; ask for reorder in loop, because we may have to ask for command right again
843 (if (eq command
'reorder
)
846 (org-icompleting-read
847 "Please choose column to reorder index table once: "
848 (list "ref" "count" "created" "last-accessed")
851 ;; maybe ask initial question again
852 (eq command
'reorder
)))
853 (cons command reorder-once
)))
856 (defun org-index--get-or-read-search (search command
)
857 "Get SEARCH string, maybe read from user; respect COMMAND that will be executed."
859 (let (search-from-table
863 ;; Search string can come from several sources:
864 ;; From link or ref columns of table
865 (when (and org-index--within-node
867 (setq search-from-table
(or (org-index--get-field 'link
)
868 (org-index--get-field 'ref
))))
870 ;; From string below cursor
871 (when (and (not org-index--within-node
)
872 org-index--below-cursor
873 (string-match (concat "\\(" org-index--ref-regex
"\\)")
874 org-index--below-cursor
))
875 (setq search-from-cursor
(match-string 1 org-index--below-cursor
)))
877 ;; Depending on requested action, get search from one of the sources above
878 (cond ((eq command
'enter
)
879 (setq search search-from-cursor
))
880 ((memq command
'(head occur
))
881 (setq search
(or search-from-table search-from-cursor
)))))
884 ;; From occur-buffer into index ?
886 (if (and (string= (buffer-name) org-index--occur-buffer-name
)
888 (setq search
(org-index--get-field 'ref
))))
891 ;; If we still do not have a search string, ask user explicitly
894 (if org-index--silent
(error "Need to specify search, if silence is required"))
896 (if (eq command
'enter
)
897 ;; accept single char commands or switch to reading a sequence of digits
900 ;; read one character
901 (while (not (memq char
(append (number-sequence ?
0 ?
9) (list ?c ?l ?. ?\C-m
))))
902 ;; start with short prompt but give more help on next iteration
903 (setq prompt
"Please specify, where to go (0-9.l<return> or ? for help): ")
904 (setq char
(read-char prompt
))
905 (setq prompt
"Digits specify a reference number to got to, `.' goes to index line of current node, `l' to last line created and <return> to top of index. Please choose: "))
907 (if (memq char
(number-sequence ?
0 ?
9))
908 ;; read rest of digits
909 (setq search
(read-from-minibuffer "Search reference number: " (char-to-string char
)))
910 ;; decode single chars
911 (if (eq char ?.
) (setq search
(org-id-get)))
912 (if (eq char ?\C-m
) (setq search nil
))
913 (if (eq char ?l
) (setq search
(number-to-string org-index--maxref
)))))
915 (setq search
(read-from-minibuffer "Search reference number: "))))
917 ;; Clean up and examine search string
919 (setq search
(org-trim search
))
920 (if (string= search
"") (setq search nil
))
922 (if (string-match "^[0-9]+$" search
)
923 (setq search
(concat org-index--head search org-index--tail
)))))
928 (defun org-index--verify-id ()
929 "Check, that we have a valid id."
933 (org-index--create-missing-index "Variable org-index-id is not set, so probably no index table has been created yet."))
937 (setq marker
(org-id-find org-index-id
'marker
))
938 (unless marker
(org-index--create-missing-index "Cannot find the node with id \"%s\" (as specified by variable org-index-id)." org-index-id
))
939 ; Try again with new node
940 (setq marker
(org-id-find org-index-id
'marker
))
941 (unless marker
(error "Could not create node"))
942 (setq org-index--buffer
(marker-buffer marker
)
943 org-index--point
(marker-position marker
))
944 (move-marker marker nil
)))
947 (defun org-index--retrieve-context ()
948 "Collect context information before starting with command."
950 ;; Get the content of the active region or the word under cursor
951 (setq org-index--active-region
952 (if (and transient-mark-mode mark-active
)
953 (buffer-substring (region-beginning) (region-end))
955 (setq org-index--below-cursor
(thing-at-point 'symbol
))
957 ;; get category of current node
958 (setq org-index--category-before
959 (save-excursion ; workaround: org-get-category does not give category when at end of buffer
963 ;; Find out, if we are within index table or not
964 (setq org-index--within-node
(string= (org-id-get) org-index-id
))
966 ;; Check and remember, if active window contains buffer with index table
967 (if (eq (window-buffer) org-index--buffer
)
968 (setq org-index--active-window-index
(selected-window)))
970 ;; get current position in index-buffer
971 (with-current-buffer org-index--buffer
972 (setq org-index--point-before
973 (if (string= (org-id-get) org-index-id
)
978 (defun org-index--parse-table ()
979 "Parse content of index table."
987 (with-current-buffer org-index--buffer
989 (setq org-index--maxref
0)
990 (setq initial-point
(point))
992 (org-index--go-below-hline)
995 ;; get headings to display during occur
996 (setq end-of-headings
(point))
997 (while (org-at-table-p) (forward-line -
1))
999 (setq start-of-headings
(point))
1000 (setq org-index--headings
(buffer-substring start-of-headings end-of-headings
))
1003 (org-table-goto-column 100)
1004 (setq org-index--numcols
(- (org-table-current-column) 1))
1006 ;; go to top of table
1007 (while (org-at-table-p)
1011 ;; parse line of headings
1012 (org-index--parse-headings)
1015 ;; parse list of flags
1016 (goto-char org-index--point
)
1017 (org-index--parse-flags)
1019 (org-index--go-below-hline)
1020 (setq org-index--below-hline
(point-marker))
1022 ;; Retrieve any decorations around the number within the first nonempty ref-field
1023 (goto-char org-index--below-hline
)
1024 (while (and (org-at-table-p)
1025 (not (setq ref-field
(org-index--get-field 'ref
))))
1030 (org-index--report-index-error "Reference column is empty"))
1032 (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field
)
1033 (org-index--report-index-error
1034 "First reference in index table ('%s') does not contain a number" ref-field
))
1036 ;; These are the decorations used within the first ref of index
1037 (setq org-index--head
(match-string 1 ref-field
))
1038 (setq org-index--tail
(match-string 3 ref-field
))
1039 (setq org-index--ref-regex
(concat (regexp-quote org-index--head
)
1041 (regexp-quote org-index--tail
)))
1042 (setq org-index--ref-format
(concat org-index--head
"%d" org-index--tail
))
1044 ;; Go through table to find maximum number and do some checking
1047 (while (org-at-table-p)
1049 (setq ref-field
(org-index--get-field 'ref
))
1050 (setq link-field
(org-index--get-field 'link
))
1052 (when (and (not ref-field
)
1055 (message "Removing line from index-table with both ref and link empty"))
1058 (if (string-match org-index--ref-regex ref-field
)
1060 (setq ref
(string-to-number (match-string 1 ref-field
)))
1062 (message "Removing line from index-table whose ref does not contain a number")))
1064 ;; check, if higher ref
1065 (if (> ref org-index--maxref
) (setq org-index--maxref ref
))
1069 ;; go back to initial position
1070 (goto-char initial-point
))))
1073 (defun org-index--sort (&optional sort-column
)
1074 "Sort index table maybe according to SORT-COLUMN."
1076 (unless sort-column
(setq sort-column
(org-index--special-column 'sort
)))
1078 (let ((is-modified (buffer-modified-p))
1084 (unless buffer-read-only
1086 ;; get boundaries of table
1087 (goto-char org-index--below-hline
)
1090 (while (org-at-table-p) (forward-line))
1092 ;; Kill all empty rows at bottom
1095 (org-table-goto-column 1)
1097 (not (org-index--get-field 'ref
))
1098 (not (org-index--get-field 'link
))))
1099 (org-table-kill-row))
1101 (setq bottom
(point))
1104 (narrow-to-region top bottom
)
1111 (ref-field (or (org-index--get-field 'ref
) ""))
1112 (count-field (or (org-index--get-field 'count
) "")))
1114 ;; get reference with leading zeroes, so it can be
1116 (string-match org-index--ref-regex ref-field
)
1120 (or (match-string 1 ref-field
)
1123 ;; Construct different sort-keys according to
1124 ;; requested sort column
1127 ((eq sort-column
'count
)
1130 (string-to-number (or (org-index--get-field 'count
)
1134 ((eq sort-column
'ref
)
1137 ((eq sort-column
'last-accessed
)
1138 (concat (org-index--get-field sort-column
)
1142 (t (error "This is a bug: unmatched case '%s'" sort-column
)))))
1146 ;; restore modification state
1147 (set-buffer-modified-p is-modified
))))
1150 (defun org-index--go-below-hline ()
1151 "Move below hline in index-table."
1154 (errstring (format "index table within node %s" org-index-id
)))
1156 (goto-char org-index--point
)
1158 ;; go to heading of node
1159 (while (not (org-at-heading-p)) (forward-line -
1))
1162 ;; go to first table, but make sure we do not get into another node
1163 (while (and (not (org-at-table-p))
1164 (not (org-at-heading-p))
1168 ;; check, if there really is a table
1169 (unless (org-at-table-p)
1170 (org-index--create-missing-index "Cannot find %s." errstring
))
1172 ;; go just after hline
1173 (while (and (not (org-at-table-hline-p))
1179 (unless (org-at-table-p)
1180 (org-index--report-index-error "Cannot find a hline within %s" errstring
))
1182 (org-table-goto-column 1)))
1185 (defun org-index--align ()
1186 "Align index table without setting its buffer modified."
1187 (let ((is-modified (buffer-modified-p)))
1188 (unless buffer-read-only
(org-table-align))
1189 (set-buffer-modified-p is-modified
)
1190 (org-index--go-below-hline)
1191 (setq org-index--below-hline
(point-marker))))
1194 (defun org-index--parse-headings ()
1195 "Parse headings of index table."
1197 (let (field ;; field content
1198 field-symbol
;; and as a symbol
1201 (setq org-index--columns nil
)
1204 (dotimes (col org-index--numcols
)
1206 (setq field
(substring-no-properties (downcase (org-trim (org-table-get-field (+ col
1))))))
1208 (if (string= field
"")
1209 (error "Column name cannot be empty"))
1210 (if (and (not (string= (substring field
0 1) "."))
1211 (not (member (intern field
) org-index--valid-headings
)))
1212 (error "Column name '%s' is not a valid heading (custom headings may start with a dot (e.g. '.foo')" field
))
1214 (setq field-symbol
(intern field
))
1216 ;; check if heading has already appeared
1217 (if (assoc field-symbol org-index--columns
)
1218 (org-index--report-index-error
1219 "'%s' appears two times as column heading" (downcase field
))
1220 ;; add it to list at front, reverse later
1221 (setq org-index--columns
(cons (cons field-symbol
(+ col
1)) org-index--columns
)))))
1223 (setq org-index--columns
(reverse org-index--columns
))
1225 ;; check if all necessary headings have appeared
1226 (mapc (lambda (head)
1227 (unless (cdr (assoc head org-index--columns
))
1228 (org-index--report-index-error "No column has heading '%s'" head
)))
1229 org-index--required-headings
))
1232 (defun org-index--parse-flags ()
1233 "Parse list of flags in index table."
1235 (let (parent parent-is-comment child
)
1237 ;; reset configuration variables
1238 (setq org-index--special-columns nil
)
1239 (setq org-index--flagged-columns nil
)
1241 (org-index--goto-list "columns-and-flags" t
)
1244 ;; outer loop over columns
1245 (while (and (setq parent
(org-index--parse-list-item))
1247 (> (cdr (assoc :indent parent
)) 0))
1249 (setq parent-is-comment
(member (cdr (assoc :text parent
)) '("all-columns-explained" "all-flags-explained")))
1251 ;; check, that we have a valid heading
1252 (unless (or parent-is-comment
1253 (assoc (cdr (assoc :sym parent
)) org-index--columns
))
1254 (org-index--report-index-error "'%s' is not a valid column" (cdr (assoc :text parent
))))
1256 ;; inner loop over children
1257 (while (and (forward-line 1)
1258 (setq child
(org-index--parse-list-item))
1260 (> (cdr (assoc :indent child
))
1261 (cdr (assoc :indent parent
))))
1263 (unless parent-is-comment
1264 ;; check, that we have a valid flag
1265 (unless (memq (cdr (assoc :sym child
)) org-index--all-flags
)
1266 (org-index--report-index-error "'%s' is not a valid flag" (cdr (assoc :text child
))))
1268 ;; process flag with respect to current index-column
1269 (if (memq (cdr (assoc :sym child
)) org-index--single-flags
)
1270 ;; Check, that none of org-index--single-flags appears twice
1271 (if (assoc (cdr (assoc :sym child
)) org-index--special-columns
)
1272 (org-index--report-index-error
1273 "More than one column is marked with flag '%s'" (cdr (assoc :text child
)))
1275 (setq org-index--special-columns
(cons (cons (cdr (assoc :sym child
)) (cdr (assoc :sym parent
)))
1276 org-index--special-columns
))))
1278 ;; all flags are stored in org-index--flagged-columns
1279 (let ((l (assoc (cdr (assoc :sym child
)) org-index--flagged-columns
))) ;; list of flag and columns, that carry this flag
1281 ;; no list of columns with this flag is present, create one
1282 (setq org-index--flagged-columns
1283 (cons (cons (cdr (assoc :sym child
)) nil
)
1284 org-index--flagged-columns
))
1285 (setq l
(car org-index--flagged-columns
)))
1286 ;; prepend this column to list of columns with this flag
1287 (setcdr l
(cons (cdr (assoc :sym parent
)) (cdr l
)))))))
1289 ;; check, that all needed flags have been specified
1291 (unless (assoc x org-index--special-columns
)
1292 (org-index--report-index-error "Required flag '%s' does not appear" (substring (symbol-name x
) 1))))
1293 org-index--required-flags
)))
1296 (defun org-index--goto-list (name &optional required non-top
)
1297 "Goto list NAME (maybe NON-TOP Level) in index node, err if REQUIRED list is not present."
1298 (goto-char org-index--point
)
1300 ;; go to heading of node
1301 (while (not (org-at-heading-p)) (forward-line -
1))
1305 (while (and (not (let ((item (org-index--parse-list-item)))
1307 (and (or non-top
(= (cdr (assoc :indent item
)) 0)) ;; accept only toplevel ?
1308 (string= (cdr (assoc :text item
)) name
)) ;; with requested name
1310 (not (org-at-table-p))
1311 (not (org-at-heading-p))
1318 (org-index--report-index-error "Could not find required list '%s'" name
)
1322 (defun org-index--parse-list-item ()
1323 "Parse a list item into an assoc array (indent, checkbox, text, value)."
1325 (if (looking-at org-list-full-item-re
)
1327 ;; retrieve interesting parts of list item from match data
1328 (let (alist indent checkbox text value
)
1330 (setq indent
(save-excursion
1331 (goto-char (match-beginning 1))
1333 (decf indent
(+ (save-match-data (org-current-level)) 1))
1334 (add-to-list 'alist
(cons :indent indent
))
1336 (setq checkbox
(match-string 3))
1338 (setq text
(match-string 4))
1339 (setq value
(buffer-substring
1341 (save-excursion (end-of-line) (point))))
1347 (add-to-list 'alist
(cons :text text
))
1348 (add-to-list 'alist
(cons :value value
))
1350 (add-to-list 'alist
(cons :sym
(intern text
)))
1353 (mapc (lambda (x) (if (stringp (cdr x
)) (setf (cdr x
) (org-trim (substring-no-properties (cdr x
)))))) alist
)
1361 (defun org-index--create-missing-index (&rest reasons
)
1362 "Create a new empty index table with detailed explanation. Argument REASONS explains why."
1364 (org-index--ask-before-create-index "Cannot find your index table: "
1367 (org-index--create-index))
1371 (defun org-index--report-index-error (&rest reasons
)
1372 "Report an error (explained by REASONS) with the existing index and offer to create a valid one to compare with."
1374 (org-index--ask-before-create-index "The existing index contains this error: "
1375 "temporary" ", to compare with."
1377 (org-index--create-index t t
))
1381 (defun org-index--ask-before-create-index (explanation type for-what reasons
)
1382 ; checkdoc-params: (explanation type for-what reasons)
1383 "Ask the user before creating an index or throw error. Arguments specify bits of issued message."
1384 (let (reason prompt
)
1386 (setq reason
(apply 'format reasons
))
1387 (if org-index--silent
(error (concat explanation reason
))) ; cannot proceed without querying the user
1389 (setq prompt
(concat explanation reason
"\n\n"
1390 "However, this assistant can help you to create a "
1391 type
" index with detailed comments" for-what
"\n\n"
1392 "Do you want to proceed ?"))
1394 (unless (let ((max-mini-window-height 1.0))
1396 (error explanation reason
))))
1400 (defun org-index--create-index (&optional temporary compare
)
1401 "Create a new empty index table with detailed explanation.
1402 specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existing index."
1409 (let ((file-name (concat temporary-file-directory
"org-index--example-index.org"))
1410 (buffer-name "*org-index-example-index*"))
1411 (setq buffer
(get-buffer-create buffer-name
))
1412 (with-current-buffer buffer
1413 ;; but it needs a file for its index to be found
1414 (unless (string= (buffer-file-name) file-name
)
1415 (set-visited-file-name file-name
))
1416 (rename-buffer buffer-name
) ; name is change by line above
1421 (setq buffer
(get-buffer (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name
(org-buffer-list)) nil nil
))))
1423 (setq title
(read-from-minibuffer "Please enter the title of the index node: "))
1426 (setq firstref
(read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit 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 to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: "))
1428 (when (string-match "[[:blank:]]" firstref
)
1429 (setq desc
"Contains whitespace"))
1430 (when (string-match "[[:cntrl:]]" firstref
)
1431 (setq desc
"Contains control characters"))
1432 (unless (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref
)
1433 ;; firstref not okay, report details
1435 (cond ((string= firstref
"") "is empty")
1436 ((not (string-match "^[^0-9]+" firstref
)) "starts with a digit")
1437 ((not (string-match "^[^0-9]+[0-9]+" firstref
)) "does not contain a number")
1438 ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref
)) "contains more than one sequence of digits")
1443 (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s.\nPlease hit RET and try again: " firstref desc
))
1447 (with-current-buffer buffer
1448 (goto-char (point-max))
1449 (insert (format "* %s %s\n" firstref title
))
1452 Below you find your temporary index table, which will not last longer
1453 than your current emacs session.
1456 Below you find your initial index table, which will grow over time.
1459 You may start using it by adding some lines. Just move to
1460 another heading, invoke `org-index' and choose the command
1461 \"add\". After adding a few nodes, try the command \"occur\"
1462 to search among them.
1464 To gain further insight you may invoke the subcommand \"help\", or
1465 read the description of `org-index'.
1467 Within the index table below, dhe sequence of columns does not
1468 matter. You may reorder them any way you like. Columns are
1469 found by their heading. You may also add your own columns.
1471 Following these explanations there is the item-list
1472 `columns-and-flags', which influences the behaviour of
1473 `org-index'. See the explanations which are part of this list.
1475 This node needs not be a top level node; its name is completely
1476 at your choice; it is found through its ID only.
1478 Remark: These lines of explanation can be removed at any time.
1481 (setq id
(org-id-get-create))
1486 | ref | .category | keywords | count | last-accessed | created | link |
1488 |-----+-----------+----------+-------+---------------+---------+------|
1489 | %s | | %s | | | %s | %s |
1492 org-index--sample-flags
1495 (with-temp-buffer (org-insert-time-stamp nil nil t
))
1498 ;; make sure, that node can be found
1499 (org-id-add-location id
(buffer-file-name))
1500 (setq buffer-save-without-query t
)
1503 (while (not (org-at-table-p)) (forward-line -
1))
1504 (unless buffer-read-only
(org-table-align))
1505 (while (not (org-at-heading-p)) (forward-line -
1))
1507 ;; read back some info about new index
1508 (let ((org-index-id id
))
1509 (org-index--verify-id))
1511 ;; present results to user
1514 ;; Present existing and temporary index together
1516 (pop-to-buffer-same-window org-index--buffer
)
1517 (goto-char org-index--point
)
1518 (org-index--unfold-buffer)
1519 (delete-other-windows)
1520 (select-window (split-window-vertically)))
1522 (pop-to-buffer-same-window buffer
)
1524 (org-index--unfold-buffer)
1526 (error "Please compare your existing index (upper window) and a temporary new one (lower window) to fix your index")
1527 (message "This is your new temporary index.")))
1529 ;; Only show the new index
1530 (pop-to-buffer-same-window buffer
)
1531 (delete-other-windows)
1533 (org-index--unfold-buffer)
1534 (setq org-index-id id
)
1535 (if (y-or-n-p "This is your new index table. It is already set for this Emacs session, so you may try it out. Do you want to save its id to make it available for future Emacs sessions too ? ")
1537 (customize-save-variable 'org-index-id id
)
1538 (error "Saved org-index-id '%s' to %s" id
(or custom-file
1541 (setq sq
(format "(setq org-index-id \"%s\")" id
))
1543 (error "Did not make the id of this new index permanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it" sq
))))))))
1546 (defun org-index--unfold-buffer ()
1547 "Helper function to unfold buffer."
1552 (org-back-to-heading)
1553 (forward-line) ;; on property drawer
1555 (org-index--goto-list "columns-and-flags")
1559 (defun org-index--update-line (ref-or-link)
1560 "Update columns count and last-accessed in line REF-OR-LINK."
1565 (with-current-buffer org-index--buffer
1566 (unless buffer-read-only
1568 ;; search reference or link, if given (or assume, that we are already positioned right)
1570 (setq initial
(point))
1571 (goto-char org-index--below-hline
)
1572 (while (and (org-at-table-p)
1573 (not (or (string= ref-or-link
(org-index--get-field 'ref
))
1574 (string= ref-or-link
(org-index--get-field 'link
)))))
1577 (if (not (org-at-table-p))
1578 (error "Did not find reference or link '%s'" ref-or-link
)
1579 (org-index--update-current-line))
1581 (if initial
(goto-char initial
))))))
1584 (defun org-index--update-current-line ()
1585 "Update current lines columns count and last-accessed."
1586 (let (newcount (count-field (org-index--get-field 'count
)))
1588 ;; update count field only if number or empty
1589 (when (or (not count-field
)
1590 (string-match "^[0-9]+$" count-field
))
1591 (setq newcount
(+ 1 (string-to-number (or count-field
"0"))))
1592 (org-index--get-field 'count
1593 (number-to-string newcount
)))
1596 (org-table-goto-column (org-index--column-num 'last-accessed
))
1597 (org-table-blank-field)
1598 (org-insert-time-stamp nil t t
)))
1601 (defun org-index--get-field (key &optional value
)
1602 "Retrieve field KEY from index table or set it to VALUE."
1605 (setq field
(org-trim (org-table-get-field (cdr (assoc key org-index--columns
)) value
)))
1606 (if (string= field
"") (setq field nil
))
1608 (org-no-properties field
))))
1611 (defun org-index--column-num (key)
1612 "Return number of column KEY."
1615 (cdr (assoc key org-index--columns
))))
1618 (defun org-index--special-column (key)
1619 "Return column (not a number) for special column KEY."
1620 (cdr (assoc key org-index--special-columns
)))
1623 (defun org-index--flag-p (flag column
)
1624 "Check if COLUMN has FLAG set."
1625 (unless (memq flag org-index--all-flags
)
1626 (error (format "Internal error: unknown flag %s" (symbol-name flag
))))
1627 (memq column
(assoc flag org-index--flagged-columns
)))
1630 (defun org-index--make-guarded-search (ref &optional dont-quote
)
1631 "Make robust search string from REF; DONT-QUOTE it, if requested."
1632 (concat "\\_<" (if dont-quote ref
(regexp-quote ref
)) "\\_>"))
1635 (defun org-index--do-statistics ()
1636 "Compute statistics about index table."
1645 ;; go through table and remove all refs, that we see
1646 (goto-char org-index--below-hline
)
1647 (while (org-at-table-p)
1649 ;; get ref-field and number
1650 (setq ref-field
(org-index--get-field 'ref
))
1652 (string-match org-index--ref-regex ref-field
))
1653 (setq ref
(string-to-number (match-string 1 ref-field
))))
1655 ;; record min and max
1656 (if (or (not min
) (< ref min
)) (setq min ref
))
1657 (if (or (not max
) (> ref max
)) (setq max ref
))
1660 (setq total
(1+ total
))
1664 (setq message
(format "Found %d references from %s to %s."
1666 (format org-index--ref-format min
)
1667 (format org-index--ref-format max
)))
1672 (defun org-index--do-add (link-id)
1673 "For current node (with id LINK-ID): add a new line to index table."
1675 (let ((args (list 'ref t
'link link-id
))
1676 ref-and-yank content
)
1678 (unless (org-at-heading-p)
1679 (error "Not at headline"))
1681 ;; some fields want to be edited
1682 (dolist (col-num org-index--columns
)
1687 (if (org-index--flag-p 'get-heading-on-add
(car col-num
))
1688 (setq content
(nth 4 (org-heading-components))))
1691 (if (org-index--flag-p 'get-category-on-add
(car col-num
))
1692 (setq content org-index--category-before
))
1694 (if (org-index--flag-p 'edit-on-add
(car col-num
))
1695 (setq content
(read-from-minibuffer
1696 (format "Edit text for column '%s': " (symbol-name (car col-num
)))
1699 (if (not (string= content
""))
1700 (setq args
(append (list (car col-num
) content
) args
))))
1702 ;; new line in index table
1703 (setq ref-and-yank
(apply 'org-index--do-new-line args
))
1706 (org-entry-put (point) "org-index-ref" (car ref-and-yank
))
1708 (cdr ref-and-yank
)))
1711 (defun org-index--do-delete ()
1712 "Perform command delete."
1714 (unless (org-at-heading-p)
1715 (error "Not at headline"))
1717 (let ((ref (org-entry-get (point) "org-index-ref")))
1719 ;; delete from index table
1720 (org-index--get-or-delete-line 'delete
'ref ref
)
1722 ;; delete from property
1723 (org-entry-delete (point) "org-index-ref")
1725 ;; maybe delete from heading
1728 (let ((end (point)))
1730 (when (search-forward ref end t
)
1731 (delete-char (- (length ref
)))
1732 (just-one-space))))))
1735 (defun org-index--find-in-index (search &optional search-link
)
1736 "Find index line with ref or link SEARCH (decided by SEARCH-LINK)."
1737 (let ((initial (point))
1739 (while (and (not found
)
1745 (org-index--get-field
1746 (if search-link
'link
'ref
))))))
1749 (setq text
(format "Found index line '%s'" search
))
1750 (org-index--update-line nil
)
1751 (org-table-goto-column (org-index--column-num 'ref
))
1752 (if (looking-back " ") (backward-char))
1753 ;; remember string to copy
1754 (setq org-index--text-to-yank
1755 (org-trim (org-table-get-field (org-index--column-num 'copy
)))))
1756 (setq text
(format "Did not find index line '%s'" search
))
1762 (defun org-index--do-head (ref link
&optional other
)
1763 "Perform command head: Find node with REF or LINK and present it; if OTHER in separate window."
1765 (if ref
(setq org-index--last-ref ref
))
1766 (let (message marker
)
1768 ;; Prefer link if available
1770 (setq marker
(org-id-find link t
))
1773 (message (format "Scanning headlines for '%s' ..." ref
))
1776 (when (string= ref
(org-entry-get (point) "org-index-ref"))
1777 (throw 'found
(point-marker))))
1783 (org-index--update-line (or link ref
))
1785 (setq message
"Followed link")
1786 (setq message
(format "Found headline '%s'" ref
)))
1790 (setq cb
(current-buffer))
1791 (pop-to-buffer (marker-buffer marker
)))
1792 (pop-to-buffer-same-window (marker-buffer marker
)))
1799 (setq message
(format "Did not find link '%s'" link
))
1800 (setq message
(format "Did not find headline '%s'." ref
))))
1805 (defun org-index--do-occur ()
1806 "Perform command occur."
1807 (let ((word "") ; last word to search for growing and shrinking on keystrokes
1808 (prompt "Search for: ")
1809 (lines-wanted (window-body-height))
1810 (lines-found 0) ; number of lines found
1811 words
; list words that should match
1813 begin
; position of first line
1814 narrow
; start of narrowed buffer
1815 help-text
; cons with help text short and long
1816 key-help
; for keys with special function
1817 search-text
; description of text to search for
1818 done
; true, if loop is done
1819 in-c-backspace
; true, while processing C-backspace
1820 show-headings
; true, if headings should be shown
1821 help-overlay
; Overlay with help text
1822 last-point
; Last position before end of search
1823 key
; input from user
1824 key-sequence
) ; as a sequence
1827 ;; make and show buffer
1828 (if (get-buffer org-index--occur-buffer-name
)
1829 (kill-buffer org-index--occur-buffer-name
))
1830 (setq occur-buffer
(make-indirect-buffer org-index--buffer org-index--occur-buffer-name
))
1831 (pop-to-buffer-same-window occur-buffer
)
1832 ;; avoid modifying direct buffer
1833 (setq buffer-read-only t
)
1834 (toggle-truncate-lines 1)
1835 (setq font-lock-keywords-case-fold-search t
)
1836 (setq case-fold-search t
)
1838 ;; reset stack and overlays
1839 (setq org-index--occur-stack nil
)
1840 (setq org-index--occur-tail-overlay nil
)
1842 ;; narrow to table rows and one line before
1843 (goto-char (marker-position org-index--below-hline
))
1845 (setq begin
(point))
1847 (setq narrow
(point))
1848 (while (org-at-table-p)
1850 (narrow-to-region narrow
(point))
1851 (goto-char (point-min))
1854 ;; initialize help text
1855 (setq help-text
(cons
1856 "Incremental occur; `?' toggles help and headlines.\n"
1860 "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; all other keys end search.\n"))
1861 org-index--headings
)))
1863 ;; insert overlay for help text and to cover unsearched lines
1864 (setq help-overlay
(make-overlay (point-min) begin
))
1865 (overlay-put help-overlay
'display
(car help-text
))
1866 (overlay-put help-overlay
'face
'org-agenda-dimmed-todo-face
)
1867 (setq org-index--occur-tail-overlay
(make-overlay (point-max) (point-max)))
1868 (overlay-put org-index--occur-tail-overlay
'invisible t
)
1873 (setq key
"<backspace>")
1874 (setq search-text
(mapconcat 'identity
(reverse (cons word words
)) ","))
1881 (if (string= search-text
"") "" " ")))))
1882 (setq key
(key-description key-sequence
)))
1887 ((string= key
"<C-backspace>")
1888 (setq in-c-backspace t
))
1891 ((member key
(list "<backspace>" "DEL")) ; erase last char
1893 (if (= (length word
) 0)
1895 ;; nothing more to delete from current word; try next
1897 (setq word
(car words
))
1898 (setq words
(cdr words
))
1899 (setq in-c-backspace nil
))
1901 ;; unhighlight longer match
1902 (unhighlight-regexp (regexp-quote word
))
1904 ;; some chars are left; shorten word
1905 (setq word
(substring word
0 -
1))
1906 (when (= (length word
) 0) ; when nothing left, use next word from list
1907 (setq word
(car words
))
1908 (setq words
(cdr words
))
1909 (setq in-c-backspace nil
))
1911 ;; free top list of overlays and remove list
1912 (setq lines-found
(or (org-index--unhide) lines-wanted
))
1913 (move-overlay org-index--occur-tail-overlay
1914 (if org-index--occur-stack
(cdr (assoc :end-of-visible
(car org-index--occur-stack
)))
1919 ;; highlight shorter word
1920 (unless (= (length word
) 0)
1921 (highlight-regexp (regexp-quote word
) 'isearch
))
1923 ;; make sure, point is still visible
1927 ((member key
(list "SPC" ",")) ; space or comma: enter an additional search word
1929 ;; push current word and clear, no need to change display
1930 (setq words
(cons word words
))
1934 ((string= key
"?") ; question mark: toggle display of headlines and help
1935 (setq help-text
(cons (cdr help-text
) (car help-text
)))
1936 (overlay-put help-overlay
'display
(car help-text
)))
1938 ((and (= (length key
) 1)
1939 (aref printable-chars
(elt key
0))) ; any printable char: add to current search word
1941 ;; unhighlight short word
1942 (unless (= (length word
) 0)
1943 (unhighlight-regexp (regexp-quote word
)))
1946 (setq word
(concat word key
))
1948 ;; make overlays to hide lines, that do not match longer word any more
1950 (setq lines-found
(org-index--hide-with-overlays (cons word words
) lines-wanted
))
1951 (move-overlay org-index--occur-tail-overlay
1952 (if org-index--occur-stack
(cdr (assoc :end-of-visible
(car org-index--occur-stack
)))
1958 ;; highlight longer word
1959 (highlight-regexp (regexp-quote word
) 'isearch
)
1961 ;; make sure, point is on a visible line
1965 ;; anything else terminates loop
1968 ;; put back input event, that caused the loop to end
1969 (unless (string= key
"C-g")
1970 (setq unread-command-events
(listify-key-sequence key-sequence
))
1974 (setq last-point
(point))
1976 ;; For performance reasons do not show matching lines for rest of table. So not code here.
1978 ;; make permanent copy
1979 ;; copy visible lines
1980 (let ((lines-collected 0)
1981 keymap line all-lines
)
1983 (setq cursor-type t
)
1986 ;; collect all visible lines
1987 (while (and (not (eobp))
1988 (< lines-collected lines-wanted
))
1989 ;; skip over invisible lines
1990 (while (and (invisible-p (point))
1992 (goto-char (1+ (overlay-end (car (overlays-at (point)))))))
1993 (setq line
(buffer-substring-no-properties (line-beginning-position) (line-end-position)))
1994 (unless (string= line
"")
1995 (incf lines-collected
)
1996 (setq all-lines
(cons (concat line
2001 (kill-buffer org-index--occur-buffer-name
) ; cannot keep this buffer; might become stale soon
2003 ;; create new buffer
2004 (setq occur-buffer
(get-buffer-create org-index--occur-buffer-name
))
2005 (pop-to-buffer-same-window occur-buffer
)
2008 ;; prepare help text
2009 (setq org-index--occur-help-overlay
(make-overlay (point-min) (point-max)))
2010 (setq org-index--occur-help-text
2013 (concat "Search is done; `?' toggles help and headlines.\n"))
2015 (org-index--wrap (format (concat "Search is done. "
2016 (if (< lines-collected lines-wanted
)
2017 " Showing all %d matches for "
2018 " Showing one window of matches for ")
2020 "\". <return> jumps to heading, <tab> jumps to heading in other window, subcommand \"enter\" to matching line in index.\n" )
2021 (length all-lines
)))
2022 org-index--headings
)))
2024 (overlay-put org-index--occur-help-overlay
'display
(car org-index--occur-help-text
))
2025 (overlay-put org-index--occur-help-overlay
'face
'org-agenda-dimmed-todo-face
)
2028 ;; insert into new buffer
2030 (apply 'insert
(reverse all-lines
))
2031 (if (= lines-collected lines-wanted
)
2032 (insert "\n(more lines omitted)\n")))
2035 (setq truncate-lines t
)
2036 (font-lock-fontify-buffer)
2039 (setq case-fold-search t
)
2040 (setq font-lock-keywords-case-fold-search t
)
2041 (mapc (lambda (w) (unless (or (not w
) (string= w
"")) (highlight-regexp (regexp-quote w
) 'isearch
)))
2044 (setq buffer-read-only t
)
2046 ;; install keyboard-shortcuts
2047 (setq keymap
(make-sparse-keymap))
2048 (set-keymap-parent keymap org-mode-map
)
2050 (mapc (lambda (x) (define-key keymap
(kbd x
)
2051 (lambda () (interactive)
2052 (message (org-index--occur-to-head)))))
2053 (list "<return>" "RET"))
2055 (define-key keymap
(kbd "<tab>")
2056 (lambda () (interactive)
2057 (message (org-index--occur-to-head t
))))
2059 (define-key keymap
(kbd "?")
2060 (lambda () (interactive)
2061 (setq-local org-index--occur-help-text
(cons (cdr org-index--occur-help-text
) (car org-index--occur-help-text
)))
2062 (overlay-put org-index--occur-help-overlay
'display
(car org-index--occur-help-text
))))
2064 (use-local-map keymap
))))
2067 (defun org-index--wrap (text)
2068 "Wrap TEXT at fill column."
2071 (fill-region (point-min) (point-max) nil t
)
2075 (defun org-index--occur-to-head (&optional other
)
2076 "Helper for `org-index--occur', find heading with ref or link; if OTHER, in other window."
2077 (org-index--do-head (org-index--get-field 'ref
)
2078 (org-index--get-field 'link
)
2082 (defun org-index--hide-with-overlays (words lines-wanted
)
2083 "Hide text that is currently visible and does not match WORDS by creating overlays; leave LINES-WANTED lines visible."
2084 (let ((symbol (intern (format "org-index-%d" (length org-index--occur-stack
))))
2086 (end-of-visible (point))
2087 overlay overlays start matched
)
2090 (while (and (not (eobp))
2091 (< lines-found lines-wanted
))
2093 ;; skip invisible lines
2094 (while (and (not (eobp))
2096 (invisible-p (point))
2097 (< (point) (overlay-start org-index--occur-tail-overlay
))))
2098 (goto-char (overlay-end (car (overlays-at (point))))))
2100 ;; find stretch of lines, that are currently visible but should be invisible now
2102 (setq start
(point))
2103 (while (and (not (eobp))
2106 (invisible-p (point))
2107 (< (point) (overlay-start org-index--occur-tail-overlay
))))
2108 (not (and (org-index--test-words words
)
2109 (setq matched t
)))) ; for its side effect
2112 ;; create overlay to hide this stretch
2113 (when (< start
(point)) ; avoid creating an empty overlay
2114 (setq overlay
(make-overlay start
(point)))
2115 (overlay-put overlay
'invisible symbol
)
2116 (setq overlays
(cons overlay overlays
)))
2118 ;; skip and count line, that matched
2121 (setq end-of-visible
(point))
2122 (incf lines-found
)))
2124 ;; put new list on top of stack
2125 (setq org-index--occur-stack
2126 (cons (list (cons :symbol symbol
)
2127 (cons :overlays overlays
)
2128 (cons :end-of-visible end-of-visible
)
2129 (cons :lines lines-found
))
2130 org-index--occur-stack
))
2132 ;; make lines invisible
2133 (add-to-invisibility-spec symbol
)
2138 (defun org-index--unhide ()
2139 "Unhide text that does has been hidden by `org-index--hide-with-overlays'."
2140 (when org-index--occur-stack
2141 ;; make text visible again
2142 (remove-from-invisibility-spec (cdr (assoc :symbol
(car org-index--occur-stack
))))
2146 (cdr (assoc :overlays
(car org-index--occur-stack
))))
2147 ;; remove from stack
2148 (setq org-index--occur-stack
(cdr org-index--occur-stack
))
2149 ;; return number of lines, that are now visible
2150 (if org-index--occur-stack
(cdr (assoc :lines
(car org-index--occur-stack
))))))
2153 (defun org-index--test-words (words)
2154 "Test current line for match against WORDS."
2156 (setq line
(downcase (buffer-substring (line-beginning-position) (line-beginning-position 2))))
2160 (throw 'not-found nil
)))
2164 (defun org-index--create-new-line (create-ref)
2165 "Do the common work for `org-index-new-line' and `org-index'. CREATE-REF asks for new reference."
2171 ;; construct new reference
2173 (setq new
(format "%s%d%s" org-index--head
(1+ org-index--maxref
) org-index--tail
)))
2175 ;; remember for org-mark-ring-goto
2176 (setq org-index--text-to-yank new
))
2178 ;; insert ref or link as very first row
2179 (goto-char org-index--below-hline
)
2180 (org-table-insert-row)
2182 ;; insert some of the standard values
2183 (org-table-goto-column (org-index--column-num 'created
))
2184 (org-insert-time-stamp nil nil t
)
2185 (org-table-goto-column (org-index--column-num 'count
))
2191 (defadvice org-mark-ring-goto
(after org-index--advice-text-to-yank activate
)
2192 "Make text from `org-index' available for yank."
2193 (when org-index--text-to-yank
2194 (kill-new org-index--text-to-yank
)
2195 (message (format "Ready to yank '%s'" org-index--text-to-yank
))
2196 (setq org-index--text-to-yank nil
)))
2199 (provide 'org-index
)
2203 ;; comment-column: 50
2204 ;; lexical-binding: t
2207 ;;; org-index.el ends here