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