new version 1.5 or org-refer-by-number.el
[worg.git] / code / elisp / org-refer-by-number.el
1 ;;; org-refer-by-number.el --- Create and search numbers used as references\r
2 \r
3 ;; Copyright (C) 2011,2012 Free Software Foundation, Inc.\r
4 \r
5 ;; Author: Marc-Oliver Ihm <ihm@ferntreffer.de>\r
6 ;; Keywords: hypermedia, matching\r
7 ;; Requires: org\r
8 ;; Download: http://orgmode.org/worg/code/elisp/org-refer-by-number.el\r
9 ;; Version: 1.5.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 ;;  Refer to things by reference numbers, especially if direct linking is\r
33 ;;  not possible. These reference numbers are added to and kept within a\r
34 ;;  table along with the timestamp of their creation.\r
35 ;;\r
36 ;;  These reference numbers may then be used to refer to things outside of\r
37 ;;  or within Org. E.g. by writing them on a piece of paper or using them\r
38 ;;  as part of a directory name or the heading of an Org node. Within Org\r
39 ;;  you may then refer to these things by their reference number\r
40 ;;  (e.g. "R153"); the numbers can be looked up and searched easily.\r
41 ;;\r
42 ;;  The whole functionality is available through the function\r
43 ;;  `org-refer-by-number'; the necessary setup is described in the\r
44 ;;  docstring of the variable `org-refer-by-number-id'.\r
45 ;;\r
46 ;;  org-refer-by-number.el is only a small add-on to Carsten Dominiks\r
47 ;;  Org-mode, which must be installed as a prerequisite. See\r
48 ;;  http://orgmode.org or elpa for Org-mode itself.\r
49 ;;\r
50 ;; Setup:\r
51 ;;\r
52 ;;  - Adjust these lines and add them to your .emacs:\r
53 ;;\r
54 ;;    (require 'org-refer-by-number)\r
55 ;;    (setq org-refer-by-number-id "00e26bef-1929-4110-b8b4-7eb9c9ab1fd4")\r
56 ;;    ;; Optionally assign a key\r
57 ;;    (global-set-key (kbd "C-+") 'org-refer-by-number)\r
58 ;;\r
59 ;;  - Create an Org-mode node with a reference table\r
60 ;;    as described in the documentation of `org-refer-by-number-id'\r
61 ;;\r
62 ;; Further reading:\r
63 ;;\r
64 ;;  For the necessary setup, see the variable `org-refer-by-number-id';\r
65 ;;  for regular usage, see the function `org-refer-by-number'.\r
66 ;;\r
67 \r
68 ;;; Change Log:\r
69 \r
70 ;;   [2012-09-22 Sa] Version 1.5.0:\r
71 ;;   - New operation "sort" to sort a buffer or region by reference number\r
72 ;;   - New operations "highlight" and "unhighlight" to mark references\r
73 \r
74 ;;   [2012-07-13 Fr] Version 1.4.0:\r
75 ;;   - New operation "head" to find a headline with a reference number\r
76 \r
77 ;;   [2012-04-28 Sa] Version 1.3.0:\r
78 ;;   - New operations occur and multi-occur\r
79 ;;   - All operations can now be invoked explicitly\r
80 ;;   - New documentation\r
81 ;;   - Many bugfixes\r
82 \r
83 ;;   [2011-12-10 Sa] Version 1.2.0:\r
84 ;;   - Fixed a bug, which lead to a loss of newly created reference numbers\r
85 ;;   - Introduced single and double prefix arguments\r
86 ;;   - Started this Change Log\r
87 \r
88 ;;; Code:\r
89 \r
90 (require 'org-table)\r
91 \r
92 (defvar org-refer-by-number-id nil \r
93   "Id of the Org-mode node, with the table of reference numbers.\r
94 \r
95 Read below, on how to set up things. See the documentation of\r
96 `org-refer-by-number' for normal usage after setup.\r
97 \r
98 Setup requires two steps:\r
99 \r
100 - Create a suitable org-mode node\r
101 - Adjust your .emacs initialization file\r
102 \r
103 \r
104 Here is how you create the org-mode node, where your reference\r
105 numbers will be stored. It may look like this:\r
106 \r
107 \r
108   * My node for org-refer-by-number\r
109     :PROPERTIES:\r
110     :ID:       00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\r
111     :END:\r
112   \r
113     | Number | Date            | Comment                    |\r
114     |--------+-----------------+----------------------------|\r
115     | R1     | [2012-04-28 Sa] | My first reference number  |\r
116 \r
117 \r
118 You may just want to copy this node into one of your org-files.\r
119 Many things however can or should be adjusted:\r
120 \r
121 - The node needs not be a top level node.\r
122 \r
123 - Its name is completely at you choice. The node is found\r
124   through its ID.\r
125 \r
126 - Column names can be changed.\r
127 \r
128 - You can add further columns or even remove the\r
129   \"Comment\"-column. The columns \"Number\" and \"Date\" however\r
130   are required.\r
131 \r
132 - Your references need not start at \"R1\"; and of course you can\r
133   adjust date and comment.  However, having an initial row is\r
134   required (it servers a template for subsequent references).\r
135 \r
136 - Your reference need not have the form \"R1\"; you may just as\r
137   well choose any text, that contains a single number,\r
138   e.g. \"reference-{1}\" or \"#1\" or \"++1++\". The function\r
139   `org-refer-by-number' will inspect your first reference and\r
140   create all subsequent references in the same way.\r
141     \r
142 - You may want to change the ID-Property of the node above and\r
143   create a new one, which is unique (and not just a copy of\r
144   mine). You need to change it in the lines copied to your .emacs\r
145   too. However, this is not strictly required to make things\r
146   work, so you may do this later, after trying out this package.\r
147 \r
148 \r
149 Having created the node with your reference table, you only need\r
150 to add some lines to your .emacs:\r
151 \r
152   (require 'org-refer-by-number)\r
153   (setq org-refer-by-number-id \"00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\")\r
154   ;; Optionally assign a key\r
155   (global-set-key (kbd \"C-+\") 'org-refer-by-number)\r
156 \r
157 Do not forget to restart emacs to make these lines effective.\r
158 \r
159 \r
160 After this two-step setup you may invoke `org-refer-by-number' to\r
161 create a new reference number; read there for instructions on\r
162 normal usage.\r
163 \r
164 ")\r
165 \r
166 (defvar org-refer-by-number-windowconfig nil \r
167   "Saved window-configuration for `org-refer-by-number'.\r
168 This variable is only used internally.")\r
169 \r
170 (defvar org-refer-by-number-marker nil \r
171   "Saved marker for `org-refer-by-number'.\r
172 This variable is only used internally.")\r
173 \r
174 (defvar org-refer-by-number-last-action nil \r
175   "Last action performed by `org-refer-by-number'.\r
176 This variable is only used internally.")\r
177 \r
178 (defvar org-refer-by-number-occur-buffer nil\r
179   "Buffer (if any) with result from occur or multi-occur.\r
180 This variable is only used internally.")\r
181 \r
182 (defun org-refer-by-number (arg) \r
183   "Add a new reference number or search for an existing one.\r
184 \r
185 These reference numbers may then be used to refer to things\r
186 outside of Org in cases, where direct linking is not\r
187 possible. E.g. you may write them on documents or letters you\r
188 receive or use them on your computer as part of foldernames that\r
189 you create.\r
190 \r
191 Read below for a detailed description of this function. See the\r
192 documentation of `org-refer-by-number-id' for the necessary\r
193 setup.\r
194 \r
195 \r
196 The function `org-refer-by-number' operates on a dedicated\r
197 table (called the reference table) within a special Org-mode\r
198 node. The node has to be created as part of your initial\r
199 setup. The reference table has at least two columns: The\r
200 reference number (automatically increasing by one from row to\r
201 row) and the date of creation. The table is found through the id\r
202 of the containing node; this id must be stored within\r
203 `org-refer-by-number-id' (see there for details).\r
204 \r
205 \r
206 The function `org-refer-by-number' is the only interactive\r
207 function of this package and its sole entry point; it offers seven\r
208 different operations (short names in parens):\r
209 \r
210 - Add a new row with a new reference number and the\r
211   date of creation (\"add\").\r
212 \r
213 - Search for an existing reference number within your reference\r
214   table (\"search\").\r
215 \r
216 - Find all occurences of a particular string within your\r
217   reference table; typically within the comment\r
218   column (\"occur\").\r
219 \r
220 - Find all occurences of a particular reference number within all\r
221   of your org-files (\"multi-occur\").\r
222 \r
223 - Go to the first heading, that contains a given reference\r
224   number (\"heading\").\r
225 \r
226 - Enter the reference table and position the cursor at the\r
227   top (\"enter\").\r
228 \r
229 - Leave the reference table and restore cursor position and\r
230   window configuration, back to the state before entering\r
231   it (\"leave\").\r
232 \r
233 - Sort lines in current buffer or active region by the first\r
234   reference number, they contain, if any (\"sort\").\r
235 \r
236 - Highlight or unhighlight all occurences of reference number\r
237   within current buffer (\"highlight\" or \"unhighlight\").\r
238  \r
239 The most straightforward way to select between these operations\r
240 is to supply a negative or a a double prefix argument:\r
241 \r
242 `C-- \\[org-refer-by-number]' or `\\[universal-argument] \\[universal-argument] \\[org-refer-by-number]'\r
243 \r
244 You will then be prompted to type a single letter (\"a\", \"s\",\r
245 \"o\", \"m\", \"h\", \"e\" or \"l\") to invoke the respective\r
246 operation from the list above. If your type \"+\" you will be\r
247 prompted a second time to choose among some of the less common\r
248 operations (e.g. \"sort\").\r
249 \r
250 \r
251 Some of the operations above can be invoked with less keystrokes. In that\r
252 case the precise operation invoked depends on two things:\r
253 \r
254 - The kind of a prefix argument (or absence of such)\r
255 \r
256 - The location of point; either outside the reference table or\r
257   within\r
258 \r
259 \r
260 The following cases explain, which of the seven\r
261 operations (\"add\", \"search\", \"occur\", \"multi-occur\",\r
262 \"heading\", \"enter\" and \"leave\") is actually invoked\r
263 depending on the conditions above:\r
264 \r
265 \r
266   If no prefix argument is given (`\\[org-refer-by-number]') and\r
267   point is withib the reference table, the operation \"leave\"\r
268   will be invoked. If point is within reference table, a\r
269   \"search\" will be done in most cases; if, however, there is an\r
270   active region, the operation \"add\" is performed.\r
271 \r
272   If a numeric prefix argument is given (e.g. `153 \\[org-refer-by-number]'): \r
273   The function does a \"search\" for this reference number, \r
274   if point is outside and a \"multi-occur\", if point is within\r
275   regardless of position of point.\r
276 \r
277   If a single prefix argument is given (e.g. `\\[universal-argument] \\[org-refer-by-number]')\r
278   and point outside the reference table: \"add\" a new reference. \r
279   If point within: Do a \"multi-occur\" for the given reference.\r
280 \r
281 \r
282 In any case the function `org-refer-by-number' will give a short\r
283 message to explain, what operation has actually been invoked.\r
284 \r
285 \r
286 Before you can successfully use `org-refer-by-number' finally,\r
287 you need to read the documentation of `org-refer-by-number-id'\r
288 and complete the necessary setup decribed there.\r
289 \r
290 \r
291 "\r
292 \r
293   (interactive "P")\r
294 \r
295   (let (within-node        ; True, if we are within node with reference table\r
296                            ; (false otherwise, even if we are in the\r
297                            ; right buffer)\r
298         result-is-visible  ; True, if node or occur is visible in any window\r
299         search-from-prefix ; search string from prefix-argument\r
300         search-from-table  ; search string from first column of table\r
301         search-from-cursor ; search string from text below cursro\r
302         search-from-user   ; search string from user input\r
303         below-cursor       ; word below cursor\r
304         active-region      ; active region (if any)\r
305         search             ; final string to search for\r
306         guarded-search     ; with guard against additional digits\r
307         what               ; What are we supposed to do ? Will be stored in\r
308                            ; org-refer-by-number-last-action\r
309         what-adjusted      ; True, if we had to adjust what\r
310         what-explicit      ; True, if what has been specified explicitly\r
311         parts              ; Parts of a typical reference number (which\r
312                            ; need not be a plain number); these are:\r
313         head               ; Any header before number (e.g. "R")\r
314         last-number        ; Last number used in reference table (e.g. "153")\r
315         tail               ; Tail after number (e.g. "}" or "")\r
316         ref-regex          ; Regular expression to match a reference\r
317         columns            ; Number of columns in reference table\r
318         kill-new-text      ; Text that will be appended to kill ring\r
319         message-text       ; Text that will be issued as an explanation,\r
320                            ; what we have done\r
321         node-marker        ; Initial point within buffer with reference table\r
322         )\r
323         \r
324     ;; Find out, if we are within reference table or not\r
325     (setq within-node (string= (org-id-get) org-refer-by-number-id))\r
326     ;; Find out, if point in any window is within node with reference table\r
327     (mapc (lambda (x) (save-excursion \r
328                         (set-buffer (window-buffer x))\r
329                         (when (or \r
330                                (string= (org-id-get) org-refer-by-number-id)\r
331                                (eq (window-buffer x) \r
332                                    org-refer-by-number-occur-buffer))\r
333                           (setq result-is-visible t))))\r
334           (window-list))\r
335 \r
336     ;; Get the content of the active region or the word under cursor; do\r
337     ;; this before examinig reference table\r
338      (if (and transient-mark-mode\r
339               mark-active)\r
340         (setq active-region (buffer-substring (region-beginning) (region-end))))\r
341      (setq below-cursor (thing-at-point 'symbol))\r
342 \r
343     ;; Find out, what we are supposed to do\r
344     (cond ((equal arg nil)\r
345            (setq what (if result-is-visible 'leave \r
346                         (if active-region 'add 'search))))\r
347           ((equal arg '(4))\r
348            (setq what (if within-node 'multi-occur 'add)))\r
349           ((numberp arg)\r
350            (setq what (if within-node 'multi-occur 'search)))\r
351           (t ; C-- or C-u C-u\r
352            (let (key)\r
353              (while \r
354                  (progn \r
355                    (setq key (read-char-exclusive \r
356                               "Please choose: e=enter l=leave s=search a=add o=occur m=multi-occur h=heading +=more choices"))\r
357                    (not \r
358                     (setq what (case key\r
359                                  (?l 'leave) (?e 'enter) (?a 'add) \r
360                                  (?s 'search) (?o 'occur) (?m 'multi-occur) (?h 'heading) (?+ 'more)))))\r
361                (message "Invalid key '%c'" key)\r
362                (sleep-for 1))\r
363              (if (eq what 'more)\r
364                  (setq what (cdr (assoc \r
365                                   (org-icompleting-read "Please choose: " '("sort" "highlight" "unhighlight") nil t)\r
366                                   '(("sort" . sort)("highlight" . highlight)("unhighlight" . unhighlight))))))\r
367              (setq what-explicit t))))\r
368 \r
369     ;; Get decoration and number of last row from reference table\r
370     (let ((m (org-id-find org-refer-by-number-id 'marker)))\r
371       (unless m\r
372         (org-refer-by-number-report-setup-error \r
373          (format "Cannot find node with id \"%s\"" org-refer-by-number-id)))\r
374       (with-current-buffer (marker-buffer m)\r
375         (setq node-marker (point-marker))\r
376         (setq node-buffer (marker-buffer node-marker))\r
377         (goto-char m)\r
378         (setq parts (org-refer-by-number-trim-table nil t))\r
379         (goto-char node-marker))\r
380       (move-marker m nil)\r
381       (setq head (nth 0 parts))\r
382       (setq last-number (nth 1 parts))\r
383       (setq tail (nth 2 parts))\r
384       (setq columns (nth 3 parts))\r
385       (setq ref-regex (concat (regexp-quote head) "\\([0-9]+\\)" (regexp-quote tail))))\r
386       \r
387 \r
388     ;; These actions need a search string:\r
389     (when (memq what '(search occur multi-occur heading))\r
390 \r
391       ;; Search string can come from several sources:\r
392       ;; From explicit numerical prefix\r
393       (if (numberp arg) \r
394           (setq search-from-prefix (format "%s%d%s" head arg tail)))\r
395       ;; From first column of table\r
396       (when within-node\r
397         (save-excursion (setq search-from-table (org-table-get-field 1)))\r
398         (if (string= search-from-table "") (setq search-from-table nil)))      \r
399       ;; From string below cursor\r
400       (when (and (not within-node)\r
401                  below-cursor\r
402                  (string-match (concat "\\(" ref-regex "\\)") \r
403                                below-cursor))\r
404         (setq search-from-cursor (match-string 1 below-cursor)))\r
405       \r
406       ;; Depending on requested action, get search from one of the sources above\r
407       (cond ((eq what 'search)\r
408              (setq search (or search-from-prefix search-from-cursor)))\r
409             ((or (eq what 'multi-occur) (eq what 'heading))\r
410              (setq search (or search-from-table search-from-cursor)))\r
411             ((eq what 'occur)\r
412              (setq search active-region)))\r
413 \r
414 \r
415       ;; If we still do not have a search string, ask user explicitly\r
416       (unless search\r
417         (setq search (read-from-minibuffer\r
418                       (cond ((memq what '(search multi-occur heading))\r
419                              "Reference number to search for: ")\r
420                             ((eq what 'occur)\r
421                              "Text to search for: "))))\r
422         (if (string-match "^\\s *[0-9]*\\s *$" search)\r
423             (unless (string= search "")\r
424               (setq search (format "%s%s%s" head (org-trim search) tail)))))\r
425       \r
426       ;; Clean up search string\r
427       (if (string= search "") (setq search nil))\r
428       (if search (setq search (org-trim search)))\r
429 \r
430       (setq guarded-search \r
431             (concat (regexp-quote search)\r
432                     ;; if there is no tail in reference number, we\r
433                     ;; have to guard agains trailing digits\r
434                     (if (string= tail "") "\\($\\|[^0-9]\\)" "")))\r
435 \r
436     \r
437       ;; Correct requested action, if nothing to search\r
438       (when (and (not search)\r
439                (memq what '(search occur multi-occur heading)))\r
440           (setq what 'enter)\r
441           (setq what-adjusted t))\r
442            \r
443       ;; Check for invalid combinations of arguments; try to be helpful\r
444       (if (string-match ref-regex search)\r
445           (if (eq what 'occur) \r
446               (error "Can do 'occur' only for text, try 'search', 'multi-occur' or 'heading' for a number"))\r
447         (if (memq what '(search multi-occur heading))\r
448             (error "Can do '%s' only for a number, try 'occur' to search for text" what))))\r
449     \r
450     ;; Move into table, if outside ...\r
451     (when (memq what '(enter add search occur multi-occur))\r
452       ;; Save current window configuration\r
453       (when (or (not result-is-visible)\r
454                 (not org-refer-by-number-windowconfig))\r
455         (setq org-refer-by-number-windowconfig (current-window-configuration))\r
456         (setq org-refer-by-number-marker node-marker))\r
457       \r
458       ;; Switch to reference table; this needs to duplicate some code from\r
459       ;; org-id-goto, because point should be moved, if what equals 'enter\r
460       (let ((m (org-id-find org-refer-by-number-id 'marker)))\r
461         (org-pop-to-buffer-same-window (marker-buffer m))\r
462         ;; After changing buffer we might be in table or not, so check again\r
463         (setq within-node (string= (org-id-get) org-refer-by-number-id))\r
464         ;; Be careful with position within table, if we should just enter it\r
465         (unless within-node (goto-char m))\r
466         (move-marker m nil)\r
467         (show-subtree)\r
468         (org-show-context)))\r
469 \r
470 \r
471     ;; Actually do, what is requested\r
472     (cond\r
473      ((eq what 'multi-occur) \r
474       \r
475       ;; Position cursor on number to search for\r
476       (org-refer-by-number-trim-table t)\r
477       (let (found (initial (point)))\r
478         (forward-line)\r
479         (while (and (not found)\r
480                     (forward-line -1)\r
481                     (org-at-table-p))\r
482           (save-excursion \r
483             (setq found (string= search \r
484                                  (org-trim (org-table-get-field 1))))))\r
485         (if found \r
486             (org-table-goto-column 1)\r
487           (goto-char initial)))\r
488 \r
489       ;; Construct list of all org-buffers\r
490       (let (buff org-buffers)\r
491         (dolist (buff (buffer-list))\r
492           (set-buffer buff)\r
493           (if (string= major-mode "org-mode")\r
494               (setq org-buffers (cons buff org-buffers))))\r
495        \r
496         ;; Do multi-occur\r
497         (multi-occur org-buffers guarded-search)\r
498         (if (get-buffer "*Occur*")\r
499             (progn \r
500               (setq message-text (format "multi-occur for '%s'" search))\r
501               (setq org-refer-by-number-occur-buffer (get-buffer "*Occur*")))\r
502           (setq message-text (format "Did not find '%s'" search)))))\r
503 \r
504 \r
505      ((eq what 'heading)\r
506       (message (format "Scanning headlines for '%s' ..." search))\r
507       (let (buffer point)\r
508         (if (catch 'found\r
509               (progn\r
510                 (org-map-entries \r
511                  (lambda () \r
512                    (when (looking-at (concat ".*\\b" guarded-search))\r
513                      (setq buffer (current-buffer))\r
514                      (setq point (point))\r
515                      (throw 'found t)))          \r
516                  nil 'agenda)\r
517                 nil))\r
518             (progn\r
519               (setq message-text (format "Found '%s'" search))\r
520               (org-pop-to-buffer-same-window buffer)\r
521               (goto-char point)\r
522               (org-reveal))\r
523           (setq message-text (format "Did not find '%s'" search)))))\r
524 \r
525 \r
526      ((eq what 'leave)\r
527 \r
528       (when result-is-visible\r
529 \r
530         ;; if we are within the occur-buffer, switch over to get current line\r
531         (if (and (string= (buffer-name) "*Occur*")\r
532                  (eq org-refer-by-number-last-action 'occur))\r
533             (occur-mode-goto-occurrence))\r
534         \r
535         (if (org-at-table-p)\r
536             (let ((column (org-table-current-column)))\r
537               ;; Copy different things depending on the last action\r
538               (if (and (eq org-refer-by-number-last-action 'search)\r
539                        (= column 1))\r
540                   ;; It does not help to copy the first field, because\r
541                   ;; thats what we just searched for, so take last one\r
542                   (setq column columns))\r
543               (if (or (memq org-refer-by-number-last-action '(add occur))\r
544                       (< column 1))\r
545                   (setq column 1))\r
546               \r
547               ;; Add to kill ring\r
548               (if (memq org-refer-by-number-last-action '(add enter search occur))\r
549                   ;; Got left to first nonempty column\r
550                   (while (progn \r
551                            (save-excursion \r
552                              (setq kill-new-text \r
553                                    (org-trim (org-table-get-field column))))\r
554                            (and (> column 0)\r
555                                 (string= kill-new-text "")))\r
556                     (setq column (- column 1))))))\r
557         \r
558         ;; Clean up table before leaving\r
559         (with-current-buffer node-buffer \r
560           (org-refer-by-number-trim-table t)\r
561           (let ((buffer-modified (buffer-modified-p)))\r
562             (org-table-align)\r
563             (set-buffer-modified-p buffer-modified))))\r
564 \r
565       ;; Restore position within buffer with reference table\r
566       (if org-refer-by-number-windowconfig \r
567           (progn  \r
568             (with-current-buffer node-buffer\r
569               (goto-char org-refer-by-number-marker)\r
570               (set-marker org-refer-by-number-marker nil))\r
571             ;; Restore initial window configuration\r
572             (set-window-configuration org-refer-by-number-windowconfig)\r
573             (setq org-refer-by-number-windowconfig nil)\r
574             (recenter)\r
575             (setq message-text "Back"))\r
576         ;; We did not have a window-configuration to restore, so we cannot\r
577         ;; pretend we have retturned back\r
578         (setq message-text "Cannot leave; nowhere to go to")))\r
579 \r
580         \r
581      ((eq what 'search)\r
582       ;; Go upward in table within first column\r
583       (org-refer-by-number-trim-table t)\r
584       (let (found (initial (point)))\r
585         (forward-line)\r
586         (while (and (not found)\r
587                     (forward-line -1)\r
588                     (org-at-table-p))\r
589           (save-excursion \r
590             (setq found \r
591                   (string= search \r
592                            (org-trim (org-table-get-field 1))))))\r
593         (if found\r
594             (progn\r
595               (setq message-text (format "Found '%s'" search))\r
596               (org-table-goto-column 1)\r
597               (if (looking-back " ") (backward-char)))\r
598           (setq message-text (format "Did not find '%s'" search))\r
599           (goto-char initial)\r
600           (forward-line)\r
601           (setq what 'missed))))\r
602 \r
603 \r
604      ((eq what 'occur)\r
605       ;; search for string: occur\r
606       (org-narrow-to-subtree)\r
607       (occur search)\r
608       (widen)\r
609       (if (get-buffer "*Occur*")\r
610           (progn\r
611             (put 'org-refer-by-number 'occur-buffer (current-buffer))\r
612             (other-window 1)\r
613             (toggle-truncate-lines 1)\r
614             (forward-line 1)\r
615             (occur-mode-display-occurrence)\r
616             (setq message-text\r
617                   (format  "Occur for '%s'" search)))\r
618         (setq message-text\r
619               (format "Did not find any matches for '%s'" search))))\r
620 \r
621         \r
622      ((eq what 'add)\r
623       ;; Nothing to search for, add a new row\r
624       (org-refer-by-number-trim-table t)\r
625       (let ((new (format "%s%d%s" head (1+ last-number) tail)))\r
626         (org-table-insert-row 1)\r
627         (insert new)\r
628         (org-table-goto-column 2)\r
629         (org-insert-time-stamp nil nil t)\r
630         (org-table-goto-column 3)\r
631         (org-table-align)\r
632         (if active-region (setq kill-new-text active-region))\r
633         (setq message-text (format "Adding a new row '%s'" new))))\r
634      \r
635      \r
636      ((eq what 'enter)\r
637       ;; Already there, not much to do left\r
638       (show-subtree)\r
639       (recenter)\r
640       (if what-adjusted\r
641           (setq message-text "Nothing to search for; at reference table")\r
642         (setq message-text "At reference table")))\r
643      \r
644 \r
645      ((eq what 'sort)\r
646       (let (begin end where)\r
647         (if (if (and transient-mark-mode\r
648                      mark-active)\r
649                 (progn\r
650                   (setq begin (region-beginning))\r
651                   (setq end (region-end))\r
652                   (setq where "region")\r
653                   t)\r
654               (setq begin (point-min))\r
655               (setq end (point-max))\r
656               (setq where "whole buffer")\r
657               (y-or-n-p "Sort whole buffer ")\r
658               )\r
659             (save-excursion\r
660               (save-restriction\r
661                 (beginning-of-buffer)\r
662                 (narrow-to-region begin end)\r
663                 (sort-subr nil 'forward-line 'end-of-line \r
664                            (lambda ()\r
665                              (if (looking-at (concat "^.*\\b" ref-regex "\\b"))\r
666                                  (string-to-number (match-string 1))\r
667                                0))))\r
668               (highlight-regexp ref-regex)\r
669               (setq message-text (format "Sorted %s from character %d to %d, %d lines" \r
670                                          where begin end\r
671                                          (count-lines begin end))))\r
672           (setq message-text "Sort aborted"))))\r
673       \r
674 \r
675      ((memq what '(highlight unhighlight))\r
676       (let ((where "buffer"))\r
677         (save-excursion\r
678           (save-restriction\r
679             (when (and transient-mark-mode\r
680                      mark-active)\r
681                 (narrow-to-region (region-beginning) (region-end))\r
682                 (setq where "region")\r
683               )\r
684           (if (eq what 'highlight)\r
685               (progn\r
686                 (highlight-regexp ref-regex)\r
687                 (setq message-text (format "Highlighted references in %s" where)))\r
688             (unhighlight-regexp ref-regex)\r
689             (setq message-text (format "Removed highlights for references in %s" where)))))))\r
690      \r
691 \r
692      (t (error "This is a bug: Unmatched condition '%s'" what)))\r
693 \r
694     \r
695     ;; Remember what we have done for next time\r
696     (setq org-refer-by-number-last-action what)\r
697     \r
698     ;; Tell, what we have done and what can be yanked\r
699     (if kill-new-text (setq kill-new-text \r
700                             (substring-no-properties kill-new-text)))\r
701     (if (string= kill-new-text "") (setq kill-new-text nil))\r
702     (let ((m (concat \r
703               message-text\r
704               (if (and message-text kill-new-text) \r
705                   " and r" \r
706                 (if kill-new-text "R" ""))\r
707               (if kill-new-text (format "eady to yank '%s'" kill-new-text) "")\r
708               )))\r
709       (unless (string= m "") (message m)))\r
710     (if kill-new-text (kill-new kill-new-text))))\r
711 \r
712 \r
713 (defun org-refer-by-number-trim-table (&optional goto-end get-parts)\r
714   "Trim reference table, only used internally"\r
715   \r
716   (let ((initial (point-marker))\r
717         field\r
718         parts\r
719         columns)\r
720 \r
721     ;; Go to heading of node\r
722     (while (not (org-at-heading-p)) (forward-line -1))\r
723     (forward-line 1)\r
724     ;; Go to table within node, but make sure we do not get into another node\r
725     (while (and (not (org-at-heading-p))\r
726                 (not (org-at-table-p))\r
727                 (not (eq (point) (point-max)))) \r
728       (forward-line 1))\r
729     ;; Check, if there really is a table\r
730     (unless (org-at-table-p)\r
731       (org-refer-by-number-report-setup-error \r
732        "Cannot find reference table within reference node" t))\r
733 \r
734     ;; Go beyond end of table\r
735     (while (org-at-table-p) (forward-line 1))\r
736 \r
737     ;; Kill all empty rows at bottom\r
738     (while (progn\r
739              (forward-line -1)\r
740              (org-table-goto-column 1)\r
741              (string= "" (org-trim (org-table-get-field 1)))\r
742              )\r
743       (org-table-kill-row)\r
744       )\r
745 \r
746     (when get-parts\r
747 \r
748       ;; Find out number of columns\r
749       (org-table-goto-column 100)\r
750       (setq columns (- (org-table-current-column) 1))\r
751 \r
752       ;; Check for right number of columns\r
753       (unless (>= columns 2)\r
754         (org-refer-by-number-report-setup-error \r
755          "Table within reference node has less than two columns" t)\r
756         )\r
757 \r
758       ;; Retrieve any decorations around the number within first field of\r
759       ;; the last row\r
760       (setq field (org-trim (org-table-get-field 1)))\r
761       (or (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" field)\r
762           (org-refer-by-number-report-setup-error \r
763            (format "Last field of reference table '%s' does not contain a number" field) t)\r
764           )\r
765 \r
766       ;; These are the decorations used within the last row of the\r
767       ;; reference table\r
768       (setq parts (list (match-string 1 field) \r
769                         (string-to-number (match-string 2 field)) \r
770                         (match-string 3 field) \r
771                         columns)))\r
772 \r
773     (unless goto-end (goto-char (marker-position initial)))\r
774     (set-marker initial nil)\r
775     \r
776     parts))\r
777 \r
778 \r
779 (defun org-refer-by-number-report-setup-error (text &optional switch-to-node)\r
780   "Report error, which might be related with incomplete setup; offer help"\r
781 \r
782   (when switch-to-node \r
783     (org-id-goto org-refer-by-number-id)\r
784     (delete-other-windows)\r
785     )\r
786   \r
787   (if (y-or-n-p (concat text \r
788                         "; "\r
789                         "the correct setup is explained in the documentation of 'org-refer-by-number-id'. " \r
790                         "Do you want to read it ? "))\r
791       (describe-variable 'org-refer-by-number-id)\r
792     )\r
793   (error "")\r
794   (setq org-refer-by-number-windowconfig nil)\r
795   (setq org-refer-by-number-last-action 'leave))\r
796 \r
797 \r
798 (provide 'org-refer-by-number)\r
799 \r
800 ;; Local Variables:\r
801 ;; fill-column: 75\r
802 ;; comment-column: 50\r
803 ;; End:\r
804 \r
805 ;;; org-refer-by-number.el ends here\r
806 \r