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