1 ;;; org-index.el --- A personal index for org and beyond
3 ;; Copyright (C) 2011-2014 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 ;; Mark and find your favorite things and org-locations easily:
31 ;; Create and update an index table of references and links. When
32 ;; searching, frequently used entries appear at the top and entering
33 ;; some keywords narrows down to matching entries only, so that the
34 ;; right one can be spotted easily.
36 ;; References are essentially small numbers (e.g. "R237" or "-455-"),
37 ;; as created by this package; they are well suited to be used
38 ;; outside of org. Links are normal org-mode links.
43 ;; - Add these lines to your .emacs (modify appropriately):
45 ;; (require 'org-index)
46 ;; (org-index-default-keybindings) ; optional
48 ;; - Restart your Emacs to make these lines effective.
50 ;; - Invoke `org-index', which will assist in creating your index
51 ;; table. The variable org-index-id will be persisted within your
52 ;; customization file (typically .emacs).
57 ;; See the documentation of `org-index', which can also be read
58 ;; by invoking `org-index' and choosing the help-command.
63 ;; The latest tested version of this file can always be found at:
65 ;; http://orgmode.org/w/org-mode.git?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD
69 ;; [2014-12-14 Su] Version 3.0.2:
70 ;; - Bugfixes in occur mode
71 ;; - New function `org-index-copy-references-from-heading-to-property'
73 ;; [2014-12-10 We] Version 3.0.1:
74 ;; - Bugfixes related with assistant
75 ;; - Fix for editing of category
77 ;; [2014-12-07 Sa] Version 3.0.0:
78 ;; - New commands "add" and "delete" to easily add and remove
79 ;; the current node to or from your index.
80 ;; - New command "example" to create an example index.
81 ;; - Moved flags to a list within the same node as the index table;
82 ;; this breaks compatibility to prior versions of the package.
83 ;; - Several new flags that are explained within index node.
84 ;; - Removed commands "reuse", "missing", "put", "goto",
85 ;; "update", "link", "fill", "unhighlight"
86 ;; - New function `org-index-default-keybindings'
88 ;; [2014-04-26 Sa] Version 2.4.3:
89 ;; - Some Bug fixes and enhancements for occur-command
90 ;; - Fixes for assistant to create index table
92 ;; [2014-02-01 Sa] Version 2.4.2:
93 ;; - Follow mode in occur-buffer
94 ;; - Reorder for x-columns
96 ;; [2014-01-02 Th] Version 2.4.0:
97 ;; - New command "put" to store a nodes reference in a property
98 ;; - New functions org-index-new-line and org-index-get-line
99 ;; offer access to org-index from other lisp programs
100 ;; - New flag p, new columns x1,x2 and x3
101 ;; - Major Code refactoring
102 ;; - Regression tests with ert
103 ;; - Lots of bug fixes
105 ;; [2013-10-04 Fr] Version 2.3.2:
106 ;; - Bug fix: index-table created by assistant is found after
107 ;; restart of emacs instead of invoking assistant again
109 ;; [2013-07-20 Sa] Version 2.3.0:
110 ;; - Renamed from "org-favtable" to "org-index"
111 ;; - Added an assistant to set up the index table
112 ;; - occur is now incremental, searching as you type
113 ;; - simplified the documentation and help-system
114 ;; - Saving keystrokes, as "+g237" is now valid input
117 ;; [2013-02-28 Th] Version 2.2.0:
118 ;; - Allowed shortcuts like "h237" for command "head" with argument "237"
119 ;; - Integrated with org-mark-ring-goto
121 ;; [2013-01-25 Fr] Version 2.1.0:
122 ;; - Added full support for links
123 ;; - New commands "statistics"
124 ;; - Renamed the package from "org-reftable" to "org-favtable"
125 ;; - Additional columns are required (e.g. "link"). Error messages will
128 ;; [2012-12-07 Fr] Version 2.0.0:
129 ;; - The format of the table of favorites has changed ! You need to bring
130 ;; your existing table into the new format by hand (which however is
131 ;; easy and explained below)
132 ;; - Reference table can be sorted after usage count or date of last access
133 ;; - Ask user explicitly, which command to invoke
134 ;; - Renamed the package from "org-refer-by-number" to "org-reftable"
136 ;; [2012-09-22 Sa] Version 1.5.0:
137 ;; - New command "sort" to sort a buffer or region by reference number
138 ;; - New commands "highlight" and "unhighlight" to mark references
140 ;; [2012-07-13 Fr] Version 1.4.0:
141 ;; - New command "head" to find a headline with a reference number
143 ;; [2012-04-28 Sa] Version 1.3.0:
144 ;; - New commands occur and multi-occur
145 ;; - All commands can now be invoked explicitly
146 ;; - New documentation
149 ;; [2011-12-10 Sa] Version 1.2.0:
150 ;; - Fixed a bug, which lead to a loss of newly created reference numbers
151 ;; - Introduced single and double prefix arguments
152 ;; - Started this Change Log
159 (defcustom org-index-id nil
160 "Id of the Org-mode node, which contains the index table."
164 ;; Variables to hold the configuration of the index table
165 (defvar org-index--maxref nil
"Maximum number from reference table (e.g. \"153\").")
166 (defvar org-index--head nil
"Any header before number (e.g. \"R\").")
167 (defvar org-index--tail nil
"Tail after number (e.g. \"}\" or \")\".")
168 (defvar org-index--numcols nil
"Number of columns in index table.")
169 (defvar org-index--ref-regex nil
"Regular expression to match a reference.")
170 (defvar org-index--ref-format nil
"Format, that can print a reference.")
171 (defvar org-index--columns nil
"Columns of index-table.")
172 (defvar org-index--special-columns nil
"Columns with flags, that may appear only once.")
173 (defvar org-index--flagged-columns nil
"Columns with flags, that may appear multiple times.")
174 (defvar org-index--buffer nil
"Buffer of index table.")
175 (defvar org-index--point nil
"Position at start of headline of index table.")
176 (defvar org-index--below-hline nil
"Position of first cell in first line below hline.")
177 (defvar org-index--headings nil
"Headlines of index-table as a string.")
178 (defvar org-index-map nil
"Keymap for shortcuts for some commands of `org-index'. Can be activated and filled by org-index-default-keybings.")
180 ;; Variables to hold context and state
181 (defvar org-index--last-action nil
"Last action performed by `org-index'.")
182 (defvar org-index--text-to-yank nil
"Text, that can be yanked after call (mostly a reference).")
183 (defvar org-index--last-ref nil
"Last reference created or visited.")
184 (defvar org-index--point-before nil
"Point in buffer with index table.")
185 (defvar org-index--point-saved nil
"Saved point if we want to return.")
186 (defvar org-index--category-before nil
"Category of node before.")
187 (defvar org-index--silent nil
"Set to t, if user should not be queried.")
188 (defvar org-index--active-region nil
"Active region, initially. I.e. what has been marked.")
189 (defvar org-index--below-cursor nil
"Word below cursor.")
190 (defvar org-index--within-node nil
"True, if we are within node of the index table.")
191 (defvar org-index--active-window-index nil
"Active window with index table (if any).")
192 (defvar org-index--message-text nil
"Text that was issued as an explanation; helpful for regression tests.")
195 ;; static information for this program package
196 (defconst org-index--commands
'(occur add delete head enter leave ref help example reorder sort multi-occur highlight statistics
) "List of commands available.")
197 (defconst org-index--required-flags
'(sort) "Flags that are required.")
198 (defconst org-index--single-flags
'(sort point-on-add yank-after-add
) "Flags, that may only appear once; these can appear as special-columns.")
199 (defconst org-index--multiple-flags
'(edit-on-add get-category-on-add get-heading-on-add
) "Flags, that might appear multiple times.")
200 (defconst org-index--all-flags
(append org-index--single-flags org-index--multiple-flags
) "All flags.")
201 (defconst org-index--valid-headings
'(ref link created last-accessed count keywords
) "All valid headings.")
202 (defconst org-index--required-headings org-index--valid-headings
"All required headings.")
203 (defconst org-index--sample-flags
205 - columns-and-flags :: associate columns of index table with flags
209 - get-category-on-add
220 - all-columns-explained :: All columns of the index table and their meaning
221 - ref :: The reference number; will be generated automatically
222 - link :: link to the node, that this line represents
223 - created :: When has this entry been created ?
224 - last-accessed :: When has this entry been accessed last ?
225 - count :: How many times has this entry been picked ?
226 - keywords :: List of keywords, which may match your input during occur
227 - all-flags-explained :: All flags, that can be associated with columns
228 - sort :: Sort whole table after this column
229 - yank-after-add :: Let this column be yanked after picking this line
230 - edit-on-add :: Edit this line when adding a new one
231 - point-on-add :: Point will land here, when adding a new line
232 - get-category-on-add :: This column will receive the nodes category during add
233 - get-heading-on-add :: This column will receive the nodes heading during add"
234 "A sample string of flags.")
237 (defun org-index (&optional command
)
238 "Mark and find your favorite things and org-locations easily:
239 Create and update an index table of references and links. When
240 searching, frequently used entries appear at the top and entering
241 some keywords narrows down to matching entries only, so that the
242 right one can be spotted easily.
244 References are essentially small numbers (e.g. \"R237\" or \"-455-\"),
245 as created by this package; they are well suited to be used
246 outside of org. Links are normal `org-mode' links.
249 This is version 3.0.2 of org-index.el .
252 The function `org-index' operates on a dedicated table, the index
253 table, which lives within its own Org-mode node. The table and
254 its containing node will be created, when you first invoke
255 `org-index'. The node will have some comments, describing the
256 columns of the index table and their associated flags. The index
257 table is found through the id of the containing node, which is
258 stored within the variable `org-index-id'.
261 The function `org-index' is the only interactive function of this
262 package and its main entry point; once invoked it asks, which of
263 it subcommands to execute:
265 occur: Incremental search, that shows matching lines from the
266 index table, updated after every keystroke. You may enter a
267 list of words seperated by space or comma (\",\"), to select
268 lines that contain all of the given words.
270 add: Add the current node to your index, so that it can be
271 found through the subcommand \"occur\".
273 delete: Delete the current node from your index.
275 head: Ask for a reference number and search for an entry, which
276 either has this reference contained in its heading or within
277 its property org-index-ref.
279 enter: Enter index table and maybe go to a specific reference.
281 leave: Leave the index table and return to your previous location.
283 ref: Create a new reference.
285 help: Show this text.
287 example: Create a temporary index, that will not be saved, but
288 may serve as an example.
290 reorder: Temporarily reorder the index table, e.g. by count,
291 reference or last access.
293 sort: Sort a set of lines (either from the active region or the
294 whole buffer) by references found in each line.
296 multi-occur: Apply Emacs standard `multi-occur' operation on all
297 `org-mode' buffers to search for the given reference.
299 highlight: Highlight or unhiglight references in active region or buffer.
301 statistics : Show some statistics (e.g. minimum and maximum
302 reference) about index table.
304 If you invoke `org-index' for the first time, an assistant will be
305 invoked, that helps you to create your own, commented index.
307 Use `org-index-default-keybindings' to establish convenient
310 Optional argument COMMAND is a symbol naming the command to execute."
314 (let ((org-index--silent nil
) ; t, if user can be asked
315 prefix-arg
; prefix arg
316 link-id
; link of starting node, if required
317 search
; what to search for
318 guarded-search
; with guard against additional digits
319 search-ref
; search, if search is a reference
320 search-link
; search, if search is a link
321 reorder-once
; column to use for single time sorting
322 kill-new-text
; text that will be appended to kill ring
323 initial-ref-or-link
; initial position in index table
324 message-text
) ; text that will be issued as an explanation
328 ;; Initialize and parse
331 ;; creates index table, if necessary
332 (org-index--verify-id)
334 ;; Get configuration of index table
335 (org-index--parse-table)
337 ;; store context information
338 (org-index--retrieve-context)
342 ;; Find out, what we are supposed to do
345 (when (equal command
'(4))
346 (setq prefix-arg command
)
350 (unless (memq command org-index--commands
)
351 (error "Unknown command '%s' passed as argument, valid choices are any of these symbols: %s"
352 command
(mapconcat 'symbol-name org-index--commands
",")))
353 (let ((r (org-index--read-command))) ; query user if not from argument
354 (setq command
(car r
))
355 (setq reorder-once
(cdr r
))))
359 ;; Get search, if required
362 ;; These actions need a search string:
363 (when (memq command
'(enter head
))
364 ;; Maybe we've got a search string from the arguments
365 (setq search
(org-index--get-or-read-search search command
))
368 (when (string-match org-index--ref-regex search
)
369 (setq search-ref search
)
370 (setq guarded-search
(org-index--make-guarded-search search
)))
371 (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
)
372 (setq search-link search
))))
376 ;; Check for invalid combinations of arguments; try to be helpful
379 (when (and (eq command
'head
)
382 (error "Can do 'head' only for a reference or link (not '%s'), try 'occur' to search for text" search
))
386 ;; Sort and enter table
389 ;; Get link if required before moving in
390 (if (eq command
'add
)
391 (setq link-id
(org-id-get-create)))
393 ;; Save initial ref or link for later return
394 (if (and org-index--within-node
396 (setq initial-ref-or-link
397 (or (org-index--get-field 'ref
)
398 (org-index--get-field 'link
))))
400 ;; These commands enter index table only temporarily
401 (when (memq command
'(occur multi-occur statistics example
))
403 (set-buffer org-index--buffer
)
404 (goto-char org-index--point
)
407 (org-index--sort reorder-once
)
410 ;; These commands will leave user in index table after they are finished
411 (when (memq command
'(enter ref
))
413 ;; Support orgmode-standard of going back (buffer and position)
416 (org-pop-to-buffer-same-window org-index--buffer
)
417 (goto-char org-index--point
)
418 (org-index--unfold-buffer)
421 (org-index--sort reorder-once
)
424 ;; Remember position for leave
425 (if org-index--point-before
426 (setq org-index--point-saved org-index--point-before
)))
428 ;; prepare to return to initial position in index table
429 (when initial-ref-or-link
430 (while (and (org-at-table-p)
432 (string= initial-ref-or-link
(org-index--get-field 'ref
))
433 (string= initial-ref-or-link
(org-index--get-field 'link
)))))
435 ;; did not find ref, go back to top
436 (if (not (org-at-table-p)) (goto-char org-index--point
)))
440 ;; Actually do, what is requested
448 ;; bring up help-buffer for this function
449 (describe-function 'org-index
))
452 ((eq command
'multi-occur
)
454 ;; Position point in index buffer on reference to search for
455 (goto-char org-index--below-hline
)
456 (let (found (initial (point)))
457 (while (and (not found
)
461 (setq found
(string= search
462 (org-index--get-field 'ref
)))))
464 (org-index--update-line nil
)
465 (goto-char initial
)))
467 ;; Construct list of all org-buffers
468 (let (buff org-buffers
)
469 (dolist (buff (buffer-list))
471 (if (string= major-mode
"org-mode")
472 (setq org-buffers
(cons buff org-buffers
))))
475 (multi-occur org-buffers guarded-search
)
478 (if (get-buffer "*Occur*")
480 (setq message-text
(format "multi-occur for '%s'" search
))
482 (toggle-truncate-lines 1))
483 (setq message-text
(format "Did not find '%s'" search
)))))
488 (setq kill-new-text
(org-index--do-add link-id
)))
491 ((eq command
'delete
)
493 (org-index--do-delete))
499 (if (and org-index--within-node
501 (setq link
(org-index--get-field 'link
)))
503 (setq message-text
(org-index--do-head search-ref
(or link search-link
)))))
508 (setq kill-new-text org-index--text-to-yank
)
509 (setq org-index--text-to-yank nil
)
511 ;; If "leave" has been called two times in succession, make
512 ;; org-mark-ring-goto believe it has been called two times too
513 (if (eq org-index--last-action
'leave
)
514 (let ((this-command nil
) (last-command nil
))
515 (org-mark-ring-goto 1))
516 (org-mark-ring-goto))
518 ;; Return to saved position in index buffer
519 (when org-index--point-saved
520 ;; buffer displayed in window need to set point there first
521 (if (eq (window-buffer org-index--active-window-index
)
523 (set-window-point org-index--active-window-index
(marker-position org-index--point-saved
)))
524 ;; set position in buffer in any case and second
525 (with-current-buffer org-index--buffer
526 (goto-char org-index--point-saved
)))
527 (setq org-index--point-saved nil
))
532 ;; Go downward in table to requested reference
533 (goto-char org-index--below-hline
)
535 (let (found (initial (point)))
536 (while (and (not found
)
542 (org-index--get-field
543 (if search-link
'link
'ref
))))))
546 (setq message-text
(format "Found '%s'" search
))
547 (org-index--update-line nil
)
548 (org-table-goto-column (org-index--column-num 'ref
))
549 (if (looking-back " ") (backward-char))
550 ;; remember string to copy
551 (setq org-index--text-to-yank
552 (org-trim (org-table-get-field (org-index--column-num 'copy
)))))
553 (setq message-text
(format "Did not find '%s'" search
))
556 (setq command
'missed
)))
558 ;; simply go into table
559 (setq message-text
"At index table"))
566 (org-index--do-occur))
574 (setq new
(org-index--create-new-line (eq command
'ref
)))
576 ;; fill special columns with standard values
577 (org-table-goto-column (org-index--column-num 'ref
))
579 (setq org-index--last-ref new
)
583 ;; goto point-field or first empty one or first field
584 (if (org-index--special-column 'point-on-add
)
585 (org-table-goto-column (org-index--column-num (org-index--special-column 'point-on-add
)))
586 (unless (catch 'empty
587 (dotimes (col org-index--numcols
)
588 (org-table-goto-column (+ col
1))
589 (if (string= (org-trim (org-table-get-field)) "")
591 ;; none found, goto first
592 (org-table-goto-column 1)))
594 (if org-index--active-region
(setq kill-new-text org-index--active-region
))
595 (setq message-text
(format "Adding a new row with ref '%s'" new
))))
600 ;; sort lines according to contained reference
601 (let (begin end where
)
603 ;; either active region or whole buffer
604 (if (and transient-mark-mode
608 (setq begin
(region-beginning))
609 (setq end
(region-end))
610 (setq where
"region"))
612 (setq begin
(point-min))
613 (setq end
(point-max))
614 (setq where
"whole buffer")
616 (unless (y-or-n-p "Sort whole buffer? ")
617 (setq message-text
"Sort aborted")
618 (throw 'aborted nil
)))
622 (goto-char (point-min))
623 (narrow-to-region begin end
)
624 (sort-subr nil
'forward-line
'end-of-line
626 (if (looking-at (concat ".*"
627 (org-index--make-guarded-search org-index--ref-regex
'dont-quote
)))
628 (string-to-number (match-string 1))
630 (highlight-regexp org-index--ref-regex
'isearch
)
631 (setq message-text
(format "Sorted %s from character %d to %d, %d lines"
633 (count-lines begin end
)))))))
637 ((eq command
'highlight
)
639 (let ((where "buffer"))
642 (when (and transient-mark-mode
644 (narrow-to-region (region-beginning) (region-end))
645 (setq where
"region"))
649 (unhighlight-regexp org-index--ref-regex
)
650 (setq message-text
(format "Removed highlights for references in %s" where
)))
651 (highlight-regexp org-index--ref-regex
'isearch
)
652 (setq message-text
(format "Highlighted references in %s" where
)))))))
655 ((eq command
'statistics
)
657 (setq message-text
(org-index--do-statistics)))
660 ((eq command
'example
)
662 (if (y-or-n-p "This assistand will help you to create a temporary index with detailed comments.\nDo you want to proceed ? ")
663 (org-index--create-index t
)))
666 (t (error "This is a bug: unmatched case '%s'" command
)))
669 ;; remember what we have done for next time
670 (setq org-index--last-action command
)
672 ;; tell, what we have done and what can be yanked
673 (if kill-new-text
(setq kill-new-text
674 (substring-no-properties kill-new-text
)))
675 (if (string= kill-new-text
"") (setq kill-new-text nil
))
678 (if (and message-text kill-new-text
)
680 (if kill-new-text
"R" ""))
681 (if kill-new-text
(format "eady to yank '%s'" kill-new-text
) ""))))
682 (unless (string= m
"")
684 (setq org-index--message-text m
)))
685 (if kill-new-text
(kill-new kill-new-text
))))
688 (defun org-index-default-keybindings ()
689 "Set default keybindings for `org-index'.
691 Establish the common prefix key `C-c i' which is followed by the
692 first letter of a subcommand, so that `C-c i a' invokes the
693 subcommand \"add\". Subcommands available are occur, add, delete,
694 head, enter, leave and ref. As a special case `C-c i i' invokes
695 `org-index' to let you choose."
696 (define-prefix-command 'org-index-map
)
697 (global-set-key (kbd "C-c i") 'org-index-map
)
698 (define-key org-index-map
(kbd "i") (lambda () (interactive) (org-index)))
699 (define-key org-index-map
(kbd "o") (lambda () (interactive) (org-index 'occur
)))
700 (define-key org-index-map
(kbd "a") (lambda () (interactive) (org-index 'add
)))
701 (define-key org-index-map
(kbd "d") (lambda () (interactive) (org-index 'delete
)))
702 (define-key org-index-map
(kbd "h") (lambda () (interactive) (org-index 'head
)))
703 (define-key org-index-map
(kbd "e") (lambda () (interactive) (org-index 'enter
)))
704 (define-key org-index-map
(kbd "l") (lambda () (interactive) (org-index 'leave
)))
705 (define-key org-index-map
(kbd "r") (lambda () (interactive) (org-index 'ref
))))
708 (defun org-index-new-line (&rest keys-values
)
709 "Create a new line within the index table, returning its reference.
711 The function takes a varying number of argument pairs; each pair
712 is a symbol for an existing column heading followed by its value.
716 (org-index-new-line 'ref t 'link \"7f480c3e\")
718 Passing \"'ref t\" will make the function create a new reference
721 Optional argument KEYS-VALUES specifies content of new line."
723 (org-index--verify-id)
724 (org-index--parse-table)
726 (car (org-index--do-new-line keys-values
)))
729 (defun org-index--do-new-line (&rest keys-values
)
730 "Do the work for `org-index-new-line'.
731 Optional argument KEYS-VALUES specifies content of new line."
733 (let ((org-index--silent t
))
736 (org-index--retrieve-context)
737 (with-current-buffer org-index--buffer
738 (goto-char org-index--point
)
740 ;; check arguments early
741 (let ((kvs keys-values
)
747 (unless (memq v
'(t nil
))
748 (error "Column 'ref' accepts only t or nil"))
749 (if (or (not (symbolp k
))
750 (and (symbolp v
) (not (eq v t
)) (not (eq v nil
))))
751 (error "Arguments must be alternation of key and value")))
752 (unless (org-index--column-num k
)
753 (error "Unknown column or column not defined in table: '%s'" (symbol-name k
)))
754 (setq kvs
(cddr kvs
))))
756 (if (and (not (plist-get keys-values
'ref
))
757 (not (stringp (plist-get keys-values
'link
))))
758 (error "Need a link when not creating a ref"))
762 (setq ref
(org-index--create-new-line (plist-get keys-values
'ref
)))
763 (plist-put keys-values
'ref
(or ref
""))
766 (let ((kvs keys-values
)
771 (setq n
(org-index--column-num k
))
772 (org-table-goto-column n
)
774 (setq kvs
(cddr kvs
))))
776 ;; get column to yank
777 (setq yank
(org-trim (org-table-get-field (org-index--column-num (org-index--special-column 'yank-after-add
)))))
783 (defun org-index-get-line (type value
)
784 "Retrieve an existing line within the index table by ref or link.
785 Return its contents as a property list.
787 The function `plist-get' may be used to retrieve specific elements
792 (plist-get (org-index-get-line 'ref \"R12\") 'count)
794 retrieves the value of the count-column for reference number 12.
796 Argument TYPE is a symbol, either ref or link,
797 argument VALUE specifies the value to search for."
799 (unless (memq type
'(ref link
))
800 (error "Argument can only be 'ref' or 'link'"))
802 (org-index--verify-id)
803 (org-index--parse-table)
805 (org-index--get-or-delete-line 'get type value
))
808 (defun org-index--get-or-delete-line (command type value
)
809 "Get or delete (according to COMMAND) a line by TYPE and VALUE."
810 (let ((org-index--silent t
)
814 (org-index--retrieve-context)
815 (with-current-buffer org-index--buffer
816 (goto-char org-index--point
)
818 (goto-char org-index--below-hline
)
819 (while (and (not found
)
821 (when (string= (org-index--get-field type
)
823 ;; found matching line
824 (if (eq command
'get
)
827 (if (and (numberp (cdr x
))
829 (setq found
(cons (car x
) (cons (or (org-index--get-field (car x
)) "") found
)))
830 )) (reverse org-index--columns
))
832 (let ((start (point)))
835 (delete-region start
(point)))))
840 (defun org-index--read-command ()
841 "Find out, what we are supposed to do."
843 (let (reorder-once ; Column to use for single time sorting
847 ;; Ask user, what to do
853 (mapcar 'symbol-name org-index--commands
)
857 (setq command
(intern input
))
859 ;; ask for reorder in loop, because we may have to ask for command right again
860 (if (eq command
'reorder
)
863 (org-icompleting-read
864 "Please choose column to reorder index table once: "
865 (list "ref" "count" "created" "last-accessed")
868 ;; maybe ask initial question again
869 (eq command
'reorder
)))
870 (cons command reorder-once
)))
873 (defun org-index--get-or-read-search (search command
)
874 "Get SEARCH string, maybe read from user; respect COMMAND that will be executed."
876 (let (search-from-table
880 ;; Search string can come from several sources:
881 ;; From link or ref columns of table
882 (when (and org-index--within-node
884 (setq search-from-table
(or (org-index--get-field 'link
)
885 (org-index--get-field 'ref
))))
887 ;; From string below cursor
888 (when (and (not org-index--within-node
)
889 org-index--below-cursor
890 (string-match (concat "\\(" org-index--ref-regex
"\\)")
891 org-index--below-cursor
))
892 (setq search-from-cursor
(match-string 1 org-index--below-cursor
)))
894 ;; Depending on requested action, get search from one of the sources above
895 (cond ((eq command
'enter
)
896 (setq search search-from-cursor
))
897 ((memq command
'(head occur
))
898 (setq search
(or search-from-table search-from-cursor
)))))
901 ;; If we still do not have a search string, ask user explicitly
904 (if org-index--silent
(error "Need to specify search, if silence is required"))
906 (unless (eq command
'occur
)
908 (setq search
(read-from-minibuffer
909 (cond ((eq command
'head
)
910 "Text or reference number to search for: ")
912 "Reference number to search for (or <empty> for id of current node, `l' for last ref created, `t' for top of index table): "))))))
914 ;; Check for special case
915 (when (eq command
'enter
)
916 (if (string= search
"") (setq search
(org-id-get)))
917 (if (string= search
"t") (setq search nil
))
918 (if (string= search
"l") (setq search
(number-to-string org-index--maxref
))))
920 ;; Clean up and examine search string
922 (setq search
(org-trim search
))
923 (if (string= search
"") (setq search nil
))
925 (if (string-match "^[0-9]+$" search
)
926 (setq search
(concat org-index--head search org-index--tail
)))))
931 (defun org-index--verify-id ()
932 "Check, that we have a valid id."
936 (org-index--create-missing-index "Variable org-index-id is not set, so probably no index table has been created yet."))
940 (setq marker
(org-id-find org-index-id
'marker
))
941 (unless marker
(org-index--create-missing-index "Cannot find the node with id \"%s\" (as specified by variable org-index-id)." org-index-id
))
942 ; Try again with new node
943 (setq marker
(org-id-find org-index-id
'marker
))
944 (unless marker
(error "Could not create node"))
945 (setq org-index--buffer
(marker-buffer marker
)
946 org-index--point
(marker-position marker
))
947 (move-marker marker nil
)))
950 (defun org-index--retrieve-context ()
951 "Collect context information before starting with command."
953 ;; Get the content of the active region or the word under cursor
954 (setq org-index--active-region
955 (if (and transient-mark-mode mark-active
)
956 (buffer-substring (region-beginning) (region-end))
958 (setq org-index--below-cursor
(thing-at-point 'symbol
))
960 ;; get category of current node
961 (setq org-index--category-before
962 (save-excursion ; workaround: org-get-category does not give category when at end of buffer
966 ;; Find out, if we are within index table or not
967 (setq org-index--within-node
(string= (org-id-get) org-index-id
))
969 ;; Check and remember, if active window contains buffer with index table
970 (if (eq (window-buffer) org-index--buffer
)
971 (setq org-index--active-window-index
(selected-window)))
973 ;; get current position in index-buffer
974 (with-current-buffer org-index--buffer
975 (setq org-index--point-before
976 (if (string= (org-id-get) org-index-id
)
981 (defun org-index--parse-table ()
982 "Parse content of index table."
990 (with-current-buffer org-index--buffer
992 (setq org-index--maxref
0)
993 (setq initial-point
(point))
995 (org-index--go-below-hline)
998 ;; get headings to display during occur
999 (setq end-of-headings
(point))
1000 (while (org-at-table-p) (forward-line -
1))
1002 (setq start-of-headings
(point))
1003 (setq org-index--headings
(buffer-substring start-of-headings end-of-headings
))
1006 (org-table-goto-column 100)
1007 (setq org-index--numcols
(- (org-table-current-column) 1))
1009 ;; go to top of table
1010 (while (org-at-table-p)
1014 ;; parse line of headings
1015 (org-index--parse-headings)
1018 ;; parse list of flags
1019 (goto-char org-index--point
)
1020 (org-index--parse-flags)
1022 (org-index--go-below-hline)
1023 (setq org-index--below-hline
(point-marker))
1025 ;; Retrieve any decorations around the number within the first nonempty ref-field
1026 (goto-char org-index--below-hline
)
1027 (while (and (org-at-table-p)
1028 (not (setq ref-field
(org-index--get-field 'ref
))))
1033 (org-index--report-index-error "Reference column is empty"))
1035 (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field
)
1036 (org-index--report-index-error
1037 "First reference in index table ('%s') does not contain a number" ref-field
))
1039 ;; These are the decorations used within the first ref of index
1040 (setq org-index--head
(match-string 1 ref-field
))
1041 (setq org-index--tail
(match-string 3 ref-field
))
1042 (setq org-index--ref-regex
(concat (regexp-quote org-index--head
)
1044 (regexp-quote org-index--tail
)))
1045 (setq org-index--ref-format
(concat org-index--head
"%d" org-index--tail
))
1047 ;; Go through table to find maximum number and do some checking
1050 (while (org-at-table-p)
1052 (setq ref-field
(org-index--get-field 'ref
))
1053 (setq link-field
(org-index--get-field 'link
))
1055 (when (and (not ref-field
)
1058 (message "Removing line from index-table with both ref and link empty"))
1061 (if (string-match org-index--ref-regex ref-field
)
1063 (setq ref
(string-to-number (match-string 1 ref-field
)))
1065 (message "Removing line from index-table whose ref does not contain a number")))
1067 ;; check, if higher ref
1068 (if (> ref org-index--maxref
) (setq org-index--maxref ref
))
1072 ;; go back to initial position
1073 (goto-char initial-point
))))
1076 (defun org-index--sort (&optional sort-column
)
1077 "Sort index table maybe according to SORT-COLUMN."
1079 (unless sort-column
(setq sort-column
(org-index--special-column 'sort
)))
1081 (let ((is-modified (buffer-modified-p))
1087 (unless buffer-read-only
1089 ;; get boundaries of table
1090 (goto-char org-index--below-hline
)
1093 (while (org-at-table-p) (forward-line))
1095 ;; Kill all empty rows at bottom
1098 (org-table-goto-column 1)
1100 (not (org-index--get-field 'ref
))
1101 (not (org-index--get-field 'link
))))
1102 (org-table-kill-row))
1104 (setq bottom
(point))
1107 (narrow-to-region top bottom
)
1114 (ref-field (or (org-index--get-field 'ref
) ""))
1115 (count-field (or (org-index--get-field 'count
) "")))
1117 ;; get reference with leading zeroes, so it can be
1119 (string-match org-index--ref-regex ref-field
)
1123 (or (match-string 1 ref-field
)
1126 ;; Construct different sort-keys according to
1127 ;; requested sort column
1130 ((eq sort-column
'count
)
1133 (string-to-number (or (org-index--get-field 'count
)
1137 ((eq sort-column
'ref
)
1140 ((eq sort-column
'last-accessed
)
1141 (concat (org-index--get-field sort-column
)
1145 (t (error "This is a bug: unmatched case '%s'" sort-column
)))))
1149 ;; restore modification state
1150 (set-buffer-modified-p is-modified
))))
1153 (defun org-index--go-below-hline ()
1154 "Move below hline in index-table."
1157 (errstring (format "index table within node %s" org-index-id
)))
1159 (goto-char org-index--point
)
1161 ;; go to heading of node
1162 (while (not (org-at-heading-p)) (forward-line -
1))
1165 ;; go to first table, but make sure we do not get into another node
1166 (while (and (not (org-at-table-p))
1167 (not (org-at-heading-p))
1171 ;; check, if there really is a table
1172 (unless (org-at-table-p)
1173 (org-index--create-missing-index "Cannot find %s." errstring
))
1175 ;; go just after hline
1176 (while (and (not (org-at-table-hline-p))
1182 (unless (org-at-table-p)
1183 (org-index--report-index-error "Cannot find a hline within %s" errstring
))
1185 (org-table-goto-column 1)))
1188 (defun org-index--align ()
1189 "Align index table without setting its buffer modified."
1190 (let ((is-modified (buffer-modified-p)))
1191 (unless buffer-read-only
(org-table-align))
1192 (set-buffer-modified-p is-modified
)
1193 (org-index--go-below-hline)
1194 (setq org-index--below-hline
(point-marker))))
1197 (defun org-index--parse-headings ()
1198 "Parse headings of index table."
1200 (let (field ;; field content
1201 field-symbol
;; and as a symbol
1204 (setq org-index--columns nil
)
1207 (dotimes (col org-index--numcols
)
1209 (setq field
(substring-no-properties (downcase (org-trim (org-table-get-field (+ col
1))))))
1211 (if (string= field
"")
1212 (error "Column name cannot be empty"))
1213 (if (and (not (string= (substring field
0 1) "."))
1214 (not (member (intern field
) org-index--valid-headings
)))
1215 (error "Column name '%s' is not a valid heading (custom headings may start with a dot (e.g. '.foo')" field
))
1217 (setq field-symbol
(intern field
))
1219 ;; check if heading has already appeared
1220 (if (assoc field-symbol org-index--columns
)
1221 (org-index--report-index-error
1222 "'%s' appears two times as column heading" (downcase field
))
1223 ;; add it to list at front, reverse later
1224 (setq org-index--columns
(cons (cons field-symbol
(+ col
1)) org-index--columns
)))))
1226 (setq org-index--columns
(reverse org-index--columns
))
1228 ;; check if all necessary headings have appeared
1229 (mapc (lambda (head)
1230 (unless (cdr (assoc head org-index--columns
))
1231 (org-index--report-index-error "No column has heading '%s'" head
)))
1232 org-index--required-headings
))
1235 (defun org-index--parse-flags ()
1236 "Parse list of flags in index table."
1238 (let (parent parent-is-comment child
)
1240 ;; reset configuration variables
1241 (setq org-index--special-columns nil
)
1242 (setq org-index--flagged-columns nil
)
1244 (org-index--goto-list "columns-and-flags" t
)
1247 ;; outer loop over columns
1248 (while (and (setq parent
(org-index--parse-list-item))
1250 (> (cdr (assoc :indent parent
)) 0))
1252 (setq parent-is-comment
(member (cdr (assoc :text parent
)) '("all-columns-explained" "all-flags-explained")))
1254 ;; check, that we have a valid heading
1255 (unless (or parent-is-comment
1256 (assoc (cdr (assoc :sym parent
)) org-index--columns
))
1257 (org-index--report-index-error "'%s' is not a valid column" (cdr (assoc :text parent
))))
1259 ;; inner loop over children
1260 (while (and (forward-line 1)
1261 (setq child
(org-index--parse-list-item))
1263 (> (cdr (assoc :indent child
))
1264 (cdr (assoc :indent parent
))))
1266 (unless parent-is-comment
1267 ;; check, that we have a valid flag
1268 (unless (memq (cdr (assoc :sym child
)) org-index--all-flags
)
1269 (org-index--report-index-error "'%s' is not a valid flag" (cdr (assoc :text child
))))
1271 ;; process flag with respect to current index-column
1272 (if (memq (cdr (assoc :sym child
)) org-index--single-flags
)
1273 ;; Check, that none of org-index--single-flags appears twice
1274 (if (assoc (cdr (assoc :sym child
)) org-index--special-columns
)
1275 (org-index--report-index-error
1276 "More than one column is marked with flag '%s'" (cdr (assoc :text child
)))
1278 (setq org-index--special-columns
(cons (cons (cdr (assoc :sym child
)) (cdr (assoc :sym parent
)))
1279 org-index--special-columns
))))
1281 ;; all flags are stored in org-index--flagged-columns
1282 (let ((l (assoc (cdr (assoc :sym child
)) org-index--flagged-columns
))) ;; list of flag and columns, that carry this flag
1284 ;; no list of columns with this flag is present, create one
1285 (setq org-index--flagged-columns
1286 (cons (cons (cdr (assoc :sym child
)) nil
)
1287 org-index--flagged-columns
))
1288 (setq l
(car org-index--flagged-columns
)))
1289 ;; prepend this column to list of columns with this flag
1290 (setcdr l
(cons (cdr (assoc :sym parent
)) (cdr l
)))))))
1292 ;; check, that all needed flags have been specified
1294 (unless (assoc x org-index--special-columns
)
1295 (org-index--report-index-error "Required flag '%s' does not appear" (substring (symbol-name x
) 1))))
1296 org-index--required-flags
)))
1299 (defun org-index--goto-list (name &optional required non-top
)
1300 "Goto list NAME (maybe NON-TOP Level) in index node, err if REQUIRED list is not present."
1301 (goto-char org-index--point
)
1303 ;; go to heading of node
1304 (while (not (org-at-heading-p)) (forward-line -
1))
1308 (while (and (not (let ((item (org-index--parse-list-item)))
1310 (and (or non-top
(= (cdr (assoc :indent item
)) 0)) ;; accept only toplevel ?
1311 (string= (cdr (assoc :text item
)) name
)) ;; with requested name
1313 (not (org-at-table-p))
1314 (not (org-at-heading-p))
1321 (org-index--report-index-error "Could not find required list '%s'" name
)
1325 (defun org-index--parse-list-item ()
1326 "Parse a list item into an assoc array (indent, checkbox, text, value)."
1328 (if (looking-at org-list-full-item-re
)
1330 ;; retrieve interesting parts of list item from match data
1331 (let (alist indent checkbox text value
)
1333 (setq indent
(save-excursion
1334 (goto-char (match-beginning 1))
1336 (decf indent
(+ (save-match-data (org-current-level)) 1))
1337 (add-to-list 'alist
(cons :indent indent
))
1339 (setq checkbox
(match-string 3))
1341 (setq text
(match-string 4))
1342 (setq value
(buffer-substring
1344 (save-excursion (end-of-line) (point))))
1350 (add-to-list 'alist
(cons :text text
))
1351 (add-to-list 'alist
(cons :value value
))
1353 (add-to-list 'alist
(cons :sym
(intern text
)))
1356 (mapc (lambda (x) (if (stringp (cdr x
)) (setf (cdr x
) (org-trim (substring-no-properties (cdr x
)))))) alist
)
1364 (defun org-index--create-missing-index (&rest reasons
)
1365 "Create a new empty index table with detailed explanation. Argument REASONS explains why."
1367 (org-index--ask-before-create-index "Cannot find your index table: "
1370 (org-index--create-index))
1374 (defun org-index--report-index-error (&rest reasons
)
1375 "Report an error (explained by REASONS) with the existing index and offer to create a valid one to compare with."
1377 (org-index--ask-before-create-index "The existing index contains this error: "
1378 "temporary" ", to compare with."
1380 (org-index--create-index t t
))
1384 (defun org-index--ask-before-create-index (explanation type for-what reasons
)
1385 ; checkdoc-params: (explanation type for-what reasons)
1386 "Ask the user before creating an index or throw error. Arguments specify bits of issued message."
1387 (let (reason prompt
)
1389 (setq reason
(apply 'format reasons
))
1390 (if org-index--silent
(error (concat explanation reason
))) ; cannot proceed without querying the user
1392 (setq prompt
(concat explanation reason
"\n\n"
1393 "However, this assistant can help you to create a "
1394 type
" index with detailed comments" for-what
"\n\n"
1395 "Do you want to proceed ?"))
1397 (unless (let ((max-mini-window-height 1.0))
1399 (error explanation reason
))))
1403 (defun org-index--create-index (&optional temporary compare
)
1404 "Create a new empty index table with detailed explanation.
1405 specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existing index."
1412 (let ((file-name (concat temporary-file-directory
"org-index--example-index.org"))
1413 (buffer-name "*org-index-example-index*"))
1414 (setq buffer
(get-buffer-create buffer-name
))
1415 (with-current-buffer buffer
1416 ;; but it needs a file for its index to be found
1417 (unless (string= (buffer-file-name) file-name
)
1418 (set-visited-file-name file-name
))
1419 (rename-buffer buffer-name
) ; name is change by line above
1424 (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
))))
1426 (setq title
(read-from-minibuffer "Please enter the title of the index node: "))
1429 (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: "))
1431 (when (string-match "[[:blank:]]" firstref
)
1432 (setq desc
"Contains whitespace"))
1433 (when (string-match "[[:cntrl:]]" firstref
)
1434 (setq desc
"Contains control characters"))
1435 (unless (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref
)
1436 ;; firstref not okay, report details
1438 (cond ((string= firstref
"") "is empty")
1439 ((not (string-match "^[^0-9]+" firstref
)) "starts with a digit")
1440 ((not (string-match "^[^0-9]+[0-9]+" firstref
)) "does not contain a number")
1441 ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref
)) "contains more than one sequence of digits")
1446 (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s.\nPlease hit RET and try again: " firstref desc
))
1450 (with-current-buffer buffer
1451 (goto-char (point-max))
1452 (insert (format "* %s %s\n" firstref title
))
1455 Below you find your temporary index table, which will not last longer
1456 than your current emacs session.
1459 Below you find your initial index table, which will grow over time.
1462 You may start using it by adding some lines. Just move to
1463 another heading, invoke `org-index' and choose the command
1464 \"add\". After adding a few nodes, try the command \"occur\"
1465 to search among them.
1467 To gain further insight you may invoke the subcommand \"help\", or
1468 read the description of `org-index'.
1470 Within the index table below, dhe sequence of columns does not
1471 matter. You may reorder them any way you like. Columns are
1472 found by their heading. You may also add your own columns.
1474 Following these explanations there is the item-list
1475 `columns-and-flags', which influences the behaviour of
1476 `org-index'. See the explanations which are part of this list.
1478 This node needs not be a top level node; its name is completely
1479 at your choice; it is found through its ID only.
1481 Remark: These lines of explanation can be removed at any time.
1484 (setq id
(org-id-get-create))
1489 | ref | .category | keywords | count | last-accessed | created | link |
1491 |-----+-----------+----------+-------+---------------+---------+------|
1492 | %s | | %s | | | %s | %s |
1495 org-index--sample-flags
1498 (with-temp-buffer (org-insert-time-stamp nil nil t
))
1501 ;; make sure, that node can be found
1502 (org-id-add-location id
(buffer-file-name))
1503 (setq buffer-save-without-query t
)
1506 (while (not (org-at-table-p)) (forward-line -
1))
1507 (unless buffer-read-only
(org-table-align))
1508 (while (not (org-at-heading-p)) (forward-line -
1))
1510 ;; read back some info about new index
1511 (let ((org-index-id id
))
1512 (org-index--verify-id))
1514 ;; present results to user
1517 ;; Present existing and temporary index together
1519 (org-pop-to-buffer-same-window org-index--buffer
)
1520 (goto-char org-index--point
)
1521 (org-index--unfold-buffer)
1522 (delete-other-windows)
1523 (select-window (split-window-vertically)))
1525 (org-pop-to-buffer-same-window buffer
)
1527 (org-index--unfold-buffer)
1529 (error "Please compare your existing index (upper window) and a temporary new one (lower window) to fix your index")
1530 (message "This is your new temporary index.")))
1532 ;; Only show the new index
1533 (org-pop-to-buffer-same-window buffer
)
1534 (delete-other-windows)
1536 (org-index--unfold-buffer)
1537 (setq org-index-id id
)
1538 (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 ? ")
1540 (customize-save-variable 'org-index-id id
)
1541 (error "Saved org-index-id '%s' to %s" id
(or custom-file
1544 (setq sq
(format "(setq org-index-id \"%s\")" id
))
1546 (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
))))))))
1549 (defun org-index--unfold-buffer ()
1550 "Helper function to unfold buffer."
1555 (org-back-to-heading)
1556 (forward-line) ;; on property drawer
1558 (org-index--goto-list "columns-and-flags")
1562 (defun org-index--update-line (ref-or-link)
1563 "Update columns count and last-accessed in line REF-OR-LINK."
1568 (with-current-buffer org-index--buffer
1569 (unless buffer-read-only
1571 ;; search reference or link, if given (or assume, that we are already positioned right)
1573 (setq initial
(point))
1574 (goto-char org-index--below-hline
)
1575 (while (and (org-at-table-p)
1576 (not (or (string= ref-or-link
(org-index--get-field 'ref
))
1577 (string= ref-or-link
(org-index--get-field 'link
)))))
1580 (if (not (org-at-table-p))
1581 (error "Did not find reference or link '%s'" ref-or-link
)
1582 (org-index--update-current-line))
1584 (if initial
(goto-char initial
))))))
1587 (defun org-index--update-current-line ()
1588 "Update current lines columns count and last-accessed."
1589 (let (newcount (count-field (org-index--get-field 'count
)))
1591 ;; update count field only if number or empty
1592 (when (or (not count-field
)
1593 (string-match "^[0-9]+$" count-field
))
1594 (setq newcount
(+ 1 (string-to-number (or count-field
"0"))))
1595 (org-index--get-field 'count
1596 (number-to-string newcount
)))
1599 (org-table-goto-column (org-index--column-num 'last-accessed
))
1600 (org-table-blank-field)
1601 (org-insert-time-stamp nil t t
)))
1604 (defun org-index--get-field (key &optional value
)
1605 "Retrieve field KEY from index table or set it to VALUE."
1608 (setq field
(org-trim (org-table-get-field (cdr (assoc key org-index--columns
)) value
)))
1609 (if (string= field
"") (setq field nil
))
1611 (org-no-properties field
))))
1614 (defun org-index--column-num (key)
1615 "Return number of column KEY."
1618 (cdr (assoc key org-index--columns
))))
1621 (defun org-index--special-column (key)
1622 "Return column (not a number) for special column KEY."
1623 (cdr (assoc key org-index--special-columns
)))
1626 (defun org-index--flag-p (flag column
)
1627 "Check if COLUMN has FLAG set."
1628 (unless (memq flag org-index--all-flags
)
1629 (error (format "Internal error: unknown flag %s" (symbol-name flag
))))
1630 (memq column
(assoc flag org-index--flagged-columns
)))
1633 (defun org-index--make-guarded-search (ref &optional dont-quote
)
1634 "Make robust search string from REF; DONT-QUOTE it, if requested."
1635 (concat "\\_<" (if dont-quote ref
(regexp-quote ref
)) "\\_>"))
1638 (defun org-index--do-statistics ()
1639 "Compute statistics about index table."
1648 ;; go through table and remove all refs, that we see
1649 (goto-char org-index--below-hline
)
1650 (while (org-at-table-p)
1652 ;; get ref-field and number
1653 (setq ref-field
(org-index--get-field 'ref
))
1655 (string-match org-index--ref-regex ref-field
))
1656 (setq ref
(string-to-number (match-string 1 ref-field
))))
1658 ;; record min and max
1659 (if (or (not min
) (< ref min
)) (setq min ref
))
1660 (if (or (not max
) (> ref max
)) (setq max ref
))
1663 (setq total
(1+ total
))
1667 (setq message
(format "Found %d references from %s to %s."
1669 (format org-index--ref-format min
)
1670 (format org-index--ref-format max
)))
1675 (defun org-index--do-add (link-id)
1676 "For current node (with id LINK-ID): add a new line to index table."
1678 (let ((args (list 'ref t
'link link-id
))
1679 ref-and-yank content
)
1681 (unless (org-at-heading-p)
1682 (error "Not at headline"))
1684 ;; some fields want to be edited
1685 (dolist (col-num org-index--columns
)
1690 (if (org-index--flag-p 'get-heading-on-add
(car col-num
))
1691 (setq content
(nth 4 (org-heading-components))))
1694 (if (org-index--flag-p 'get-category-on-add
(car col-num
))
1695 (setq content org-index--category-before
))
1697 (if (org-index--flag-p 'edit-on-add
(car col-num
))
1698 (setq content
(read-from-minibuffer
1699 (format "Edit text for column '%s': " (symbol-name (car col-num
)))
1702 (if (not (string= content
""))
1703 (setq args
(append (list (car col-num
) content
) args
))))
1705 ;; new line in index table
1706 (setq ref-and-yank
(apply 'org-index--do-new-line args
))
1709 (org-entry-put (point) "org-index-ref" (car ref-and-yank
))
1711 (cdr ref-and-yank
)))
1714 (defun org-index--do-delete ()
1715 "Perform command delete."
1717 (unless (org-at-heading-p)
1718 (error "Not at headline"))
1720 (let ((ref (org-entry-get (point) "org-index-ref")))
1722 ;; delete from index table
1723 (org-index--get-or-delete-line 'delete
'ref ref
)
1725 ;; delete from property
1726 (org-entry-delete (point) "org-index-ref")
1728 ;; maybe delete from heading
1731 (let ((end (point)))
1733 (when (search-forward ref end t
)
1734 (delete-char (- (length ref
)))
1735 (just-one-space))))))
1738 (defun org-index--do-head (ref link
&optional other
)
1739 "Perform command head: Find node with REF or LINK and present it; if OTHER in separate window."
1741 (if ref
(setq org-index--last-ref ref
))
1742 (let (message marker
)
1744 ;; Prefer link if available
1746 (setq marker
(org-id-find link t
))
1749 (message (format "Scanning headlines for '%s' ..." ref
))
1752 (when (string= ref
(org-entry-get (point) "org-index-ref"))
1753 (throw 'found
(point-marker))))
1759 (org-index--update-line (or link ref
))
1761 (setq message
"Followed link")
1762 (setq message
(format "Found '%s'" ref
)))
1765 (pop-to-buffer (marker-buffer marker
))
1770 (pop-to-buffer "*org-index-occur*"))
1771 (org-pop-to-buffer-same-window (marker-buffer marker
))
1776 (setq message
(format "Did not find link '%s'" link
))
1777 (setq message
(format "Did not find '%s'. Note: References in headings are no longer found in recent versions of this package; simply call `org-index-copy-references-from-heading-to-property' once to fix this." ref
))))
1782 (defun org-index-copy-references-from-heading-to-property ()
1783 "Loop over all headings and copy; needs to be done only once"
1786 (org-index--verify-id)
1787 (org-index--parse-table)
1789 (if (y-or-n-p "This function will scan all headings and copy any reference to the property. Do you want to proceed? ")
1791 (message "Scanning headlines ...")
1792 (setq results
(org-map-entries
1794 (let (ref-from-head ref-from-property
)
1795 (when (looking-at (concat ".*\\("
1796 (org-index--make-guarded-search org-index--ref-regex
'dont-quote
)
1799 (setq ref-from-head
(match-string 1))
1800 (setq ref-from-property
(org-entry-get (point) "org-index-ref"))
1802 (when (and (not (string= ref-from-head ref-from-property
)) ; ref from head is not in property
1803 (< (org-element-property :level
(org-element-at-point)) ; node is not an inline task
1804 org-inlinetask-min-level
)
1805 (org-index--get-or-delete-line 'get
'ref ref-from-head
)) ; ref appears in index table
1806 (org-entry-put (point) "org-index-ref" ref-from-head
)
1809 (message "Scanned %d entries, %d of them needed to be and were fixed." (length results
) (count 1 results
)))
1810 (message "Please note, that some headings may not be found. Call this function once to fix this.")))
1813 (defun org-index--do-occur ()
1814 "Perform command occur."
1815 (let ((occur-buffer-name "*org-index-occur*")
1816 (word "") ; last word to search for growing and shrinking on keystrokes
1817 (prompt "Search for: ")
1819 (key-help "<up>, <down> move. <return> finds node, <tab> finds in other window.\n")
1820 words
; list of other words that must match too
1822 lines-to-show
; number of lines to show in window
1823 start-of-lines
; position, where lines begin
1824 start-of-help
; start of displayed help (if any)
1825 left-off-at
; stack of last positions in index table
1826 after-inserted
; in occur-buffer
1827 at-end
; in occur-buffer
1828 lines-visible
; in occur-buffer
1829 below-hline-bol
; below-hline and at bol
1830 exit-gracefully
; true if normal exit
1831 in-c-backspace
; true while processing C-backspace
1832 show-headings
; true, if headings should be shown
1833 fun-on-ret
; function to be executed, if return is pressed
1834 fun-on-tab
; function to be executed, if tab is pressed
1838 (if (get-buffer "*org-index-occur*")
1839 (kill-buffer occur-buffer-name
))
1840 (setq occur-buffer
(get-buffer-create "*org-index-occur*"))
1842 ;; install keyboard-shortcuts within occur-buffer
1843 (with-current-buffer occur-buffer
1844 (let ((keymap (make-sparse-keymap)))
1846 (set-keymap-parent keymap org-mode-map
)
1847 (setq fun-on-ret
(lambda () (interactive) (org-index--occur-find-heading)))
1848 (define-key keymap
[return] fun-on-ret)
1849 (setq fun-on-tab (lambda () (interactive)
1850 (org-index--occur-find-heading t)))
1851 (define-key keymap [tab] fun-on-tab)
1852 (define-key keymap [(control ?i)] fun-on-tab)
1853 (use-local-map keymap)))
1855 (with-current-buffer org-index--buffer
1856 (let ((initial (point)))
1857 (goto-char org-index--below-hline)
1859 (setq below-hline-bol (point))
1860 (goto-char initial)))
1862 (org-pop-to-buffer-same-window occur-buffer)
1863 (toggle-truncate-lines 1)
1865 (unwind-protect ; to reset cursor-shape even in case of errors
1870 (insert (concat "Incremental search, showing one window of matches. '?' toggles help.\n\n"))
1871 (setq start-of-lines (point-marker))
1872 (setq start-of-help start-of-lines)
1873 (setq cursor-type 'hollow)
1875 ;; get window size of occur-buffer as number of lines to be searched
1876 (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1))
1879 (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol))
1881 (insert (nth 1 ret))
1882 (setq left-off-at (cons (nth 0 ret) nil))
1883 (setq after-inserted (cons (point) nil)))
1888 (goto-char start-of-lines)
1889 (setq lines-visible 0)
1892 (setq key 'backspace)
1893 (let ((search-text (mapconcat 'identity (reverse (cons word words)) ",")))
1898 (if (string= search-text "") "" " ")
1901 (setq exit-gracefully (member key (list 'up 'down 'left 'right 'RET ?\C-g ?\C-m
1902 'C-return 'S-return ?\C-i 'TAB))))
1905 (not exit-gracefully))
1909 ((eq key 'C-backspace)
1911 (setq in-c-backspace t))
1913 ((member key (list 'backspace 'deletechar ?\C-?)) ; erase last char
1915 (if (= (length word) 0)
1917 ;; nothing more to delete from current word; try next
1919 (setq word (car words))
1920 (setq words (cdr words))
1921 (setq in-c-backspace nil))
1923 ;; unhighlight longer match
1924 (let ((case-fold-search t))
1925 (unhighlight-regexp (regexp-quote word)))
1927 ;; some chars are left; shorten word
1928 (setq word (substring word 0 -1))
1929 (when (= (length word) 0) ; when nothing left, use next word from list
1930 (setq word (car words))
1931 (setq words (cdr words))
1932 (setq in-c-backspace nil))
1934 ;; remove everything, that has been added for char just deleted
1935 (when (cdr after-inserted)
1936 (setq after-inserted (cdr after-inserted))
1937 (goto-char (car after-inserted))
1938 (delete-region (point) (point-max)))
1940 ;; back up last position in index table too
1941 (when (cdr left-off-at)
1942 (setq left-off-at (cdr left-off-at)))
1944 ;; go through buffer and check, if any invisible line should now be shown
1945 (goto-char start-of-lines)
1946 (while (< (point) (point-max))
1947 (if (outline-invisible-p)
1949 (setq from (line-beginning-position)
1950 to (line-beginning-position 2))
1952 ;; check for matches
1953 (when (org-index--test-words (cons word words) (buffer-substring from to))
1954 (when (<= lines-visible lines-to-show) ; show, if more lines required
1955 (outline-flag-region from to nil)
1956 (incf lines-visible))))
1958 ;; already visible, just count
1959 (incf lines-visible))
1963 ;; highlight shorter word
1964 (unless (= (length word) 0)
1965 (let ((case-fold-search t))
1966 (highlight-regexp (regexp-quote word) 'isearch)))))
1969 ((member key (list ?\s ?,)) ; space or comma: enter an additional search word
1971 ;; push current word and clear, no need to change display
1972 (setq words (cons word words))
1976 ((eq key ??) ; question mark: toggle display of headlines and help
1977 (setq show-headings (not show-headings))
1978 (goto-char start-of-lines)
1983 (setq start-of-help (point-marker))
1984 (insert "Normal keys add to search word, SPACE or COMMA start new word, BACKSPACE and C-BACKSPACE erase char or word. Every other key ends search. ")
1986 (goto-char start-of-help)
1988 (goto-char start-of-lines)
1989 (insert org-index--headings))
1990 (delete-region start-of-help start-of-lines)
1992 (setq start-of-lines (point-marker)))
1995 ((and (integerp key)
1996 (aref printable-chars key)) ; any printable char: add to current search word
1998 ;; unhighlight short word
1999 (unless (= (length word) 0)
2000 (let ((case-fold-search t))
2001 (unhighlight-regexp (regexp-quote word))))
2004 (setq word (concat word (char-to-string key)))
2006 ;; hide lines, that do not match longer word any more
2007 (while (< (point) (point-max))
2008 (unless (outline-invisible-p)
2009 (setq from (line-beginning-position)
2010 to (line-beginning-position 2))
2012 ;; check for matches
2013 (if (org-index--test-words (list word) (buffer-substring from to))
2014 (incf lines-visible) ; count as visible
2015 (outline-flag-region from to t))) ; hide
2019 ;; duplicate top of stacks; eventually overwritten below
2020 (setq left-off-at (cons (car left-off-at) left-off-at))
2021 (setq after-inserted (cons (car after-inserted) after-inserted))
2023 ;; get new lines from index table
2024 (when (< lines-visible lines-to-show)
2025 (setq ret (org-index--get-matching-lines (cons word words)
2026 (- lines-to-show lines-visible)
2030 (insert (nth 1 ret))
2031 (setq at-end (nth 2 ret))
2032 (setcar left-off-at (nth 0 ret))
2033 (setcar after-inserted (point))))
2035 ;; highlight longer word
2036 (let ((case-fold-search t))
2037 (highlight-regexp (regexp-quote word) 'isearch)))
2040 (t ; non-printable chars
2041 (setq hint (format "(cannot search for key '%s', use %s to quit)"
2044 (key-description (char-to-string key)))
2045 (substitute-command-keys "\\[keyboard-quit]"))))))
2047 ;; search is done collect and brush up results
2048 ;; remove any lines, that are still invisible
2049 (goto-char start-of-lines)
2050 (while (< (point) (point-max))
2051 (if (outline-invisible-p)
2052 (delete-region (line-beginning-position) (line-beginning-position 2))
2055 ;; postprocessing even for non graceful exit
2056 (setq cursor-type t)
2057 ;; replace previous heading
2058 (let ((numlines (count-lines (point) start-of-lines)))
2059 (goto-char start-of-lines)
2060 (delete-region (point-min) (point))
2061 (insert (format (concat (if exit-gracefully "Search is done;" "Search aborted;")
2063 " showing all %d matches. "
2064 " showing one window of matches. ")
2068 (setq start-of-lines (point-marker))
2069 (goto-char (point-min))
2071 (goto-char start-of-lines)
2072 (if show-headings (insert "\n\n" org-index--headings)))
2075 ;; perform action according to last char
2079 ((member key (list 'RET ?\C-m))
2080 (funcall fun-on-ret))
2082 ((member key (list 'TAB ?\C-i))
2083 (funcall fun-on-tab))
2089 (forward-line 1)))))
2092 (defun org-index--occur-find-heading (&optional other)
2093 "Helper for keymap of occur: find heading, if other in other window and expand."
2095 (let ((ref (org-index--get-field 'ref))
2096 (link (org-index--get-field 'link)))
2097 (message (org-index--do-head ref link other)))))
2100 (defun org-index--create-new-line (create-ref)
2101 "Do the common work for `org-index-new-line' and `org-index'. CREATE-REF asks for new reference."
2107 ;; construct new reference
2109 (setq new (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail)))
2111 ;; remember for org-mark-ring-goto
2112 (setq org-index--text-to-yank new))
2114 ;; insert ref or link as very first row
2115 (goto-char org-index--below-hline)
2116 (org-table-insert-row)
2118 ;; insert some of the standard values
2119 (org-table-goto-column (org-index--column-num 'created))
2120 (org-insert-time-stamp nil nil t)
2121 (org-table-goto-column (org-index--column-num 'count))
2127 (defun org-index--get-matching-lines (words numlines start-from)
2128 "Helper for occur: search for WORDS and get NUMLINES lines from index table, starting at START-FROM."
2131 initial line lines at-end)
2133 (with-current-buffer org-index--buffer
2135 ;; remember initial pos and start at requested
2136 (setq initial (point))
2137 (goto-char start-from)
2139 ;; loop over buffer until we have found enough lines
2140 (while (and (or (< numfound numlines)
2145 (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2)))
2146 (when (org-index--test-words words line)
2147 (setq lines (concat lines line))
2152 (setq at-end (not (org-at-table-p)))
2154 ;; return to initial position
2155 (goto-char initial))
2157 (unless lines (setq lines ""))
2158 (list pos lines at-end)))
2161 (defun org-index--test-words (words line)
2162 "Test LINE for match against WORDS."
2163 (let ((found-all t))
2164 (setq line (downcase line))
2168 (throw 'not-found nil)))
2172 (defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate)
2173 "Make text from `org-index' available for yank."
2174 (when org-index--text-to-yank
2175 (kill-new org-index--text-to-yank)
2176 (message (format "Ready to yank '%s'" org-index--text-to-yank))
2177 (setq org-index--text-to-yank nil)))
2180 (provide 'org-index)
2184 ;; comment-column: 50
2187 ;;; org-index.el ends here