882f502267a76508bee06bab3e1ab60e22ec80ff
[worg.git] / code / elisp / org-index.el
1 ;;; org-index.el --- A personal index for org and beyond\r
2 \r
3 ;; Copyright (C) 2011-2013 Free Software Foundation, Inc.\r
4 \r
5 ;; Author: Marc Ihm <org-index@ferntreffer.de>\r
6 ;; Keywords: hypermedia, matching\r
7 ;; Requires: org\r
8 ;; Download: http://orgmode.org/worg/code/elisp/org-index.el\r
9 ;; Version: 2.3.2\r
10 \r
11 ;; This file is not part of GNU Emacs.\r
12 \r
13 ;;; License:\r
14 \r
15 ;; This program is free software; you can redistribute it and/or modify\r
16 ;; it under the terms of the GNU General Public License as published by\r
17 ;; the Free Software Foundation; either version 3, or (at your option)\r
18 ;; any later version.\r
19 ;;\r
20 ;; This program is distributed in the hope that it will be useful,\r
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
23 ;; GNU General Public License for more details.\r
24 ;;\r
25 ;; You should have received a copy of the GNU General Public License\r
26 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.\r
27 \r
28 ;;; Commentary:\r
29 \r
30 ;; Purpose:\r
31 ;;\r
32 ;;  Mark and find your favorite org-locations and other points of interest\r
33 ;;  easily; create and update a lookup table of references and links. When\r
34 ;;  searching, frequently used entries appear at the the top and entering\r
35 ;;  some keywords narrows down to matching entries only; so the right one\r
36 ;;  can be spotted easily.\r
37 ;;\r
38 ;;  References are essentially small numbers (e.g. "R237" or "-455-"),\r
39 ;;  which are created by this package; they are well suited to be used\r
40 ;;  outside org. Links are normal org-mode links.\r
41 ;;\r
42 ;; Setup:\r
43 ;;\r
44 ;;  - Add these lines to your .emacs:\r
45 ;;\r
46 ;;    (require 'org-index)\r
47 ;;\r
48 ;;    ;; Optionally assign a key. Pick your own.\r
49 ;;    (global-set-key (kbd "C-+") 'org-index)\r
50 ;;\r
51 ;;  - Invoke `org-index', which will assist you to create your \r
52 ;;    index table.\r
53 ;;\r
54 ;;  - Do not forget to restart emacs to make these lines effective.\r
55 ;;\r
56 ;;\r
57 ;; Further reading:\r
58 ;;\r
59 ;;  See the documentation of `org-index', which can also be read\r
60 ;;  by invoking `org-index' and and choosing the help-command.\r
61 ;;\r
62 ;;  For more documentation and working examples, see:\r
63 ;;\r
64 ;;    http://orgmode.org/worg/org-contrib/org-index.html\r
65 ;;\r
66 \r
67 ;;; Change Log:\r
68 \r
69 ;;   [2013-10-04 Fr] Version 2.3.2:\r
70 ;;   - Bugfix: index-table created by assistant is found after \r
71 ;;     restart of emacs instead of invoking assistent again\r
72 ;;\r
73 ;;   [2013-07-20 Sa] Version 2.3.0:\r
74 ;;    - Renamed from "org-favtable" to "org-index"\r
75 ;;    - Added an assistent to set up the index table\r
76 ;;    - occur is now incremental, searching as you type\r
77 ;;    - simplified the documentation and help-system\r
78 ;;    - Saving keystrokes, as "+g237" is now valid input\r
79 ;;    - Many bugfixes\r
80 ;;\r
81 ;;   [2013-02-28 Th] Version 2.2.0:\r
82 ;;    - Allowed shortcuts like "h237" for command "head" with argument "237"\r
83 ;;    - Integrated with org-mark-ring-goto\r
84 ;;\r
85 ;;   [2013-01-25 Fr] Version 2.1.0:\r
86 ;;    - Added full support for links\r
87 ;;    - New commands "missing" and "statistics"\r
88 ;;    - Renamed the package from "org-reftable" to "org-favtable"\r
89 ;;    - Additional columns are required (e.g. "link"). Error messages will\r
90 ;;      guide you\r
91 ;;\r
92 ;;   [2012-12-07 Fr] Version 2.0.0:\r
93 ;;    - The format of the table of favorites has changed ! You need to bring\r
94 ;;      your existing table into the new format by hand (which however is\r
95 ;;      easy and explained below)\r
96 ;;    - Reference table can be sorted after usage count or date of last access\r
97 ;;    - Ask user explicitly, which command to invoke\r
98 ;;    - Renamed the package from "org-refer-by-number" to "org-reftable"\r
99 \r
100 ;;   [2012-09-22 Sa] Version 1.5.0:\r
101 ;;    - New command "sort" to sort a buffer or region by reference number\r
102 ;;    - New commands "highlight" and "unhighlight" to mark references\r
103 \r
104 ;;   [2012-07-13 Fr] Version 1.4.0:\r
105 ;;    - New command "head" to find a headline with a reference number\r
106 \r
107 ;;   [2012-04-28 Sa] Version 1.3.0:\r
108 ;;    - New commands occur and multi-occur\r
109 ;;    - All commands can now be invoked explicitly\r
110 ;;    - New documentation\r
111 ;;    - Many bugfixes\r
112 \r
113 ;;   [2011-12-10 Sa] Version 1.2.0:\r
114 ;;    - Fixed a bug, which lead to a loss of newly created reference numbers\r
115 ;;    - Introduced single and double prefix arguments\r
116 ;;    - Started this Change Log\r
117 \r
118 ;;; Code:\r
119 \r
120 (require 'org-table)\r
121 (require 'cl)\r
122 \r
123 (defvar org-index--preferred-command nil)\r
124 \r
125 (defvar org-index--commands \r
126   '(occur head ref link leave enter goto help + reorder fill sort update highlight unhighlight missing statistics)\r
127   "List of commands known to org-index.")\r
128 \r
129 (defvar org-index--commands-some '(occur head ref link leave enter goto help +))  \r
130 \r
131 \r
132 (defvar org-index--columns nil)\r
133 \r
134 (defcustom org-index-id nil \r
135   "Id of the Org-mode node, which contains the index table."\r
136   :group 'org\r
137   :group 'org-index)\r
138 \r
139 \r
140 (defvar org-index--text-to-yank nil)\r
141 (defvar org-index--last-action nil)\r
142 (defvar org-index--ref-regex nil)\r
143 (defvar org-index--ref-format nil)\r
144 (defvar org-index--buffer nil "buffer of index table")\r
145 (defvar org-index--point nil "position at start of headline of index table")\r
146 (defvar org-index--below-hline nil "position of first cell in first line below hline") \r
147 (defvar org-index--point-before nil "point in buffer with index table")     \r
148 \r
149 \r
150 (defun org-index (&optional ARG)\r
151   "Mark and find your favorite things and org-locations easily:\r
152 Create and update a lookup table of references and links. Often\r
153 used entries bubble to the top; entering some keywords narrows\r
154 down to matching entries only, so that the right one can be\r
155 spotted easily.\r
156 \r
157 References are essentially small numbers (e.g. \"R237\" or \"-455-\"),\r
158 which are created by this package; they are well suited to be used\r
159 outside of org. Links are normal org-mode links.\r
160 \r
161 This is version 2.3.2 of org-index.\r
162 \r
163 The function `org-index' operates on a dedicated table, the index\r
164 table, which lives within its own Org-mode node. The table and\r
165 its node will be created, when you first invoke org-index.\r
166 \r
167 Each line in the index table contains:\r
168 \r
169  - A reference\r
170 \r
171  - A link\r
172 \r
173  - A number; counting, how often each reference has been\r
174    used. This number is updated automatically and the table can\r
175    be sorted after it, so that most frequently used references\r
176    appear at the top of the table and can be spotted easily.\r
177 \r
178  - The creation date of the line.\r
179 \r
180  - Date and time of last access. This column can alternatively be\r
181    used to sort the table.\r
182 \r
183  - A column for your own comments, which allows lines to be selected by\r
184    keywords.\r
185 \r
186 The index table is found through the id of the containing\r
187 node; this id is stored within `org-index-id'.\r
188 \r
189 \r
190 The function `org-index' is the only interactive function of this\r
191 package and its sole entry point; it offers several commands to\r
192 create, find and look up these favorites (references and links).\r
193 \r
194 Commands known:\r
195 \r
196   occur: Incremental search, that after each keystroke shows\r
197     matching lines from index table. You may enter a list of words\r
198     seperated by comma (\",\"), to select lines that contain all\r
199     of the given words.\r
200 \r
201     If you supply a number (e.g. \"237\"): Apply emacs standard\r
202     multi-occur operation on all org-mode buffers to search for\r
203     this specific reference.\r
204 \r
205     You may also read the note at the end of this help on saving\r
206     the keystroke RET with this frequent default command.\r
207 \r
208   head: If invoked outside the index table, ask for a\r
209     reference number and search for a heading containing it. If\r
210     invoked within index table dont ask; rather use the reference or\r
211     link from the current line.\r
212 \r
213   ref: Create a new reference, copy any previously selected text.\r
214     If already within index table, fill in ref-column.\r
215 \r
216   link: Create a new line in index table with a link to the\r
217     current node.  Do not populate the ref column; this can later\r
218     be populated by calling the \"fill\" command from within the\r
219     index table.\r
220 \r
221   leave: Leave the index table. If the last command has\r
222     been \"ref\", the new reference is copied and ready to yank.\r
223     This \"org-mark-ring-goto\" and can be called several times\r
224     in succession. If you invoke org-index with a prefix argument,\r
225     this command \"leave\" is executed without further questions.\r
226 \r
227   enter: Just enter the node with the index table.\r
228 \r
229   goto: Search for a specific reference within the index table.\r
230 \r
231   help: Show this text.\r
232 \r
233   +: Show all commands including the less frequently used ones\r
234     given below. If \"+\" is followd by enough letters of such a\r
235     command (e.g. \"+fi\"), then this command is invoked\r
236     directly.\r
237 \r
238   reorder: Temporarily reorder the index table, e.g. by\r
239     count, reference or last access.\r
240 \r
241   fill: If either ref or link is missing, fill it.\r
242 \r
243   sort: Sort a set of lines (either the active region or the\r
244     whole buffer) by the references found in each line.\r
245 \r
246   update: For the given reference, update the line in the\r
247     index table.\r
248 \r
249   highlight: Highlight references in region or buffer.\r
250 \r
251   unhighlight: Remove highlights.\r
252 \r
253   missing : Search for missing reference numbers (which do not\r
254     appear in the reference table). If requested, add additional\r
255     lines for them, so that the command \"ref\" is able to reuse\r
256     them.\r
257 \r
258   statistics : Show some statistics (e.g. minimum and maximum\r
259     reference) about index table.\r
260 \r
261 \r
262 \r
263 Two ways to save keystrokes:\r
264 \r
265 When prompting for a command, org-index puts the most likely\r
266 one (e.g. \"occur\" or \"ref\") in front of the list, so that\r
267 you may just type RET.\r
268 \r
269 If this command needs additional input (like e.g. \"occur\"), you\r
270 may supply this input right away, although you are still beeing\r
271 prompted for the command. So, to do an occur for the string\r
272 \"foo\", you can just enter \"foo\" RET, without even typing\r
273 \"occur\".\r
274 \r
275 \r
276 Another way to save keystrokes applies if you want to choose a\r
277 command, that requrires a reference number (and would normally\r
278 prompt for it): In that case you may just enter enough characters\r
279 from your command, so that it appears first in the list of\r
280 matches; then immediately enter the number of the reference you\r
281 are searching for. So the input \"h237\" would execute the\r
282 command \"head\" for reference \"237\" right away.\r
283 \r
284 "\r
285 \r
286   (interactive "P")\r
287 \r
288   (org-index-1 (if (equal ARG '(4)) 'leave nil) )\r
289 )\r
290 \r
291 \r
292 (defun org-index-1 (&optional what search search-is-link) \r
293 "Do the actual worg for org-index; its optional arguments are:\r
294 \r
295          search : string to search for\r
296            what : symbol of the command to invoke\r
297  search-is-link : t, if argument search is actually a link\r
298 \r
299 An example would be:\r
300 \r
301  (org-index \"237\" 'head)   ;; find heading with ref 237\r
302 "\r
303   (let (within-node        ; True, if we are within node of the index table\r
304         active-window-index    ; active window with index table (if any)\r
305         below-cursor              ; word below cursor\r
306         active-region             ; active region (if any)\r
307         link-id                   ; link of starting node, if required\r
308         guarded-search            ; with guard against additional digits\r
309         search-is-ref             ; true, if search is a reference\r
310         commands                ; currently active set of selectable commands\r
311         what-adjusted           ; True, if we had to adjust what\r
312         what-input    ; Input on what question (need not necessary be "what")\r
313         trailing-digits ; any digits, that are are appended to what-input\r
314         reorder-once  ; Column to use for single time sorting\r
315         parts         ; Parts of a typical reference number (which\r
316                       ; need not be a plain number); these are:\r
317         head               ; Any header before number (e.g. "R")\r
318         maxref             ; Maximum number from reference table (e.g. "153")\r
319         tail               ; Tail after number (e.g. "}" or "")\r
320         ref-regex          ; Regular expression to match a reference\r
321         has-reuse          ; True, if table contains a line for reuse\r
322         numcols            ; Number of columns in index table\r
323         kill-new-text      ; Text that will be appended to kill ring\r
324         message-text       ; Text that will be issued as an explanation,\r
325                            ; what we have done\r
326         initial-ref-or-link      ; Initial position in index table\r
327         )\r
328 \r
329     ;;\r
330     ;; Examine current buffer and location, before turning to index table\r
331     ;;\r
332     \r
333     (unless (boundp 'org-index-id)\r
334       (setq org-index-id nil)\r
335       (org-index--create-new-index \r
336        t\r
337        (format "No index table has been created yet." org-index-id)))\r
338 \r
339     ;; Bail out, if new index has been created\r
340     (catch 'created-new-index\r
341 \r
342       ;; Get the content of the active region or the word under cursor\r
343       (if (and transient-mark-mode\r
344                mark-active)\r
345           (setq active-region (buffer-substring (region-beginning) (region-end))))\r
346       (setq below-cursor (thing-at-point 'symbol))\r
347 \r
348 \r
349       ;; Find out, if we are within favable or not\r
350       (setq within-node (string= (org-id-get) org-index-id))\r
351 \r
352 \r
353       ;;\r
354       ;; Get decoration of references and highest reference from index table\r
355       ;;\r
356 \r
357 \r
358       ;; Save initial ref or link\r
359       (if (and within-node\r
360                (org-at-table-p))\r
361           (setq initial-ref-or-link \r
362                 (or (org-index--get-field 'ref)\r
363                     (org-index--get-field 'link))))\r
364 \r
365       ;; Find node\r
366       (let ((marker (org-id-find org-index-id 'marker)) initial)      \r
367         (if marker \r
368             (progn\r
369               (setq org-index--buffer (marker-buffer marker) \r
370                     org-index--point (marker-position marker))\r
371               (move-marker marker nil))\r
372           (org-index--create-new-index \r
373            t\r
374            (format "Cannot find node with id \"%s\"" org-index-id))))\r
375       \r
376       ;; Check and remember, if active window contains buffer with index table\r
377       (if (eq (window-buffer) org-index--buffer)\r
378           (setq active-window-index (selected-window)))\r
379 \r
380       ;; Get configuration of index table; catch errors\r
381       (let ((error-message\r
382              (catch 'content-error\r
383 \r
384                (with-current-buffer org-index--buffer\r
385                  (unless org-index--point-before \r
386                    (setq org-index--point-before (point)))\r
387 \r
388                  (unless (string= (org-id-get) org-index-id)\r
389                    (goto-char org-index--point))\r
390 \r
391                  ;; parse table while still within buffer\r
392                  (setq parts (org-index--parse-and-adjust-table))\r
393                  \r
394                  ;; go back\r
395                  (goto-char org-index--point-before)\r
396 \r
397                  nil))))\r
398 \r
399         (when error-message \r
400           (org-pop-to-buffer-same-window org-index--buffer)\r
401           (org-reveal)\r
402           (error error-message)))\r
403 \r
404       ;; Give names to parts of configuration\r
405       (setq head (nth 0 parts))\r
406       (setq maxref (nth 1 parts))\r
407       (setq tail (nth 2 parts))\r
408       (setq numcols (nth 3 parts))\r
409       (setq ref-regex (nth 4 parts))\r
410       (setq has-reuse (nth 5 parts))\r
411       (setq org-index--ref-regex ref-regex)\r
412       (setq org-index--ref-format (concat head "%d" tail))\r
413 \r
414       ;;\r
415       ;; Find out, what we are supposed to do\r
416       ;;\r
417 \r
418       ;; Set preferred action, that will be the default choice\r
419       (setq org-index--preferred-command\r
420             (if within-node\r
421                 (if (memq org-index--last-action '(ref link))\r
422                     'leave\r
423                   'goto)\r
424               (if active-region\r
425                   'ref\r
426                 (if (and below-cursor (string-match ref-regex below-cursor))\r
427                     'occur\r
428                   nil))))\r
429       \r
430       ;; Ask user, what to do\r
431       (unless what\r
432         (setq commands (copy-list org-index--commands-some))\r
433         (while (let (completions starts-with-plus is-only-plus)\r
434 \r
435                  (setq what-input\r
436                        (org-completing-read \r
437                         "Please choose: " \r
438                         (mapcar 'symbol-name \r
439                                 ;; Construct unique list of commands with\r
440                                 ;; preferred one at front\r
441                                 (delq nil (delete-dups \r
442                                            (append \r
443                                             (list org-index--preferred-command)\r
444                                             (copy-list commands)))))\r
445                         nil nil))\r
446 \r
447                  ;; if input ends in digits, save them away and do completions on head of input\r
448                  ;; this allows input like "h224" to be accepted\r
449                  (when (string-match "^\\([^0-9]+\\)\\([0-9]+\\)\\s *$" what-input)\r
450                    ;; remember digits\r
451                    (setq trailing-digits (string-to-number (match-string 2 what-input)))\r
452                    ;; and use non-digits-part to find match\r
453                    (setq what-input (match-string 1 what-input)))\r
454 \r
455                  ;; if input starts with "+", any command (not only some) may follow\r
456                  ;; this allows input like "+sort" to be accepted\r
457                  (when (string= (substring what-input 0 1) "+")\r
458                    ;; make all commands available for selection\r
459                    (setq commands (copy-list org-index--commands))\r
460                    (setq what-input (substring what-input 1))\r
461                    (setq starts-with-plus (> (length what-input) 0))\r
462                    (setq is-only-plus (not starts-with-plus)))\r
463 \r
464                  ;; get list of possible completions for what-input; i.e.\r
465                  ;; all commands, that start with what-input                   \r
466                  (setq completions (delq nil (mapcar \r
467                                               (lambda (x) \r
468                                                 (let ((where (search what-input (symbol-name x))))\r
469                                                   (if (and where \r
470                                                            (= where 0))\r
471                                                       x\r
472                                                     nil))) commands)))\r
473 \r
474                  ;; if input starts with "+" and not just "+"\r
475                  (when starts-with-plus\r
476                    ;; use first completion, if unambigously\r
477                    (if (= (length completions) 1)\r
478                        (setq what-input (symbol-name (car completions)))\r
479                      (if completions\r
480                          (error "Input \"+%s\" matches multiple commands: %s" \r
481                                 what-input \r
482                                 (mapconcat 'symbol-name completions ", "))\r
483                        (error "Input \"+%s\" matches no commands" what-input))))\r
484 \r
485                  ;; if input ends in digits, use first completion, even if ambigous\r
486                  ;; this allows input like "h224" to be accepted\r
487                  (when (and trailing-digits completions)\r
488                    ;; use first match as input, even if ambigously\r
489                    (setq org-index--preferred-command (first completions))\r
490                    (setq what-input (number-to-string trailing-digits)))\r
491 \r
492                  ;; convert to symbol\r
493                  (setq what (intern what-input))\r
494                  (if is-only-plus (setq what '+))\r
495                  \r
496                  ;; user is not required to input one of the commands; if\r
497                  ;; not, take the first one and use the original input for\r
498                  ;; next question\r
499                  (if (memq what commands)\r
500                      ;; input matched one element of list, dont need original\r
501                      ;; input any more\r
502                      (setq what-input nil)\r
503                    ;; what-input will be used for next question, use first\r
504                    ;; command for what\r
505                    (setq what (or org-index--preferred-command\r
506                                   (first commands)))\r
507                    ;; remove any trailing dot, that user might have added to\r
508                    ;; disambiguate his input\r
509                    (if (and (> (length what-input) 0) \r
510                             (equal (substring what-input -1) "."))\r
511                        ;; but do this only, if dot was really necessary to\r
512                        ;; disambiguate\r
513                        (let ((shortened-what-input (substring what-input 0 -1)))\r
514                          (unless (test-completion shortened-what-input \r
515                                                   (mapcar 'symbol-name \r
516                                                           commands))\r
517                            (setq what-input shortened-what-input)))))\r
518                  \r
519                  ;; ask for reorder in loop, because we have to ask for\r
520                  ;; what right again\r
521                  (if (eq what 'reorder)\r
522                      (setq reorder-once\r
523                            (intern\r
524                             (org-icompleting-read \r
525                              "Please choose column to reorder index table once: " \r
526                              (mapcar 'symbol-name '(ref count last-accessed))\r
527                              nil t))))\r
528                  \r
529                  ;; maybe ask initial question again\r
530                  (memq what '(reorder +)))))\r
531 \r
532 \r
533       ;;\r
534       ;; Get search, if required\r
535       ;;\r
536 \r
537       ;; These actions need a search string:\r
538       (when (memq what '(goto occur head update))\r
539 \r
540         ;; Maybe we've got a search string from the arguments\r
541         (unless search\r
542           (let (search-from-table\r
543                 search-from-cursor)\r
544             \r
545             ;; Search string can come from several sources:\r
546             ;; From link or ref columns of table\r
547             (when within-node\r
548               (setq search-from-table (org-index--get-field 'link))\r
549               (if search-from-table \r
550                   (setq search-is-link t)\r
551                 (setq search-from-table (org-index--get-field 'ref))))      \r
552             \r
553             ;; From string below cursor\r
554             (when (and (not within-node)\r
555                        below-cursor\r
556                        (string-match (concat "\\(" ref-regex "\\)") \r
557                                      below-cursor))\r
558               (setq search-from-cursor (match-string 1 below-cursor)))\r
559             \r
560             ;; Depending on requested action, get search from one of the sources above\r
561             (cond ((eq what 'goto)\r
562                    (setq search (or what-input search-from-cursor)))\r
563                   ((memq what '(head occur))\r
564                    (setq search (or what-input search-from-table search-from-cursor))))))\r
565 \r
566 \r
567         ;; If we still do not have a search string, ask user explicitly\r
568         (unless search\r
569           (unless (eq what 'occur)\r
570             \r
571             (if what-input \r
572                 (setq search what-input)\r
573               (setq search (read-from-minibuffer\r
574                             (cond ((eq what 'head)\r
575                                    "Text or reference number to search for: ")\r
576                                   ((eq what 'goto)\r
577                                    "Reference number to search for, or enter \".\" for id of current node: ")\r
578                                   ((eq what 'update)\r
579                                    "Reference number to update: ")))))\r
580 \r
581             (if (string-match "^\\s *[0-9]+\\s *$" search)\r
582                 (setq search (format "%s%s%s" head (org-trim search) tail))))))\r
583       \r
584       ;; Clean up and examine search string\r
585       (when search \r
586         (setq search (org-trim search))\r
587         (if (string= search "") (setq search nil))\r
588         (when search\r
589           (if (string-match "^[0-9]+$" search)\r
590               (setq search (concat head search tail)))\r
591           (setq search-is-ref (string-match ref-regex search))))\r
592       \r
593       ;; Check for special case\r
594       (when (and (memq what '(head goto))\r
595                  (string= search "."))\r
596         (setq search (org-id-get))\r
597         (setq search-is-link t))\r
598       \r
599       (when search-is-ref\r
600         (setq guarded-search (org-index--make-guarded-search search)))\r
601       \r
602       ;;\r
603       ;; Do some sanity checking before really starting\r
604       ;;\r
605       \r
606       ;; Correct requested action, if nothing to search\r
607       (when (and (not search)\r
608                  (memq what '(search head)))\r
609         (setq what 'enter)\r
610         (setq what-adjusted t))\r
611       \r
612       ;; For a proper reference as input, we do multi-occur\r
613       (if (and search\r
614                (string-match ref-regex search)\r
615                (eq what 'occur))\r
616           (setq what 'multi-occur))\r
617       \r
618       ;; Check for invalid combinations of arguments; try to be helpful\r
619       (when (and (memq what '(head goto))\r
620                  (not search-is-link)\r
621                  (not search-is-ref))\r
622         (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search))\r
623 \r
624       \r
625       ;;\r
626       ;; Prepare\r
627       ;;\r
628 \r
629       ;; Get link if required before moving in\r
630       (if (eq what 'link)\r
631           (let ((org-id-link-to-org-use-id t))\r
632             (setq link-id (org-id-get-create))))\r
633 \r
634       ;; Move into table, if outside\r
635 \r
636       ;; These commands enter index table only temporarily\r
637       (when (memq what '(occur multi-occur statistics))\r
638 \r
639         ;; Switch to index table\r
640         (set-buffer org-index--buffer)\r
641         (goto-char org-index--point)\r
642 \r
643         ;; sort index table\r
644         (org-index--sort-table reorder-once))\r
645 \r
646       ;; These commands will leave user in index table after they are finished\r
647       (when (memq what '(enter ref link goto missing))\r
648 \r
649         ;; Support orgmode-standard of going back (buffer and position)\r
650         (org-mark-ring-push)\r
651 \r
652         ;; Switch to index table\r
653         (org-pop-to-buffer-same-window org-index--buffer)\r
654         (goto-char org-index--point)\r
655         (show-subtree)\r
656         (org-show-context)\r
657         (setq org-index--point-before nil) ;; dont want to go back\r
658 \r
659         ;; sort index table\r
660         (org-index--sort-table reorder-once))\r
661 \r
662       ;; Goto back to initial ref, because reformatting of table above might\r
663       ;; have moved point\r
664       (when initial-ref-or-link\r
665         (while (and (org-at-table-p)\r
666                     (not (or\r
667                           (string= initial-ref-or-link (org-index--get-field 'ref))\r
668                           (string= initial-ref-or-link (org-index--get-field 'link)))))\r
669           (forward-line))\r
670         ;; did not find ref, go back to top\r
671         (if (not (org-at-table-p)) (goto-char org-index--point)))\r
672       \r
673       \r
674       ;;\r
675       ;; Actually do, what is requested\r
676       ;;\r
677 \r
678       (cond\r
679 \r
680 \r
681        ((eq what 'help)\r
682         \r
683         ;; bring up help-buffer for this function\r
684         (describe-function 'org-index))\r
685 \r
686 \r
687        ((eq what 'multi-occur) \r
688         \r
689         ;; Conveniently position cursor on number to search for\r
690         (goto-char org-index--below-hline)\r
691         (let (found (initial (point)))\r
692           (while (and (not found)\r
693                       (forward-line)\r
694                       (org-at-table-p))\r
695             (save-excursion \r
696               (setq found (string= search \r
697                                    (org-index--get-field 'ref)))))\r
698           (if found \r
699               (org-index--update-line nil)\r
700             (goto-char initial)))\r
701 \r
702         ;; Construct list of all org-buffers\r
703         (let (buff org-buffers)\r
704           (dolist (buff (buffer-list))\r
705             (set-buffer buff)\r
706             (if (string= major-mode "org-mode")\r
707                 (setq org-buffers (cons buff org-buffers))))\r
708 \r
709           ;; Do multi-occur\r
710           (multi-occur org-buffers guarded-search)\r
711           (if (get-buffer "*Occur*")\r
712               (progn \r
713                 (setq message-text (format "multi-occur for '%s'" search))\r
714                 (other-window 1)\r
715                 (toggle-truncate-lines 1))\r
716             (setq message-text (format "Did not find '%s'" search)))))\r
717 \r
718 \r
719        ((eq what 'head)\r
720 \r
721         (let (link)\r
722           ;; link either from table or passed in as argument\r
723           \r
724           ;; try to get link\r
725           (if search-is-link \r
726               (setq link (org-trim search))\r
727             (if (and within-node\r
728                      (org-at-table-p))\r
729                 (setq link (org-index--get-field 'link))))\r
730 \r
731           ;; use link if available\r
732           (if (and link\r
733                    (not (string= link "")))\r
734               (progn \r
735                 (org-index--update-line search)\r
736                 (org-id-goto link)\r
737                 (org-reveal)\r
738                 (if (eq (current-buffer) org-index--buffer)\r
739                     (setq org-index--point-before nil))\r
740                 (setq message-text "Followed link"))\r
741 \r
742             (message (format "Scanning headlines for '%s' ..." search))\r
743             (org-index--update-line search)\r
744             (let (buffer point)\r
745               (if (catch 'found\r
746                     (progn\r
747                       ;; loop over all headlines, stop on first match\r
748                       (org-map-entries \r
749                        (lambda () \r
750                          (when (looking-at (concat ".*" guarded-search))\r
751                            ;; If this is not an inlinetask ...\r
752                            (when (< (org-element-property :level (org-element-at-point))\r
753                                     org-inlinetask-min-level)\r
754                              ;; ... remember location and bail out\r
755                              (setq buffer (current-buffer))\r
756                              (setq point (point))\r
757                              (throw 'found t))))          \r
758                        nil 'agenda)\r
759                       nil))\r
760 \r
761                   (progn\r
762                     (if (eq buffer org-index--buffer)\r
763                         (setq org-index--point-before nil))\r
764                     (setq message-text (format "Found '%s'" search))\r
765                     (org-pop-to-buffer-same-window buffer)\r
766                     (goto-char point)\r
767                     (org-reveal))\r
768                 (setq message-text (format "Did not find '%s'" search)))))))\r
769 \r
770 \r
771        ((eq what 'leave)\r
772 \r
773         (setq kill-new-text org-index--text-to-yank)\r
774         (setq org-index--text-to-yank nil)\r
775         \r
776         ;; If "leave" has been called two times in succession, make\r
777         ;; org-mark-ring-goto believe it has been called two times too\r
778         (if (eq org-index--last-action 'leave) \r
779             (let ((this-command nil) (last-command nil))\r
780               (org-mark-ring-goto 1))\r
781           (org-mark-ring-goto)))\r
782 \r
783 \r
784        ((eq what 'goto)\r
785 \r
786         ;; Go downward in table to requested reference\r
787         (let (found (initial (point)))\r
788           (goto-char org-index--below-hline)\r
789           (while (and (not found)\r
790                       (forward-line)\r
791                       (org-at-table-p))\r
792             (save-excursion \r
793               (setq found \r
794                     (string= search \r
795                              (org-index--get-field \r
796                               (if search-is-link 'link 'ref))))))\r
797           (if found\r
798               (progn\r
799                 (setq message-text (format "Found '%s'" search))\r
800                 (org-index--update-line nil)\r
801                 (org-table-goto-column (org-index--column-num 'ref))\r
802                 (if (looking-back " ") (backward-char))\r
803                 ;; remember string to copy\r
804                 (setq org-index--text-to-yank \r
805                       (org-trim (org-table-get-field (org-index--column-num 'copy)))))\r
806             (setq message-text (format "Did not find '%s'" search))\r
807             (goto-char initial)\r
808             (forward-line)\r
809             (setq what 'missed))))\r
810 \r
811 \r
812        ((eq what 'occur)\r
813 \r
814         (org-index--do-occur what-input))\r
815 \r
816 \r
817        ((memq what '(ref link))\r
818 \r
819         ;; add a new row (or reuse existing one)\r
820         (let (new)\r
821 \r
822           (when (eq what 'ref)\r
823             ;; go through table to find first entry to be reused\r
824             (when has-reuse\r
825               (goto-char org-index--below-hline)\r
826               ;; go through table\r
827               (while (and (org-at-table-p)\r
828                           (not new))\r
829                 (when (string= \r
830                        (org-index--get-field 'count)\r
831                        ":reuse:")\r
832                   (setq new (org-index--get-field 'ref))\r
833                   (if new (org-table-kill-row)))\r
834                 (forward-line)))\r
835             \r
836             ;; no ref to reuse; construct new reference\r
837             (unless new \r
838               (setq new (format "%s%d%s" head (1+ maxref) tail)))\r
839 \r
840             ;; remember for org-mark-ring-goto\r
841             (setq org-index--text-to-yank new))\r
842           \r
843           ;; insert ref or link as very first row\r
844           (goto-char org-index--below-hline)\r
845           (org-table-insert-row)\r
846           \r
847           ;; fill special columns with standard values\r
848           (when (eq what 'ref)\r
849             (org-table-goto-column (org-index--column-num 'ref))\r
850             (insert new))\r
851           (when (eq what 'link)\r
852             (org-table-goto-column (org-index--column-num 'link))\r
853             (insert link-id))\r
854           (org-table-goto-column (org-index--column-num 'created))\r
855           (org-insert-time-stamp nil nil t)\r
856           (org-table-goto-column (org-index--column-num 'count))\r
857           (insert "1")\r
858 \r
859           ;; goto copy-field or first empty one\r
860           (if (org-index--column-num 'copy)\r
861               (org-table-goto-column (org-index--column-num 'copy))\r
862             (unless (catch 'empty\r
863                       (dotimes (col numcols)\r
864                         (org-table-goto-column (+ col 1))\r
865                         (if (string= (org-trim (org-table-get-field)) "")\r
866                             (throw 'empty t))))\r
867               ;; none found, goto first\r
868               (org-table-goto-column 1)))\r
869 \r
870           (org-table-align)\r
871           (if active-region (setq kill-new-text active-region))\r
872           (if (eq what 'ref)\r
873               (setq message-text (format "Adding a new row with ref '%s'" new))\r
874             (setq message-text (format "Adding a new row linked to '%s'" link-id)))))\r
875 \r
876 \r
877        ((eq what 'enter)\r
878 \r
879         ;; simply go into table\r
880         (goto-char org-index--below-hline)\r
881         (show-subtree)\r
882         (recenter)\r
883         (if what-adjusted\r
884             (setq message-text "Nothing to search for; at index table")\r
885           (setq message-text "At index table")))\r
886 \r
887        \r
888        ((eq what 'fill)\r
889 \r
890         ;; check, if within index table\r
891         (unless (and within-node\r
892                      (org-at-table-p))\r
893           (error "Not within index table"))\r
894 \r
895         ;; applies to missing refs and missing links alike\r
896         (let ((ref (org-index--get-field 'ref))\r
897               (link (org-index--get-field 'link)))\r
898 \r
899           (if (and (not ref)\r
900                    (not link))\r
901               ;; have already checked this during parse, check here anyway\r
902               (error "Columns ref and link are both empty in this line"))\r
903 \r
904           ;; fill in new ref\r
905           (if (not ref)\r
906               (progn \r
907                 (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail))\r
908                 (org-index--get-field 'ref kill-new-text)\r
909                 ;; remember for org-mark-ring-goto\r
910                 (setq org-index--text-to-yank kill-new-text)\r
911                 (org-id-goto link)\r
912                 (setq message-text "Filled field of index table with new reference"))\r
913 \r
914             ;; fill in new link\r
915             (if (not link)\r
916                 (progn\r
917                   (setq guarded-search (org-index--make-guarded-search ref))\r
918                   (message (format "Scanning headlines for '%s' ..." ref))\r
919                   (let (link)\r
920                     (if (catch 'found\r
921                           (org-map-entries \r
922                            (lambda () \r
923                              (when (looking-at (concat ".*" guarded-search))\r
924                                (setq link (org-id-get-create))\r
925                                (throw 'found t)))   \r
926                            nil 'agenda)\r
927                           nil)\r
928 \r
929                         (progn\r
930                           (org-index--get-field 'link link)\r
931                           (setq message-text "Inserted link"))\r
932 \r
933                       (setq message-text (format "Did not find reference '%s'" ref)))))\r
934               \r
935               ;; nothing is missing\r
936               (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do")))))\r
937        \r
938 \r
939        ((eq what 'sort)\r
940 \r
941         ;; sort lines according to contained reference\r
942         (let (begin end where)\r
943           (catch 'aborted\r
944             ;; either active region or whole buffer\r
945             (if (and transient-mark-mode\r
946                      mark-active)\r
947                 ;; sort only region\r
948                 (progn\r
949                   (setq begin (region-beginning))\r
950                   (setq end (region-end))\r
951                   (setq where "region"))\r
952               ;; sort whole buffer\r
953               (setq begin (point-min))\r
954               (setq end (point-max))\r
955               (setq where "whole buffer")\r
956               ;; make sure\r
957               (unless (y-or-n-p "Sort whole buffer ")\r
958                 (setq message-text "Sort aborted")\r
959                 (throw 'aborted nil)))\r
960             \r
961             (save-excursion\r
962               (save-restriction\r
963                 (goto-char (point-min))\r
964                 (narrow-to-region begin end)\r
965                 (sort-subr nil 'forward-line 'end-of-line \r
966                            (lambda ()\r
967                              (if (looking-at (concat ".*" \r
968                                                      (org-index--make-guarded-search ref-regex 'dont-quote)))\r
969                                  (string-to-number (match-string 1))\r
970                                0))))\r
971               (highlight-regexp ref-regex 'isearch)\r
972               (setq message-text (format "Sorted %s from character %d to %d, %d lines" \r
973                                          where begin end\r
974                                          (count-lines begin end)))))))\r
975        \r
976 \r
977        ((eq what 'update)\r
978 \r
979         ;; simply update line in index table\r
980         (save-excursion\r
981           (let ((ref-or-link (if search-is-link "link" "reference")))\r
982             (beginning-of-line)\r
983             (if (org-index--update-line search)\r
984                 (setq message-text (format "Updated %s '%s'" ref-or-link search))\r
985               (setq message-text (format "Did not find %s '%s'" ref-or-link search))))))\r
986 \r
987 \r
988        ((eq what 'parse)\r
989         ;; Just parse the index table, which is already done, so nothing to do\r
990         )\r
991 \r
992 \r
993        ((memq what '(highlight unhighlight))\r
994 \r
995         (let ((where "buffer"))\r
996           (save-excursion\r
997             (save-restriction\r
998               (when (and transient-mark-mode\r
999                          mark-active)\r
1000                 (narrow-to-region (region-beginning) (region-end))\r
1001                 (setq where "region"))\r
1002 \r
1003               (if (eq what 'highlight)\r
1004                   (progn\r
1005                     (highlight-regexp ref-regex 'isearch)\r
1006                     (setq message-text (format "Highlighted references in %s" where)))\r
1007                 (unhighlight-regexp ref-regex)\r
1008                 (setq message-text (format "Removed highlights for references in %s" where)))))))\r
1009 \r
1010 \r
1011        ((memq what '(missing statistics))\r
1012 \r
1013         (goto-char org-index--below-hline)\r
1014         (let (missing \r
1015               ref-field\r
1016               ref\r
1017               min\r
1018               max \r
1019               (total 0))\r
1020 \r
1021           ;; start with list of all references\r
1022           (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail)) \r
1023                                 (number-sequence 1 maxref)))\r
1024 \r
1025           ;; go through table and remove all refs, that we see\r
1026           (while (and (forward-line)\r
1027                       (org-at-table-p))\r
1028 \r
1029             ;; get ref-field and number\r
1030             (setq ref-field (org-index--get-field 'ref))\r
1031             (if (and ref-field \r
1032                      (string-match ref-regex ref-field))\r
1033                 (setq ref (string-to-number (match-string 1 ref-field))))\r
1034 \r
1035             ;; remove existing refs from list\r
1036             (if ref-field (setq missing (delete ref-field missing)))\r
1037 \r
1038             ;; record min and max            \r
1039             (if (or (not min) (< ref min)) (setq min ref))\r
1040             (if (or (not max) (> ref max)) (setq max ref))\r
1041 \r
1042             ;; count\r
1043             (setq total (1+ total)))\r
1044 \r
1045           ;; insert them, if requested\r
1046           (forward-line -1)\r
1047           (if (eq what 'statistics)\r
1048               \r
1049               (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. "\r
1050                                          total \r
1051                                          (format org-index--ref-format min)   \r
1052                                          (format org-index--ref-format max)\r
1053                                          (length missing)))\r
1054 \r
1055             (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the index table" \r
1056                                   (length missing)))\r
1057                 (let (type)\r
1058                   (setq type (org-icompleting-read \r
1059                               "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing")))\r
1060                   (mapc (lambda (x) \r
1061                           (let (org-table-may-need-update) (org-table-insert-row t))\r
1062                           (org-index--get-field 'ref x)\r
1063                           (org-index--get-field 'count (format ":%s:" type)))\r
1064                         missing)\r
1065                   (org-table-align)\r
1066                   (setq message-text (format "Inserted %d new lines for missing refernces" (length missing))))\r
1067               (setq message-text (format "%d missing references." (length missing)))))))\r
1068        \r
1069        \r
1070        (t (error "This is a bug: unmatched case '%s'" what)))\r
1071 \r
1072 \r
1073       ;; restore point in buffer or window with index table\r
1074       (if org-index--point-before\r
1075           ;; buffer displayed in window need to set point there first\r
1076           (if (eq (window-buffer active-window-index)\r
1077                   org-index--buffer)\r
1078               (set-window-point active-window-index org-index--point-before)\r
1079             ;; set position in buffer in any case and second\r
1080             (with-current-buffer org-index--buffer\r
1081               (goto-char org-index--point-before)\r
1082               (setq org-index--point-before nil))))\r
1083 \r
1084 \r
1085       ;; remember what we have done for next time\r
1086       (setq org-index--last-action what)\r
1087       \r
1088       ;; tell, what we have done and what can be yanked\r
1089       (if kill-new-text (setq kill-new-text \r
1090                               (substring-no-properties kill-new-text)))\r
1091       (if (string= kill-new-text "") (setq kill-new-text nil))\r
1092       (let ((m (concat \r
1093                 message-text\r
1094                 (if (and message-text kill-new-text) \r
1095                     " and r" \r
1096                   (if kill-new-text "R" ""))\r
1097                 (if kill-new-text (format "eady to yank '%s'" kill-new-text) ""))))\r
1098         (unless (string= m "") (message m)))\r
1099       (if kill-new-text (kill-new kill-new-text)))))\r
1100 \r
1101 \r
1102 \r
1103 (defun org-index--parse-and-adjust-table ()\r
1104 \r
1105   (let ((maxref 0)\r
1106         top\r
1107         bottom\r
1108         ref-field\r
1109         link-field\r
1110         parts\r
1111         numcols\r
1112         head\r
1113         tail\r
1114         ref-regex\r
1115         has-reuse\r
1116         initial-point)\r
1117 \r
1118     (setq initial-point (point))\r
1119     (org-index--go-below-hline)\r
1120     (setq org-index--below-hline (point))\r
1121     (setq top (point))\r
1122     \r
1123     ;; count columns\r
1124     (org-table-goto-column 100)\r
1125     (setq numcols (- (org-table-current-column) 1))\r
1126     \r
1127     ;; get contents of columns\r
1128     (forward-line -2)\r
1129     (unless (org-at-table-p)\r
1130       (org-index--create-new-index \r
1131        nil\r
1132        "Index table starts with a hline"))\r
1133 \r
1134     ;; check for optional line consisting solely of width specifications\r
1135     (beginning-of-line)\r
1136     (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$")\r
1137         (forward-line -1))\r
1138     (org-table-goto-column 1)\r
1139 \r
1140     (setq org-index--columns (org-index--parse-headings numcols))\r
1141     \r
1142     ;; Go beyond end of table\r
1143     (while (org-at-table-p) (forward-line 1))\r
1144     \r
1145     ;; Kill all empty rows at bottom\r
1146     (while (progn\r
1147              (forward-line -1)\r
1148              (org-table-goto-column 1)\r
1149              (and\r
1150               (not (org-index--get-field 'ref))\r
1151               (not (org-index--get-field 'link))))\r
1152       (org-table-kill-row))\r
1153     (forward-line)\r
1154     (setq bottom (point))\r
1155     (forward-line -1)\r
1156     \r
1157     ;; Retrieve any decorations around the number within the first nonempty ref-field\r
1158     (goto-char top)\r
1159     (while (and (org-at-table-p)\r
1160                 (not (setq ref-field (org-index--get-field 'ref))))\r
1161       (forward-line))\r
1162 \r
1163     ;; Some Checking\r
1164     (unless ref-field\r
1165       (org-index--create-new-index \r
1166        nil\r
1167        "Reference column is empty"))\r
1168     \r
1169     (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)\r
1170       (org-index--create-new-index \r
1171        nil \r
1172        (format "First reference in index table ('%s') does not contain a number" ref-field)))\r
1173     \r
1174 \r
1175     ;; These are the decorations used within the first ref of index\r
1176     (setq head (match-string 1 ref-field))\r
1177     (setq tail (match-string 3 ref-field))\r
1178     (setq ref-regex (concat (regexp-quote head)\r
1179                             "\\([0-9]+\\)" \r
1180                             (regexp-quote tail)))\r
1181 \r
1182     ;; Go through table to find maximum number and do some checking\r
1183     (let ((ref 0))\r
1184 \r
1185       (while (org-at-table-p) \r
1186 \r
1187         (setq ref-field (org-index--get-field 'ref))\r
1188         (setq link-field (org-index--get-field 'link))\r
1189 \r
1190         (if (and (not ref-field)\r
1191                  (not link-field))\r
1192             (throw 'content-error "Columns ref and link are both empty in this line"))\r
1193 \r
1194         (if ref-field\r
1195             (if (string-match ref-regex ref-field)\r
1196                 ;; grab number\r
1197                 (setq ref (string-to-number (match-string 1 ref-field)))\r
1198               (throw 'content-error "Column ref does not contain a number")))\r
1199 \r
1200         ;; check, if higher ref\r
1201         (if (> ref maxref) (setq maxref ref))\r
1202 \r
1203         ;; check if ref is ment for reuse\r
1204         (if (string= (org-index--get-field 'count) ":reuse:")\r
1205             (setq has-reuse 1))\r
1206 \r
1207         (forward-line 1)))\r
1208     \r
1209     ;; sort used to be here\r
1210     \r
1211     (setq parts (list head maxref tail numcols ref-regex has-reuse))\r
1212         \r
1213     ;; go back to top of table\r
1214     (goto-char top)\r
1215 \r
1216     parts))\r
1217 \r
1218 \r
1219 \r
1220 (defun org-index--sort-table (sort-column)\r
1221 \r
1222   (unless sort-column (setq sort-column (org-index--column-num 'sort)))\r
1223 \r
1224   (let (top \r
1225         bottom\r
1226         ref-field\r
1227         count-field\r
1228         count-special)\r
1229 \r
1230 \r
1231     ;; get boundaries of table\r
1232     (goto-char org-index--below-hline)\r
1233     (forward-line 0)\r
1234     (setq top (point))\r
1235     (while (org-at-table-p) (forward-line))\r
1236     (setq bottom (point))\r
1237     \r
1238     (save-restriction\r
1239       (narrow-to-region top bottom)\r
1240       (goto-char top)\r
1241       (sort-subr t\r
1242                  'forward-line \r
1243                  'end-of-line \r
1244                  (lambda ()\r
1245                    (let (ref\r
1246                          (ref-field (or (org-index--get-field 'ref) ""))\r
1247                          (count-field (or (org-index--get-field 'count) ""))\r
1248                          (count-special 0))\r
1249 \r
1250                      ;; get reference with leading zeroes, so it can be\r
1251                      ;; sorted as text\r
1252                      (string-match org-index--ref-regex ref-field)\r
1253                      (setq ref (format \r
1254                                 "%06d" \r
1255                                 (string-to-number \r
1256                                  (or (match-string 1 ref-field)\r
1257                                      "0"))))\r
1258 \r
1259                      ;; find out, if special token in count-column\r
1260                      (setq count-special (format "%d" \r
1261                                                  (- 2\r
1262                                                     (length (member count-field '(":missing:" ":reuse:"))))))\r
1263                    \r
1264                      ;; Construct different sort-keys according to\r
1265                      ;; requested sort column; prepend count-special to\r
1266                      ;; sort special entries at bottom of table, append ref\r
1267                      ;; as a secondary sort key\r
1268                      (cond \r
1269 \r
1270                       ((eq sort-column 'count)\r
1271                        (concat count-special\r
1272                                (format \r
1273                                 "%08d" \r
1274                                 (string-to-number (or (org-index--get-field 'count)\r
1275                                                       ""))) \r
1276                                ref))\r
1277                     \r
1278                       ((eq sort-column 'last-accessed)\r
1279                        (concat count-special\r
1280                                (org-index--get-field 'last-accessed) \r
1281                                " " \r
1282                                ref))\r
1283                     \r
1284                       ((eq sort-column 'ref)\r
1285                        (concat count-special\r
1286                                ref))\r
1287                     \r
1288                       (t (error "This is a bug: unmatched case '%s'" sort-column)))))\r
1289                \r
1290                  nil 'string<)))\r
1291     \r
1292   ;; align table\r
1293   (org-table-align)) \r
1294 \r
1295 \r
1296 (defun org-index--go-below-hline ()\r
1297 \r
1298   ;; go to heading of node\r
1299   (while (not (org-at-heading-p)) (forward-line -1))\r
1300   (forward-line 1)\r
1301   ;; go to table within node, but make sure we do not get into another node\r
1302   (while (and (not (org-at-heading-p))\r
1303               (not (org-at-table-p))\r
1304               (not (eq (point) (point-max)))) \r
1305     (forward-line 1))\r
1306   \r
1307   ;; check, if there really is a table\r
1308   (unless (org-at-table-p)\r
1309     (org-index--create-new-index \r
1310      t\r
1311      (format "Cannot find index table within node %s" org-index-id)))\r
1312 \r
1313   ;; go to first hline\r
1314   (while (and (not (org-at-table-hline-p))\r
1315               (org-at-table-p))\r
1316     (forward-line 1))\r
1317   \r
1318   ;; and check\r
1319   (unless (org-at-table-hline-p)\r
1320     (org-index--create-new-index \r
1321      nil \r
1322      "Cannot find hline within index table"))      \r
1323 \r
1324   (forward-line 1)\r
1325   (org-table-goto-column 1))\r
1326 \r
1327 \r
1328 \r
1329 (defun org-index--parse-headings (numcols)\r
1330 \r
1331   (let (columns)\r
1332 \r
1333     ;; Associate names of special columns with column-numbers\r
1334     (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0) \r
1335                                (count . 0) (sort . nil) (copy . nil))))\r
1336 \r
1337     ;; For each column\r
1338     (dotimes (col numcols)\r
1339       (let* (field-flags ;; raw heading, consisting of file name and maybe\r
1340                          ;; flags (seperated by ";")\r
1341              field       ;; field name only\r
1342              field-symbol ;; and as a symbol\r
1343              flags       ;; flags from field-flags\r
1344              found)\r
1345 \r
1346         ;; parse field-flags into field and flags\r
1347         (setq field-flags (org-trim (org-table-get-field (+ col 1))))\r
1348         (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags)\r
1349             (progn \r
1350               (setq field (downcase (or (match-string 1 field-flags) "")))\r
1351               ;; get flags as list of characters\r
1352               (setq flags (mapcar 'string-to-char \r
1353                                   (split-string \r
1354                                    (downcase (match-string 2 field-flags)) \r
1355                                    "" t))))\r
1356           ;; no flags\r
1357           (setq field field-flags))\r
1358 \r
1359         (unless (string= field "") (setq field-symbol (intern (downcase field))))\r
1360 \r
1361         ;; Check, that no flags appear twice\r
1362         (mapc (lambda (x)\r
1363                 (when (memq (car x) flags)\r
1364                   (if (cdr (assoc (cdr x) columns))\r
1365                       (org-index--create-new-index \r
1366                        nil\r
1367                        (format "More than one heading is marked with flag '%c'" (car x))))))\r
1368               '((?s . sort)\r
1369                 (?c . copy)))\r
1370         \r
1371         ;; Process flags\r
1372         (if (memq ?s flags)\r
1373             (setcdr (assoc 'sort columns) field-symbol))\r
1374         (if (memq ?c flags)\r
1375             (setcdr (assoc 'copy columns) (+ col 1)))\r
1376         \r
1377         ;; Store columns in alist\r
1378         (setq found (assoc field-symbol columns))\r
1379         (when found\r
1380           (if (> (cdr found) 0) \r
1381               (org-index--create-new-index \r
1382                nil\r
1383                (format "'%s' appears two times as column heading" (downcase field))))\r
1384           (setcdr found (+ col 1)))))\r
1385 \r
1386     ;; check if all necessary informations have been specified\r
1387     (mapc (lambda (col) \r
1388             (unless (> (cdr (assoc col columns)) 0)\r
1389               (org-index--create-new-index \r
1390                nil\r
1391                (format "column '%s' has not been set" col))))\r
1392           '(ref link count created last-accessed))\r
1393 \r
1394     ;; use ref as a default sort-column\r
1395     (unless (cdr (assoc 'sort columns))\r
1396       (setcdr (assoc 'sort columns) 'ref))\r
1397     columns))\r
1398 \r
1399 \r
1400 \r
1401 (defun org-index--create-new-index (create-new-index reason)\r
1402   "Create a new empty index table with detailed explanation."\r
1403   (let (prompt buffer-name title firstref id)\r
1404 \r
1405     (setq prompt\r
1406           (if create-new-index\r
1407               (concat "There is this problem with the existing index table:\n\n   " reason "\n\nThis assistant will guide you to create a new one.\n\nDo you want to proceed ?")        \r
1408             (concat "The existing index table contains this error:\n\n   " reason "\n\nYou need to correct this error manually before proceeding. However, this assistant will help you to create an new initial index table with detailed comments, so that you may fix the errors in your existing table more easily.\n\nDo you want to proceed ?")))\r
1409     \r
1410     (unless (y-or-n-p prompt) \r
1411       (message "Cannot proceed without a valid index table: %s" reason)\r
1412       ;; show existing index\r
1413       (when (and org-index--buffer\r
1414                  org-index--point)\r
1415         (org-pop-to-buffer-same-window org-index--buffer)\r
1416         (goto-char org-index--point)\r
1417         (org-show-context)\r
1418         (show-subtree)\r
1419         (recenter 1)\r
1420         (delete-other-windows))\r
1421       (throw 'created-new-index nil))\r
1422   \r
1423     (setq buffer-name (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))\r
1424 \r
1425     (setq title (read-from-minibuffer "Please enter the title of the index node: "))\r
1426 \r
1427     (while (progn\r
1428              (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: "))\r
1429              (if (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)\r
1430                  nil\r
1431                (let (desc)\r
1432                  ;; firstref not okay, report details\r
1433                  (setq desc\r
1434                        (cond ((string= firstref "") "is empty") \r
1435                              ((not (string-match "^[^0-9]+" firstref)) "starts with a digit")\r
1436                              ((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number")\r
1437                              ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits")))\r
1438                  (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s. Please hit RET and try again " firstref desc)))\r
1439                t)))\r
1440 \r
1441     (with-current-buffer buffer-name\r
1442       (goto-char (point-max))\r
1443       (insert (format "\n\n* %s %s\n" firstref title))\r
1444       (insert "\n\n  Below you find your initial index table, which will grow over time.\n"\r
1445               "  Following that your may read its detailed explanation, which will help you,\n"\r
1446               "  to adopt org-index to your needs. This however is optional reading and not\n" \r
1447               "  required to start using org-index.\n\n")\r
1448 \r
1449       (setq id (org-id-get-create))\r
1450       (insert (format "\r
1451 \r
1452   |     |      |         |         |               | comment |\r
1453   | ref | link | created | count;s | last-accessed | ;c      |\r
1454   |     | <4>  |         |         |               |         |\r
1455   |-----+------+---------+---------+---------------+---------|\r
1456   | %s  | %s   | %s      |         |               | %s      |\r
1457 \r
1458\r
1459                       firstref\r
1460                       id\r
1461                       (with-temp-buffer (org-insert-time-stamp nil nil t))\r
1462                       "This node"))\r
1463 \r
1464 \r
1465       (insert "\r
1466 \r
1467   Detailed explanation:\r
1468 \r
1469 \r
1470   The index table above has three lines of headings above the first\r
1471   hline:\r
1472 \r
1473   - The first one is ignored by org-index, and you can use it to\r
1474     give meaningful names to columns. In the table above only one\r
1475     column has a name (\"comment\"). This line is optional.\r
1476 \r
1477   - The second line is the most important one, because it\r
1478     contains the configuration information for org-index; please\r
1479     read further below for its format.\r
1480 \r
1481   - The third line is again optional; it may only specify the\r
1482     widths of the individual columns (e.g. <4>).\r
1483 \r
1484   The columns get their meaning by the second line of headings;\r
1485   specifically by one of the keywords (e.g. \"ref\") or a flag\r
1486   seperated by a semicolon (e.g. \";s\").\r
1487 \r
1488 \r
1489 \r
1490   The keywords and flags are:\r
1491 \r
1492 \r
1493   - ref: This contains the reference, which consists of a decorated\r
1494     number, which is incremented for each new line. References are\r
1495     meant to be used in org-mode headlines or outside of orgĀ“,\r
1496     e.g. within folder names.\r
1497 \r
1498   - link: org-mode link pointing to the matching location within org.\r
1499 \r
1500   - created: When has this line been created ?\r
1501 \r
1502   - count: How many times has this line accessed ? The trailing\r
1503     flag \"s\" makes the table beeing sorted after\r
1504     this column, so that often used entries appear at the top of\r
1505     the table.\r
1506 \r
1507   - last-accessed: When has this line ben accessed\r
1508 \r
1509   - The last column above has no keyword, only the flag \"c\",\r
1510     which makes its content beeing copied under certain\r
1511     conditions. It is typically used for comments.\r
1512 \r
1513   The sequence of columns does not matter. You may reorder them any\r
1514   way you like. Columns are found by their name, which appears in\r
1515   the second line of headings.\r
1516 \r
1517   You can add further columns or even remove the last column. All\r
1518   other columns are required.\r
1519 \r
1520 \r
1521   Finally: This node needs not be a top level node; its name is\r
1522   completely at you choice; it is found through its ID only.\r
1523 \r
1524 ")\r
1525 \r
1526 \r
1527       (while (not (org-at-table-p)) (forward-line -1))\r
1528       (org-table-align)\r
1529       (while (not (org-at-heading-p)) (forward-line -1))\r
1530       \r
1531       ;; present results to user\r
1532       (if (and (not create-new-index)\r
1533                org-index--buffer\r
1534                org-index--point)\r
1535           \r
1536           ;; we had an error with the existing table, so present old and new one\r
1537           (progn\r
1538             ;; show existing index\r
1539             (org-pop-to-buffer-same-window org-index--buffer)\r
1540             (goto-char org-index--point)\r
1541             (org-show-context)\r
1542             (show-subtree)\r
1543             (recenter 1)\r
1544             (delete-other-windows)\r
1545             ;; show new index\r
1546             (select-window (split-window-vertically))\r
1547             (org-pop-to-buffer-same-window buffer-name)\r
1548             (org-id-goto id)\r
1549             (org-show-context)    \r
1550             (show-subtree)\r
1551             (recenter 1)\r
1552             (message "Please compare your existing index (upper window) and a temporary new one (lower window) to correct the previous error (\"%s\"); the explanations following the new index table should help." reason))\r
1553 \r
1554         ;; Only show the new index\r
1555         (org-pop-to-buffer-same-window buffer-name)\r
1556         (delete-other-windows)\r
1557         (org-id-goto id)\r
1558         (org-show-context)    \r
1559         (show-subtree)\r
1560         (recenter 1)\r
1561         (setq org-index-id id)\r
1562         (if (y-or-n-p "This is your new index table; Do you want to save its id to make it permanent ? ")\r
1563             (progn\r
1564               (customize-save-variable 'org-index-id id)\r
1565               (message "Saved org-index-id '%s' to %s" org-index-id custom-file))\r
1566           (let (sq)\r
1567             (setq sq (format "(setq org-index-id \"%s\")" org-index-id))\r
1568             (kill-new sq)\r
1569             (message "Did not make the id of the new index permamanent; you may want to put\n\n   %s\n\ninto your own initialization; it is copied already, just yank it." sq)))))\r
1570     ;; cannot handle this situation in higher code, but do not want to finish with an error\r
1571     (throw 'created-new-index nil)))\r
1572 \r
1573 \r
1574 \r
1575 \r
1576 (defun org-index--update-line (ref-or-link)\r
1577 \r
1578   (let (initial\r
1579         found\r
1580         count-field)\r
1581 \r
1582     (with-current-buffer org-index--buffer\r
1583       \r
1584       ;; search reference or link, if given (or assume, that we are already positioned right)\r
1585       (when ref-or-link\r
1586         (setq initial (point))\r
1587         (goto-char org-index--below-hline)\r
1588         (while (and (org-at-table-p)\r
1589                     (not (or (string= ref-or-link (org-index--get-field 'ref))\r
1590                              (string= ref-or-link (org-index--get-field 'link)))))\r
1591           (forward-line)))\r
1592       \r
1593       (if (not (org-at-table-p))\r
1594           (error "Did not find reference or link '%s'" ref-or-link)\r
1595         (setq count-field (org-index--get-field 'count))\r
1596 \r
1597         ;; update count field only if number or empty; leave :missing: and :reuse: as is\r
1598         (if (or (not count-field)\r
1599                 (string-match "^[0-9]+$" count-field))\r
1600             (org-index--get-field 'count\r
1601                                     (number-to-string \r
1602                                      (+ 1 (string-to-number (or count-field "0"))))))\r
1603 \r
1604         ;; update timestamp\r
1605         (org-table-goto-column (org-index--column-num 'last-accessed))\r
1606         (org-table-blank-field)\r
1607         (org-insert-time-stamp nil t t)\r
1608 \r
1609         (setq found t))\r
1610       \r
1611       (if initial (goto-char initial))\r
1612       \r
1613       found)))\r
1614 \r
1615 \r
1616 \r
1617 (defun org-index--get-field (key &optional value)\r
1618   (let (field)\r
1619     (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))\r
1620     (if (string= field "") (setq field nil))\r
1621     \r
1622     field))\r
1623 \r
1624 \r
1625 (defun org-index--column-num (key)\r
1626   (cdr (assoc key org-index--columns)))\r
1627 \r
1628 \r
1629 (defun org-index--make-guarded-search (ref &optional dont-quote)\r
1630   (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b"))\r
1631 \r
1632 \r
1633 (defun org-index-get-ref-regex-format ()\r
1634   "return cons-cell with regular expression and format for references"\r
1635   (unless org-index--ref-regex\r
1636     (org-index-1 'parse))\r
1637   (cons (org-index--make-guarded-search org-index--ref-regex 'dont-quote) org-index--ref-format))\r
1638   \r
1639 \r
1640 (defun org-index--do-occur (initial-search)\r
1641   (let (\r
1642         (occur-buffer-name "*org-index-occur*")\r
1643         (word "") ; last word to search for growing and shrinking on keystrokes\r
1644         (prompt "Search for: ")\r
1645         words     ; list of other words that must match too\r
1646         occur-buffer \r
1647         lines-to-show                 ; number of lines to show in window\r
1648         start-of-lines                ; position, where lines begin\r
1649         left-off-at                   ; stack of last positions in index table\r
1650         after-inserted                ; in occur-buffer\r
1651         lines-visible                 ; in occur-buffer\r
1652         below-hline-bol               ; below-hline and at bol\r
1653         exit-gracefully               ; true if normal exit\r
1654         in-c-backspace                ; true while processing C-backspace\r
1655         ret from to key)\r
1656         \r
1657     ;; clear buffer\r
1658     (if (get-buffer "*org-index-occur*")\r
1659         (kill-buffer occur-buffer-name))\r
1660     (setq occur-buffer (get-buffer-create "*org-index-occur*"))\r
1661 \r
1662     (with-current-buffer org-index--buffer\r
1663       (let ((initial (point)))\r
1664         (goto-char org-index--below-hline)\r
1665         (forward-line 0)\r
1666         (setq below-hline-bol (point))\r
1667         (goto-char initial)))\r
1668     \r
1669     (org-pop-to-buffer-same-window occur-buffer)\r
1670     (toggle-truncate-lines 1)\r
1671 \r
1672     (unwind-protect          ; to reset cursor-shape even in case of errors\r
1673         (progn\r
1674           \r
1675           ;; fill in header\r
1676           (erase-buffer)\r
1677           (insert (concat "Incremental search, showing one window of matches.\n"\r
1678                           "Use DEL and C-DEL to erase, cursor keys to move, RET to find heading.\n\n"))\r
1679           (setq start-of-lines (point))\r
1680           (setq cursor-type 'hollow)\r
1681           \r
1682           ;; get window size of occur-buffer as number of lines to be searched\r
1683           (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1))\r
1684           \r
1685 \r
1686           ;; fill initially\r
1687           (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol))\r
1688           (when (car ret)\r
1689             (insert (cdr ret))\r
1690             (setq left-off-at (cons (car ret) nil))\r
1691             (setq after-inserted (cons (point) nil)))\r
1692 \r
1693           ;; read keys\r
1694           (while \r
1695               (progn\r
1696                 (goto-char start-of-lines)\r
1697                 (setq lines-visible 0)\r
1698                 \r
1699                 ;; use initial-search (if present) to simulate keyboard input\r
1700                 (if (and initial-search \r
1701                          (> (length initial-search) 0))\r
1702                     (progn \r
1703                       (setq key (string-to-char (substring initial-search 0 1)))\r
1704                       (if (length initial-search) \r
1705                           (setq initial-search (substring initial-search 1))))\r
1706                   (if in-c-backspace \r
1707                       (setq key 'backspace)\r
1708                     (setq key (read-event\r
1709                                (format "%s %s" \r
1710                                        prompt \r
1711                                        (mapconcat 'identity (reverse (cons word words)) ","))))\r
1712 \r
1713                     (setq exit-gracefully (memq key (list 'return 'up 'down 'left 'right)))))\r
1714                 \r
1715                 (not exit-gracefully))\r
1716             \r
1717             (cond \r
1718 \r
1719              ((eq key 'C-backspace)\r
1720 \r
1721               (setq in-c-backspace t))\r
1722 \r
1723              ((eq key 'backspace)              ; erase last char\r
1724 \r
1725               (if (= (length word) 0)\r
1726 \r
1727                   ;; nothing more to delete\r
1728                   (setq in-c-backspace nil)\r
1729 \r
1730                 ;; unhighlight longer match\r
1731                 (let ((case-fold-search t))\r
1732                 (unhighlight-regexp (regexp-quote word)))\r
1733 \r
1734                 ;; chars left shorten word\r
1735                 (setq word (substring word 0 -1))\r
1736                 (when (= (length word) 0) ; when nothing left, use next word from list\r
1737                   (setq word (car words))\r
1738                   (setq words (cdr words))\r
1739                   (setq in-c-backspace nil))\r
1740                 \r
1741                 ;; remove everything, that has been added for char just deleted\r
1742                 (when (cdr after-inserted)\r
1743                   (setq after-inserted (cdr after-inserted))\r
1744                   (goto-char (car after-inserted))\r
1745                   (delete-region (point) (point-max)))\r
1746 \r
1747                 ;; back up last position in index table too\r
1748                 (when (cdr left-off-at) \r
1749                   (setq left-off-at (cdr left-off-at)))\r
1750 \r
1751                 ;; go through buffer and check, if any invisible line should now be shown\r
1752                 (goto-char start-of-lines)\r
1753                 (while (< (point) (point-max))\r
1754                   (if (outline-invisible-p)\r
1755                       (progn\r
1756                         (setq from (line-beginning-position) \r
1757                               to (line-beginning-position 2))\r
1758 \r
1759                         ;; check for matches\r
1760                         (when (org-index--test-words (cons word words) (buffer-substring from to))\r
1761                           (when (<= lines-visible lines-to-show) ; show, if more lines required\r
1762                             (outline-flag-region from to nil) \r
1763                             (incf lines-visible))))\r
1764 \r
1765                     ;; already visible, just count\r
1766                     (incf lines-visible))\r
1767 \r
1768                   (forward-line 1))\r
1769 \r
1770                 ;; highlight shorter word\r
1771                 (unless (= (length word) 0)\r
1772                   (let ((case-fold-search t))\r
1773                     (highlight-regexp (regexp-quote word) 'isearch)))))\r
1774 \r
1775 \r
1776              ((eq key ?,)         ; comma: enter an additional search word\r
1777 \r
1778               ;; push current word and clear, no need to change display\r
1779               (setq words (cons word words))\r
1780               (setq word ""))\r
1781 \r
1782 \r
1783              ((and (characterp key)\r
1784                    (aref printable-chars key)) ; any other char: add to current search word\r
1785 \r
1786 \r
1787               ;; unhighlight short word\r
1788               (unless (= (length word) 0)\r
1789                 (let ((case-fold-search t))\r
1790                   (unhighlight-regexp (regexp-quote word))))\r
1791 \r
1792               ;; add to word\r
1793               (setq word (concat word (downcase (string key))))\r
1794 \r
1795               ;; hide lines, that do not match longer word any more\r
1796               (while (< (point) (point-max))\r
1797                 (unless (outline-invisible-p)\r
1798                   (setq from (line-beginning-position) \r
1799                         to (line-beginning-position 2))\r
1800 \r
1801                   ;; check for matches\r
1802                   (if (org-index--test-words (list word) (buffer-substring from to))\r
1803                       (incf lines-visible)            ; count as visible\r
1804                     (outline-flag-region from to t))) ; hide\r
1805 \r
1806                 (forward-line 1))\r
1807 \r
1808               ;; duplicate top of stacks; eventually overwritten below\r
1809               (setq left-off-at (cons (car left-off-at) left-off-at))\r
1810               (setq after-inserted (cons (car after-inserted) after-inserted))\r
1811 \r
1812               ;; get new lines from index table\r
1813               (when (< lines-visible lines-to-show)\r
1814                 (setq ret (org-index--get-matching-lines (cons word words) \r
1815                                                             (- lines-to-show lines-visible) \r
1816                                                             (car left-off-at)))\r
1817 \r
1818                 (when (car ret)\r
1819                   (insert (cdr ret))\r
1820                   (setcar left-off-at (car ret))\r
1821                   (setcar after-inserted (point))))\r
1822 \r
1823               ;; highlight longer word\r
1824               (let ((case-fold-search t))\r
1825                 (highlight-regexp (regexp-quote word) 'isearch)))))\r
1826           \r
1827           ;; search is done collect and brush up results\r
1828           ;; remove any lines, that are still invisible\r
1829           (goto-char start-of-lines)\r
1830           (while (< (point) (point-max))\r
1831             (if (outline-invisible-p)\r
1832                 (delete-region (line-beginning-position) (line-beginning-position 2))\r
1833               (forward-line 1)))\r
1834 \r
1835           ;; get all the rest\r
1836           (message "Getting all matches ...")\r
1837           (setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at)))\r
1838           (message "done.")\r
1839           (insert (cdr ret)))\r
1840       \r
1841       ;; postprocessing even for non graceful exit\r
1842       (setq cursor-type t)\r
1843       ;; replace previous heading\r
1844       (let ((numlines (count-lines (point) start-of-lines)))\r
1845         (goto-char start-of-lines)\r
1846         (forward-line -1)\r
1847         (delete-region (point-min) (point))\r
1848         (insert (format  (concat (if exit-gracefully \r
1849                                      "Search is done; showing all %d matchs.\n"\r
1850                                    "Search aborted; showing only some matches.\n")\r
1851                                  "Use cursor keys to move, press RET to find heading.\n")\r
1852                          numlines)))\r
1853       (forward-line))\r
1854 \r
1855     ;; install keyboard-shortcuts within occur-buffer\r
1856     (let ((keymap (make-sparse-keymap))\r
1857           fun-on-ret)\r
1858       (set-keymap-parent keymap text-mode-map)\r
1859 \r
1860       (setq fun-on-ret (lambda () (interactive) \r
1861                          (let ((ref (org-index--get-field 'ref)) \r
1862                                (link (org-index--get-field 'link)))\r
1863                            (org-index-1 'head\r
1864                                          (or link ref) ;; prefer link\r
1865                                          (if link t nil)))))      \r
1866 \r
1867       (define-key keymap (kbd "RET") fun-on-ret)\r
1868       (use-local-map keymap)\r
1869     \r
1870       ;; perform action according to last char\r
1871       (cond \r
1872        ((eq key 'return)\r
1873         (funcall fun-on-ret))\r
1874 \r
1875        ((eq key 'up)\r
1876          (forward-line -1))\r
1877 \r
1878        ((eq key 'down)\r
1879          (forward-line 1))\r
1880 \r
1881        ((eq key 'left)\r
1882          (forward-char -1))\r
1883 \r
1884        ((eq key 'right)\r
1885          (forward-char 1))))))\r
1886 \r
1887 \r
1888 (defun org-index--get-matching-lines (words numlines start-from)\r
1889   (let ((numfound 0)\r
1890         pos\r
1891         initial line lines)\r
1892     \r
1893     (with-current-buffer org-index--buffer\r
1894 \r
1895       ;; remember initial pos and start at requested\r
1896       (setq initial (point))\r
1897       (goto-char start-from) \r
1898       \r
1899       ;; loop over buffer until we have found enough lines\r
1900       (while (and (or (< numfound numlines)\r
1901                       (= numlines 0))\r
1902                   (org-at-table-p))\r
1903 \r
1904         ;; check each word\r
1905         (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2)))\r
1906         (when (org-index--test-words words line) \r
1907           (setq lines (concat lines line))\r
1908           (incf numfound))\r
1909         (forward-line 1)\r
1910         (setq pos (point)))\r
1911 \r
1912       ;; return to initial position\r
1913       (goto-char initial))\r
1914 \r
1915     (unless lines (setq lines ""))\r
1916     (cons pos lines)))\r
1917 \r
1918 \r
1919 (defun org-index--test-words (words line)\r
1920   (let ((found-all t))\r
1921     (setq line (downcase line))\r
1922     (catch 'not-found\r
1923         (dolist (w words)\r
1924           (or (search w line)\r
1925               (throw 'not-found nil)))\r
1926         t)))\r
1927 \r
1928 \r
1929 (defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate)\r
1930   "Make text from org-index available for yank."\r
1931   (when org-index--text-to-yank\r
1932       (kill-new org-index--text-to-yank)\r
1933       (message (format "Ready to yank '%s'" org-index--text-to-yank))\r
1934       (setq org-index--text-to-yank nil)))\r
1935 \r
1936 \r
1937 (provide 'org-index)\r
1938 \r
1939 ;; Local Variables:\r
1940 ;; fill-column: 75\r
1941 ;; comment-column: 50\r
1942 ;; End:\r
1943 \r
1944 ;;; org-index.el ends here\r