diff --git a/contrib/lisp/org-favtable.el b/contrib/lisp/org-favtable.el new file mode 100755 index 000000000..910909e3a --- /dev/null +++ b/contrib/lisp/org-favtable.el @@ -0,0 +1,1703 @@ +;;; org-favtable.el --- Lookup table of favorite references and links + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Marc-Oliver Ihm +;; Keywords: hypermedia, matching +;; Requires: org +;; Download: http://orgmode.org/worg/code/elisp/org-favtable.el +;; Version: 2.2.0 + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Purpose: +;; +;; Mark and find your favorite things and locations in org easily: Create +;; and update a lookup table of your references and links. Often used +;; entries bubble to the top and entering some keywords displays only the +;; matching entries. That way the right entry one can be picked easily. +;; +;; References are essentially small numbers (e.g. "R237" or "-455-"), +;; which are created by this package; they are well suited to be used +;; outside of org. Links are just normal org-mode links. +;; +;; +;; Setup: +;; +;; - Add these lines to your .emacs: +;; +;; (require 'org-favtable) +;; ;; Good enough to start, but later you should probably +;; ;; change this id, as will be explained below +;; (setq org-favtable-id "00e26bef-1929-4110-b8b4-7eb9c9ab1fd4") +;; ;; Optionally assign a key. Pick your own favorite. +;; (global-set-key (kbd "C-+") 'org-favtable) +;; +;; - Just invoke `org-favtable', which will explain how to complete your +;; setup by creating the necessary table of favorites. +;; +;; +;; Further reading: +;; +;; Invoke `org-favtable' and pick one of its help options. You may also +;; read the documentation of `org-favtable-id' for setup instructions, of +;; `org-favtable' for regular usage and of `org-favtable--commands' for a +;; list of available commands. +;; + +;;; Change Log: + +;; [2013-02-28 Th] Version 2.2.0: +;; - Allowed shortcuts like "h237" for command "head" with argument "237" +;; - Integrated with org-mark-ring-goto +;; +;; [2013-01-25 Fr] Version 2.1.0: +;; - Added full support for links +;; - New commands "missing" and "statistics" +;; - Renamed the package from "org-reftable" to "org-favtable" +;; - Additional columns are required (e.g. "link"). Error messages will +;; guide you +;; +;; [2012-12-07 Fr] Version 2.0.0: +;; - The format of the table of favorites has changed ! You need to bring +;; your existing table into the new format by hand (which however is +;; easy and explained below) +;; - Reference table can be sorted after usage count or date of last access +;; - Ask user explicitly, which command to invoke +;; - Renamed the package from "org-refer-by-number" to "org-reftable" + +;; [2012-09-22 Sa] Version 1.5.0: +;; - New command "sort" to sort a buffer or region by reference number +;; - New commands "highlight" and "unhighlight" to mark references + +;; [2012-07-13 Fr] Version 1.4.0: +;; - New command "head" to find a headline with a reference number + +;; [2012-04-28 Sa] Version 1.3.0: +;; - New commands occur and multi-occur +;; - All commands can now be invoked explicitly +;; - New documentation +;; - Many bugfixes + +;; [2011-12-10 Sa] Version 1.2.0: +;; - Fixed a bug, which lead to a loss of newly created reference numbers +;; - Introduced single and double prefix arguments +;; - Started this Change Log + +;;; Code: + +(require 'org-table) +(require 'cl) + +(defvar org-favtable--version "2.2.0") +(defvar org-favtable--preferred-command nil) + +(defvar org-favtable--commands '(occur head ref link enter leave goto + help reorder fill sort update highlight unhighlight missing statistics) + "List of commands known to org-favtable: + +Commands known: + + occur: If you supply a keyword (text): Apply emacs standard + occur operation on the table of favorites; ask for a + string (keyword) to select lines. Occur will only show you + lines which contain the given keyword, so you can easily find + the right one. You may supply a list of words seperated by + comma (\",\"), to select lines that contain any or all of the + given words. + + If you supply a reference number: Apply emacs standard + multi-occur operation all org-mode buffers to search for a + specific reference. + + You may also read the note at the end of this help on saving + the keystroke RET to accept this frequent default command. + + head: If invoked outside the table of favorites, ask for a + reference number and search for a heading containing it. If + invoked within favtable dont ask; rather use the reference or + link from the current line. + + ref: Create a new reference, copy any previously selected text. + If already within reftable, fill in ref-column. + + link: Create a new line in reftable with a link to the current node. + Do not populate the ref column; this can later be populated by + calling the \"fill\" command from within the reftable. + + leave: Leave the table of favorites. If the last command has + been \"ref\", the new reference is copied and ready to yank. + This \"org-mark-ring-goto\" and can be called several times + in succession. + + enter: Just enter the node with the table of favorites. + + goto: Search for a specific reference within the table of + favorites. + + help: Show this list of commands. + + +: Show all commands including the less frequently used ones + given below. If \"+\" is followd by enough letters of such a + command (e.g. \"+fi\"), then this command is invoked + directly. + + reorder: Temporarily reorder the table of favorites, e.g. by + count, reference or last access. + + fill: If either ref or link is missing, fill it. + + sort: Sort a set of lines (either the active region or the + whole buffer) by the references found in each line. + + update: For the given reference, update the line in the + favtable. + + highlight: Highlight references in region or buffer. + + unhighlight: Remove highlights. + + missing : Search for missing reference numbers (which do not + appear in the reference table). If requested, add additional + lines for them, so that the command \"new\" is able to reuse + them. + + statistics : Show some statistics (e.g. minimum and maximum + reference) about favtable. + + + +Two ways to save keystrokes: + +When prompting for a command, org-favtable puts the most likely +one (e.g. \"occur\" or \"ref\") at the front of the list, so that +you may just type RET. + +If this command needs additional input (like e.g. \"occur\"), you +may supply this input right away, although you are still beeing +prompted for the command. So do an occur for the string \"foo\", +you can just enter \"foo\" without even entering \"occur\". + + +Another way to save keystrokes applies if you want to choose a +command, that requrires a reference number (and would normally +prompt for it): In that case you may just enter enough characters +from your command, so that it appears first in the list of +matches; then immediately enter the number of the reference you +are searching for. So the input \"h237\" would execute the +command \"head\" for reference \"237\" right away. + +") + +(defvar org-favtable--commands-some '(occur head ref link leave enter goto + help)) + +(defvar org-favtable--columns nil) + +(defvar org-favtable-id nil + "Id of the Org-mode node, which contains the favorite table. + +Read below, on how to set up things. See the help options +\"usage\" and \"commands\" for normal usage after setup. + +Setup requires two steps: + + - Adjust your .emacs initialization file + + - Create a suitable org-mode node + + +Here are the lines, you need to add to your .emacs: + + (require 'org-favtable) + ;; Good enough to start, but later you should probably + ;; change this id, as will be explained below + (setq org-favtable-id \"00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\") + ;; Optionally assign a key. Pick your own favorite. + (global-set-key (kbd \"C-+\") 'org-favtable) + +Do not forget to restart emacs to make these lines effective. + + +As a second step you need to create the org-mode node, where your +reference numbers and links will be stored. It may look like +this: + + * org-favtable + :PROPERTIES: + :ID: 00e26bef-1929-4110-b8b4-7eb9c9ab1fd4 + :END: + + + | | | Comment, description, details | | | | + | ref | link | ;c | count;s | created | last-accessed | + | | <4> | <30> | | | | + |-----+------+--------------------------------+---------+---------+---------------| + | R1 | | My first reference | | | | + + +You may just copy this node into one of your org-files. Many +things however can or should be adjusted: + + - The node needs not be a top level node. + + - Its name is completely at you choice. The node is found + through its ID. + + - There are three lines of headings above the first hline. The + first one is ignored by org-favtable, and you can use them to + give meaningful names to columns; the second line contains + configuration information for org-favtable; please read + further below for its format. The third line is optional and + may contain width-informations (e.g. <30>) only. + + - The sequence of columns does not matter. You may reorder them + any way you like; e.g. make the comment-column the last + columns within the table. Columns ar found by their name, + which appears in the second heading-line. + + - You can add further columns or even remove the + \"Comment\"-column. All other columns from the + example (e.g. \"ref\", \"link\", \"count\", \"created\" and + \"last-accessed\") are required. + + - Your references need not start at \"R1\"; However, having an + initial row is required (it serves as a template for subsequent + references). + + - Your reference need not have the form \"R1\"; you may just as + well choose any text, that contains a single number, + e.g. \"reference-{1}\" or \"#7\" or \"++17++\" or \"-344-\". The + function `org-favtable' will inspect your first reference and + create all subsequent references in the same way. + + - You may want to change the ID-Property of the node above and + create a new one, which is unique (and not just a copy of + mine). You need to change it in the lines copied to your .emacs + too. However, this is not strictly required to make things + work, so you may do this later, after trying out this package. + + +Optionally you may tweak the second header line to adjust +`org-favtable' a bit. In the example above it looks like this + (with spaces collapsed): + + + | ref | link | ;c | count;s | created | last-accessed | + + +The different fields have different meanings: + + - ref : This denotes the column which contains you references + + - link : Column for org-mode links, which can be used to access + locations within your files. + + - ;c : The flag \"c\" (\"c\" for \"copy\") denotes this column + as the one beeing copied on command \"leave\". In the example + above, it is also the comment-column. + + - count;s : this is the column which counts, how many time this + line has been accessed (which is the key-feature of this + package). The flag \"s\" stands for \"sort\", so the table is + sorted after this column. You may also sort after columns + \"ref\" or \"last-accessed\". + + - created : Date when this line was created. + + - last-accessed : Date and time, when this line was last accessed. + + +After this two-step setup process you may invoke `org-favtable' +to create a new favorite. Read the help option \"usage\" for +instructions on normal usage, read the help option \"commands\" +for help on single commands. + +") + + +(defvar org-favtable--text-to-yank nil) +(defvar org-favtable--last-action nil) +(defvar org-favtable--occur-buffer nil) +(defvar org-favtable--ref-regex nil) +(defvar org-favtable--ref-format nil) + + + +(defun org-favtable (&optional what search search-is-link) + "Mark and find your favorite items and org-locations easily: +Create and update a lookup table of your favorite references and +links. Often used entries automatically bubble to the top of the +table; entering some keywords narrows it to just the matching +entries; that way the right one can be picked easily. + +References are essentially small numbers (e.g. \"R237\" or +\"-455-\"), as created by this package; links are normal org-mode +links. Within org-favtable, both are denoted as favorites. + + +Read below for a detailed description of this function. See the +help option \"setup\" or read the documentation of +`org-favtable-id' for setup instructions. + +The function `org-favtable' operates on a dedicated table (called +the table or favorites or favtable, for short) within a special +Org-mode node. The node has to be created as part of your initial +setup. Each line of the favorite table contains: + + - A reference (optional) + + - A link (optional) + + - A number; counting, how often each reference has been + used. This number is updated automatically and the table can + be sorted according to it, so that most frequently used + references appear at the top of the table and can be spotted + easily. + + - Its respective creation date + + - Date and time of last access. This column can alternatively be + used to sort the table. + +To be useful, your table of favorites should probably contain a +column with comments too, which allows lines to be selected by +keywords. + +The table of favorites is found through the id of the containing +node; this id should be stored within `org-favtable-id' (see there +for details). + + +The function `org-favtable' is the only interactive function of +this package and its sole entry point; it offers several commands +to create, find and look up these favorites (references and +links). All of them are explained within org-favtable's help. + + +Finally, org-favtable can also be invoked from elisp; the two +optional arguments accepted are: + + search : string to search for + what : symbol of the command to invoke + search-is-link : t, if argument search is actually a link + +An example would be: + + (org-favtable \"237\" 'head) ;; find heading with ref 237 + +" + + (interactive "P") + + (let (within-node ; True, if we are within node with favtable + result-is-visible ; True, if node or occur is visible in any window + ref-node-buffer-and-point ; cons with buffer and point of favorites node + below-cursor ; word below cursor + active-region ; active region (if any) + link-id ; link of starting node, if required + guarded-search ; with guard against additional digits + search-is-ref ; true, if search is a reference + commands ; currently active set of selectable commands + what-adjusted ; True, if we had to adjust what + what-input ; Input on what question (need not necessary be "what") + reorder-once ; Column to use for single time sorting + parts ; Parts of a typical reference number (which + ; need not be a plain number); these are: + head ; Any header before number (e.g. "R") + maxref ; Maximum number from reference table (e.g. "153") + tail ; Tail after number (e.g. "}" or "") + ref-regex ; Regular expression to match a reference + has-reuse ; True, if table contains a line for reuse + numcols ; Number of columns in favtable + kill-new-text ; Text that will be appended to kill ring + message-text ; Text that will be issued as an explanation, + ; what we have done + initial-ref-or-link ; Initial position in reftable + ) + + ;; + ;; Examine current buffer and location, before turning to favtable + ;; + + ;; Get the content of the active region or the word under cursor + (if (and transient-mark-mode + mark-active) + (setq active-region (buffer-substring (region-beginning) (region-end)))) + (setq below-cursor (thing-at-point 'symbol)) + + + ;; Find out, if we are within favable or not + (setq within-node (string= (org-id-get) org-favtable-id)) + + ;; Find out, if point in any window is within node with favtable + (mapc (lambda (x) (with-current-buffer (window-buffer x) + (when (or + (string= (org-id-get) org-favtable-id) + (eq (window-buffer x) + org-favtable--occur-buffer)) + (setq result-is-visible t)))) + (window-list)) + + + + ;; + ;; Get decoration of references and highest reference from favtable + ;; + + + ;; Save initial ref or link + (if (and within-node + (org-at-table-p)) + (setq initial-ref-or-link + (or (org-favtable--get-field 'ref) + (org-favtable--get-field 'link)))) + + ;; Find node + (setq ref-node-buffer-and-point (org-favtable--id-find)) + (unless ref-node-buffer-and-point + (org-favtable--report-setup-error + (format "Cannot find node with id \"%s\"" org-favtable-id))) + + ;; Get configuration of reftable; catch errors + (let ((error-message + (catch 'content-error + + (with-current-buffer (car ref-node-buffer-and-point) + (save-excursion + (unless (string= (org-id-get) org-favtable-id) + (goto-char (cdr ref-node-buffer-and-point))) + + ;; parse table while still within buffer + (setq parts (org-favtable--parse-and-adjust-table))) + + nil)))) + (when error-message + (org-pop-to-buffer-same-window (car ref-node-buffer-and-point)) + (org-reveal) + (error error-message))) + + ;; Give names to parts of configuration + (setq head (nth 0 parts)) + (setq maxref (nth 1 parts)) + (setq tail (nth 2 parts)) + (setq numcols (nth 3 parts)) + (setq ref-regex (nth 4 parts)) + (setq has-reuse (nth 5 parts)) + (setq org-favtable--ref-regex ref-regex) + (setq org-favtable--ref-format (concat head "%d" tail)) + + ;; + ;; Find out, what we are supposed to do + ;; + + (if (equal what '(4)) (setq what 'leave)) + + ;; Set preferred action, that will be the default choice + (setq org-favtable--preferred-command + (if within-node + (if (memq org-favtable--last-action '(ref link)) + 'leave + 'occur) + (if active-region + 'ref + (if (and below-cursor (string-match ref-regex below-cursor)) + 'occur + nil)))) + + ;; Ask user, what to do + (unless what + (setq commands (copy-list org-favtable--commands-some)) + (while (progn + (setq what-input + (org-icompleting-read + "Please choose: " + (mapcar 'symbol-name + ;; Construct unique list of commands with + ;; preferred one at front + (delq nil (delete-dups + (append + (list org-favtable--preferred-command) + commands)))) + nil nil)) + + + ;; if input starts with "+", any command (not only some) may follow + ;; this allows input like "+sort" to be accepted + (when (string= (substring what-input 0 1) "+") + ;; make all commands available for selection + (setq commands (copy-list org-favtable--commands)) + (unless (string= what-input "+") + ;; not just "+", use following string + (setq what-input (substring what-input 1)) + + (let ((completions + ;; get list of possible completions for what-input + (all-completions what-input (mapcar 'symbol-name commands)))) + ;; use it, if unambigously + (if (= (length completions) 1) + (setq what-input (car completions)))))) + + + ;; if input ends in digits, save them away and do completions on head of input + ;; this allows input like "h224" to be accepted + (when (string-match "^\\([^0-9+]\\)\\([0-9]+\\)\\s *$" what-input) + ;; use first match as input, even if ambigously + (setq org-favtable--preferred-command + (intern (first (all-completions (match-string 1 what-input) + (mapcar 'symbol-name commands))))) + ;; use digits as argument to commands + (setq what-input (format org-favtable--ref-format + (string-to-number (match-string 2 what-input))))) + + (setq what (intern what-input)) + + ;; user is not required to input one of the commands; if + ;; not, take the first one and use the original input for + ;; next question + (if (memq what commands) + ;; input matched one element of list, dont need original + ;; input any more + (setq what-input nil) + ;; what-input will be used for next question, use first + ;; command for what + (setq what (or org-favtable--preferred-command + (first commands))) + ;; remove any trailing dot, that user might have added to + ;; disambiguate his input + (if (equal (substring what-input -1) ".") + ;; but do this only, if dot was really necessary to + ;; disambiguate + (let ((shortened-what-input (substring what-input 0 -1))) + (unless (test-completion shortened-what-input + (mapcar 'symbol-name + commands)) + (setq what-input shortened-what-input))))) + + ;; ask for reorder in loop, because we have to ask for + ;; what right again + (if (eq what 'reorder) + (setq reorder-once + (intern + (org-icompleting-read + "Please choose column to reorder reftable once: " + (mapcar 'symbol-name '(ref count last-accessed)) + nil t)))) + + ;; maybe ask initial question again + (memq what '(reorder +))))) + + + ;; + ;; Get search, if required + ;; + + ;; These actions need a search string: + (when (memq what '(goto occur head update)) + + ;; Maybe we've got a search string from the arguments + (unless search + (let (search-from-table + search-from-cursor) + + ;; Search string can come from several sources: + ;; From ref column of table + (when within-node + (setq search-from-table (org-favtable--get-field 'ref))) + ;; From string below cursor + (when (and (not within-node) + below-cursor + (string-match (concat "\\(" ref-regex "\\)") + below-cursor)) + (setq search-from-cursor (match-string 1 below-cursor))) + + ;; Depending on requested action, get search from one of the sources above + (cond ((eq what 'goto) + (setq search (or what-input search-from-cursor))) + ((memq what '(head occur)) + (setq search (or what-input search-from-table search-from-cursor)))))) + + + ;; If we still do not have a search string, ask user explicitly + (unless search + + (if what-input + (setq search what-input) + (setq search (read-from-minibuffer + (cond ((memq what '(occur head)) + "Text or reference number to search for: ") + ((eq what 'goto) + "Reference number to search for, or enter \".\" for id of current node: ") + ((eq what 'update) + "Reference number to update: "))))) + + (if (string-match "^\\s *[0-9]+\\s *$" search) + (setq search (format "%s%s%s" head (org-trim search) tail)))) + + ;; Clean up and examine search string + (if search (setq search (org-trim search))) + (if (string= search "") (setq search nil)) + (setq search-is-ref (string-match ref-regex search)) + + ;; Check for special case + (when (and (memq what '(head goto)) + (string= search ".")) + (setq search (org-id-get)) + (setq search-is-link t)) + + (when search-is-ref + (setq guarded-search (org-favtable--make-guarded-search search))) + + ;; + ;; Do some sanity checking before really starting + ;; + + ;; Correct requested action, if nothing to search + (when (and (not search) + (memq what '(search occur head))) + (setq what 'enter) + (setq what-adjusted t)) + + ;; For a proper reference as input, we do multi-occur + (if (and (string-match ref-regex search) + (eq what 'occur)) + (setq what 'multi-occur)) + + ;; Check for invalid combinations of arguments; try to be helpful + (when (and (memq what '(head goto)) + (not search-is-link) + (not search-is-ref)) + (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search))) + + + ;; + ;; Prepare + ;; + + ;; Get link if required before moving in + (if (eq what 'link) + (setq link-id (org-id-get-create))) + + ;; Move into table, if outside + (when (memq what '(enter ref link goto occur multi-occur missing statistics)) + + ;; Support orgmode-standard of going back (buffer and position) + (org-mark-ring-push) + + ;; Switch to favtable + (org-pop-to-buffer-same-window (car ref-node-buffer-and-point)) + (goto-char (cdr ref-node-buffer-and-point)) + (show-subtree) + (org-show-context) + + ;; sort favtable + (org-favtable--sort-table reorder-once)) + + ;; Goto back to initial ref, because reformatting of table above might + ;; have moved point + (when initial-ref-or-link + (while (and (org-at-table-p) + (not (or + (string= initial-ref-or-link (org-favtable--get-field 'ref)) + (string= initial-ref-or-link (org-favtable--get-field 'link))))) + (forward-line)) + ;; did not find ref, go back to top + (if (not (org-at-table-p)) (goto-char top))) + + + ;; + ;; Actually do, what is requested + ;; + + (cond + + + ((eq what 'help) + + (let ((help-what + ;; which sort of help ? + (intern + (concat + "help-" + (org-icompleting-read + "Help on: " + (mapcar 'symbol-name '(commands usage setup version example)) + nil t))))) + + ;; help is taken from docstring of functions or variables + (cond ((eq help-what 'help-commands) + (org-favtable--show-help 'org-favtable--commands)) + ((eq help-what 'help-usage) + (org-favtable--show-help 'org-favtable)) + ((eq help-what 'help-setup) + (org-favtable--show-help 'org-favtable-id)) + ((eq help-what 'help-version) + (org-favtable-version))))) + + + ((eq what 'multi-occur) + + ;; Conveniently position cursor on number to search for + (org-favtable--goto-top) + (let (found (initial (point))) + (while (and (not found) + (forward-line) + (org-at-table-p)) + (save-excursion + (setq found (string= search + (org-favtable--get-field 'ref))))) + (if found + (org-favtable--update-line nil) + (goto-char initial))) + + ;; Construct list of all org-buffers + (let (buff org-buffers) + (dolist (buff (buffer-list)) + (set-buffer buff) + (if (string= major-mode "org-mode") + (setq org-buffers (cons buff org-buffers)))) + + ;; Do multi-occur + (multi-occur org-buffers guarded-search) + (if (get-buffer "*Occur*") + (progn + (setq message-text (format "multi-occur for '%s'" search)) + (setq org-favtable--occur-buffer (get-buffer "*Occur*")) + (other-window 1) + (toggle-truncate-lines 1)) + (setq message-text (format "Did not find '%s'" search))))) + + + ((eq what 'head) + + (let (link) + ;; link either from table or passed in as argument + + ;; try to get link + (if search-is-link + (setq link (org-trim search)) + (if (and within-node + (org-at-table-p)) + (setq link (org-favtable--get-field 'link)))) + + ;; use link if available + (if (and link + (not (string= link ""))) + (progn + (org-id-goto link) + (org-favtable--update-line search) + (setq message-text "Followed link")) + + (message (format "Scanning headlines for '%s' ..." search)) + (let (buffer point) + (if (catch 'found + (progn + ;; loop over all headlines, stop on first match + (org-map-entries + (lambda () + (when (looking-at (concat ".*" guarded-search)) + ;; remember location and bail out + (setq buffer (current-buffer)) + (setq point (point)) + (throw 'found t))) + nil 'agenda) + nil)) + + (progn + (org-favtable--update-line search) + (setq message-text (format "Found '%s'" search)) + (org-pop-to-buffer-same-window buffer) + (goto-char point) + (org-reveal)) + (setq message-text (format "Did not find '%s'" search))))))) + + + ((eq what 'leave) + + (when result-is-visible + + ;; If we are within the occur-buffer, switch over to get current line + (if (and (string= (buffer-name) "*Occur*") + (eq org-favtable--last-action 'occur)) + (occur-mode-goto-occurrence))) + + (setq kill-new-text org-favtable--text-to-yank) + (setq org-favtable--text-to-yank nil) + + ;; If "leave" has been called two times in succession, make + ;; org-mark-ring-goto believe it has been called two times too + (if (eq org-favtable--last-action 'leave) + (let ((this-command nil) (last-command nil)) + (org-mark-ring-goto 1)) + (org-mark-ring-goto 0))) + + + ((eq what 'goto) + + ;; Go downward in table to requested reference + (let (found (initial (point))) + (org-favtable--goto-top) + (while (and (not found) + (forward-line) + (org-at-table-p)) + (save-excursion + (setq found + (string= search + (org-favtable--get-field + (if search-is-link 'link 'ref)))))) + (if found + (progn + (setq message-text (format "Found '%s'" search)) + (org-favtable--update-line nil) + (org-table-goto-column (org-favtable--column-num 'ref)) + (if (looking-back " ") (backward-char)) + ;; remember string to copy + (setq org-favtable--text-to-yank + (org-trim (org-table-get-field (org-favtable--column-num 'copy))))) + (setq message-text (format "Did not find '%s'" search)) + (goto-char initial) + (forward-line) + (setq what 'missed)))) + + + ((eq what 'occur) + + ;; search for string: occur + (let (search-regexp + all-or-any + (search-words (split-string search "," t))) + + (if (< (length search-words) 2) + ;; only one word to search; use it as is + (setq search-regexp search) + ;; construct regexp to match any of the words (maybe throw out some matches later) + (setq search-regexp + (mapconcat (lambda (x) (concat "\\(" x "\\)")) search-words "\\|")) + (setq all-or-any + (intern + (org-icompleting-read + "Two or more words have been specified; show lines, that match: " '("all" "any"))))) + + (save-restriction + (org-narrow-to-subtree) + (occur search-regexp) + (widen) + (if (get-buffer "*Occur*") + (with-current-buffer "*Occur*" + + ;; install helpful keyboard-shortcuts within occur-buffer + (let ((keymap (make-sparse-keymap))) + (set-keymap-parent keymap occur-mode-map) + + (define-key keymap (kbd "RET") + (lambda () (interactive) + (org-favtable--occur-helper 'head))) + + (define-key keymap (kbd "") + (lambda () (interactive) + (org-favtable--occur-helper 'multi-occur))) + + (define-key keymap (kbd "") + (lambda () (interactive) + (org-favtable--occur-helper 'goto))) + + (define-key keymap (kbd "") + (lambda () (interactive) + (org-favtable--occur-helper 'update))) + + (use-local-map keymap)) + + ;; Brush up occur buffer + (other-window 1) + (toggle-truncate-lines 1) + (let ((inhibit-read-only t)) + ;; insert some help text + (insert (substitute-command-keys + "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")) + (forward-line 1) + + ;; when matching all of multiple words, remove all lines that do not match one of the words + (when (eq all-or-any 'all) + (mapc (lambda (x) (keep-lines x)) search-words)) + + ;; replace description from occur + (when all-or-any + (forward-line -1) + (kill-line) + (let ((count (- (count-lines (point) (point-max)) 1))) + (insert (format "%d %s for %s of %s" + count + (if (= count 1) "match" "matches") + all-or-any + search))) + (forward-line) + (beginning-of-line)) + + ;; Record link or reference for each line in + ;; occur-buffer, that is linked into reftable. Because if + ;; we later realign the reftable and then reuse the occur + ;; buffer, the original links might point nowehere. + (save-excursion + (while (not (eq (point) (point-max))) + (let ((beg (line-beginning-position)) + (end (line-end-position)) + pos ref link) + + ;; occur has saved the position into a special property + (setq pos (get-text-property (point) 'occur-target)) + (when pos + ;; but this property might soon point nowhere; so retrieve ref-or-link instead + (with-current-buffer (marker-buffer pos) + (goto-char pos) + (setq ref (org-favtable--get-field 'ref)) + (setq link (org-favtable--get-field 'link)))) + ;; save as text property + (put-text-property beg end 'org-favtable--ref ref) + (put-text-property beg end 'org-favtable--link link)) + (forward-line)))) + + (setq message-text + (format "Occur for '%s'" search))) + (setq message-text + (format "Did not find any matches for '%s'" search)))))) + + + ((memq what '(ref link)) + + ;; add a new row (or reuse existing one) + (let (new) + + (when (eq what 'ref) + ;; go through table to find first entry to be reused + (when has-reuse + (org-favtable--goto-top) + ;; go through table + (while (and (org-at-table-p) + (not new)) + (when (string= + (org-favtable--get-field 'count) + ":reuse:") + (setq new (org-favtable--get-field 'ref)) + (if new (org-table-kill-row))) + (forward-line))) + + ;; no ref to reuse; construct new reference + (unless new + (setq new (format "%s%d%s" head (1+ maxref) tail))) + + ;; remember for org-mark-ring-goto + (setq org-favtable--text-to-yank new)) + + ;; insert ref or link as very first row + (org-favtable--goto-top) + (org-table-insert-row) + + ;; fill special columns with standard values + (when (eq what 'ref) + (org-table-goto-column (org-favtable--column-num 'ref)) + (insert new)) + (when (eq what 'link) + (org-table-goto-column (org-favtable--column-num 'link)) + (insert link-id)) + (org-table-goto-column (org-favtable--column-num 'created)) + (org-insert-time-stamp nil nil t) + + ;; goto first empty field + (unless (catch 'empty + (dotimes (col numcols) + (org-table-goto-column (+ col 1)) + (if (string= (org-trim (org-table-get-field)) "") + (throw 'empty t)))) + ;; none found, goto first + (org-table-goto-column 1)) + + (org-table-align) + (if active-region (setq kill-new-text active-region)) + (if (eq what 'ref) + (setq message-text (format "Adding a new row with ref '%s'" new)) + (setq message-text (format "Adding a new row linked to '%s'" link-id))))) + + + ((eq what 'enter) + + ;; simply go into table + (org-favtable--goto-top) + (show-subtree) + (recenter) + (if what-adjusted + (setq message-text "Nothing to search for; at favtable") + (setq message-text "At favtable"))) + + + ((eq what 'fill) + + ;; check, if within reftable + (unless (and within-node + (org-at-table-p)) + (error "Not within table of favorites")) + + ;; applies to missing refs and missing links alike + (let ((ref (org-favtable--get-field 'ref)) + (link (org-favtable--get-field 'link))) + + (if (and (not ref) + (not link)) + ;; have already checked this during parse, check here anyway + (error "Columns ref and link are both empty in this line")) + + ;; fill in new ref + (if (not ref) + (progn + (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail)) + (org-favtable--get-field 'ref kill-new-text) + ;; remember for org-mark-ring-goto + (setq org-favtable--text-to-yank kill-new-text) + (org-id-goto link) + (setq message-text "Filled reftable field with new reference")) + + ;; fill in new link + (if (not link) + (progn + (setq guarded-search (org-favtable--make-guarded-search ref)) + (message (format "Scanning headlines for '%s' ..." ref)) + (let (link) + (if (catch 'found + (org-map-entries + (lambda () + (when (looking-at (concat ".*" guarded-search)) + (setq link (org-id-get-create)) + (throw 'found t))) + nil 'agenda) + nil) + + (progn + (org-favtable--get-field 'link link) + (setq message-text "Inserted link")) + + (setq message-text (format "Did not find reference '%s'" ref))))) + + ;; nothing is missing + (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do"))))) + + + ((eq what 'sort) + + ;; sort lines according to contained reference + (let (begin end where) + (catch 'aborted + ;; either active region or whole buffer + (if (and transient-mark-mode + mark-active) + ;; sort only region + (progn + (setq begin (region-beginning)) + (setq end (region-end)) + (setq where "region")) + ;; sort whole buffer + (setq begin (point-min)) + (setq end (point-max)) + (setq where "whole buffer") + ;; make sure + (unless (y-or-n-p "Sort whole buffer ") + (setq message-text "Sort aborted") + (throw 'aborted nil))) + + (save-excursion + (save-restriction + (goto-char (point-min)) + (narrow-to-region begin end) + (sort-subr nil 'forward-line 'end-of-line + (lambda () + (if (looking-at (concat ".*" + (org-favtable--make-guarded-search ref-regex 'dont-quote))) + (string-to-number (match-string 1)) + 0)))) + (highlight-regexp ref-regex) + (setq message-text (format "Sorted %s from character %d to %d, %d lines" + where begin end + (count-lines begin end))))))) + + + ((eq what 'update) + + ;; simply update line in reftable + (save-excursion + (let ((ref-or-link (if search-is-link "link" "reference"))) + (beginning-of-line) + (if (org-favtable--update-line search) + (setq message-text (format "Updated %s '%s'" ref-or-link search)) + (setq message-text (format "Did not find %s '%s'" ref-or-link search)))))) + + + ((eq what 'parse) + + ;; Just parse the reftable, which is already done, so nothing to do + ) + + + ((memq what '(highlight unhighlight)) + + (let ((where "buffer")) + (save-excursion + (save-restriction + (when (and transient-mark-mode + mark-active) + (narrow-to-region (region-beginning) (region-end)) + (setq where "region")) + + (if (eq what 'highlight) + (progn + (highlight-regexp ref-regex) + (setq message-text (format "Highlighted references in %s" where))) + (unhighlight-regexp ref-regex) + (setq message-text (format "Removed highlights for references in %s" where))))))) + + + ((memq what '(missing statistics)) + + (org-favtable--goto-top) + (let (missing + ref-field + ref + min + max + (total 0)) + + ;; start with list of all references + (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail)) + (number-sequence 1 maxref))) + + ;; go through table and remove all refs, that we see + (while (and (forward-line) + (org-at-table-p)) + + ;; get ref-field and number + (setq ref-field (org-favtable--get-field 'ref)) + (if (and ref-field + (string-match ref-regex ref-field)) + (setq ref (string-to-number (match-string 1 ref-field)))) + + ;; remove existing refs from list + (if ref-field (setq missing (delete ref-field missing))) + + ;; record min and max + (if (or (not min) (< ref min)) (setq min ref)) + (if (or (not max) (> ref max)) (setq max ref)) + + ;; count + (setq total (1+ total))) + + ;; insert them, if requested + (forward-line -1) + (if (eq what 'statistics) + + (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. " + total + (format org-favtable--format min) + (format org-favtable--format max) + (length missing))) + + (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the table of favorites" + (length missing))) + (let (type) + (setq type (org-icompleting-read + "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing"))) + (mapc (lambda (x) + (let (org-table-may-need-update) (org-table-insert-row t)) + (org-favtable--get-field 'ref x) + (org-favtable--get-field 'count (format ":%s:" type))) + missing) + (org-table-align) + (setq message-text (format "Inserted %d new lines for missing refernces" (length missing)))) + (setq message-text (format "%d missing references." (length missing))))))) + + + (t (error "This is a bug: unmatched case '%s'" what))) + + + ;; remember what we have done for next time + (setq org-favtable--last-action what) + + ;; tell, what we have done and what can be yanked + (if kill-new-text (setq kill-new-text + (substring-no-properties kill-new-text))) + (if (string= kill-new-text "") (setq kill-new-text nil)) + (let ((m (concat + message-text + (if (and message-text kill-new-text) + " and r" + (if kill-new-text "R" "")) + (if kill-new-text (format "eady to yank '%s'" kill-new-text) "")))) + (unless (string= m "") (message m))) + (if kill-new-text (kill-new kill-new-text)))) + + + +(defun org-favtable--parse-and-adjust-table () + + (let ((maxref 0) + top + bottom + ref-field + link-field + parts + numcols + head + tail + ref-regex + has-reuse + initial-point) + + (setq initial-point (point)) + (org-favtable--goto-top) + (setq top (point)) + + (goto-char top) + + ;; count columns + (org-table-goto-column 100) + (setq numcols (- (org-table-current-column) 1)) + + ;; get contents of columns + (forward-line -2) + (unless (org-at-table-p) + (org-favtable--report-setup-error + "Table of favorites starts with a hline" t)) + + ;; check for optional line consisting solely of width specifications + (beginning-of-line) + (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$") + (forward-line -1)) + (org-table-goto-column 1) + + (setq org-favtable--columns (org-favtable--parse-headings numcols)) + + ;; Go beyond end of table + (while (org-at-table-p) (forward-line 1)) + + ;; Kill all empty rows at bottom + (while (progn + (forward-line -1) + (org-table-goto-column 1) + (and + (not (org-favtable--get-field 'ref)) + (not (org-favtable--get-field 'link)))) + (org-table-kill-row)) + (forward-line) + (setq bottom (point)) + (forward-line -1) + + ;; Retrieve any decorations around the number within the first nonempty ref-field + (goto-char top) + (while (and (org-at-table-p) + (not (setq ref-field (org-favtable--get-field 'ref)))) + (forward-line)) + + ;; Some Checking + (unless ref-field + (org-favtable--report-setup-error + "No line of reference column contains a number" t)) + + (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field) + (org-favtable--report-setup-error + (format "First reference in table table of favorites ('%s') does not contain a number" ref-field) t)) + + + ;; These are the decorations used within the first ref of favtable + (setq head (match-string 1 ref-field)) + (setq tail (match-string 3 ref-field)) + (setq ref-regex (concat (regexp-quote head) + "\\([0-9]+\\)" + (regexp-quote tail))) + + ;; Go through table to find maximum number and do some checking + (let ((ref 0)) + + (while (org-at-table-p) + + (setq ref-field (org-favtable--get-field 'ref)) + (setq link-field (org-favtable--get-field 'link)) + + (if (and (not ref-field) + (not link-field)) + (throw 'content-error "Columns ref and link are both empty in this line")) + + (if ref-field + (if (string-match ref-regex ref-field) + ;; grab number + (setq ref (string-to-number (match-string 1 ref-field))) + (throw 'content-error "Column ref does not contain a number"))) + + ;; check, if higher ref + (if (> ref maxref) (setq maxref ref)) + + ;; check if ref is ment for reuse + (if (string= (org-favtable--get-field 'count) ":reuse:") + (setq has-reuse 1)) + + (forward-line 1))) + + ;; sort used to be here + + (setq parts (list head maxref tail numcols ref-regex has-reuse)) + + ;; go back to top of table + (goto-char top) + + parts)) + + + +(defun org-favtable--sort-table (sort-column) + + (unless sort-column (setq sort-column (org-favtable--column-num 'sort))) + + (let (top + bottom + ref-field + count-field + count-special) + + + ;; get boundaries of table + (org-favtable--goto-top) + (forward-line 0) + (setq top (point)) + (while (org-at-table-p) (forward-line)) + (setq bottom (point)) + + (save-restriction + (narrow-to-region top bottom) + (goto-char top) + (sort-subr t + 'forward-line + 'end-of-line + (lambda () + (let (ref + (ref-field (or (org-favtable--get-field 'ref) "")) + (count-field (or (org-favtable--get-field 'count) "")) + (count-special 0)) + + ;; get reference with leading zeroes, so it can be + ;; sorted as text + (string-match org-favtable--ref-regex ref-field) + (setq ref (format + "%06d" + (string-to-number + (or (match-string 1 ref-field) + "0")))) + + ;; find out, if special token in count-column + (setq count-special (format "%d" + (- 2 + (length (member count-field '(":missing:" ":reuse:")))))) + + ;; Construct different sort-keys according to + ;; requested sort column; prepend count-special to + ;; sort special entries at bottom of table, append ref + ;; as a secondary sort key + (cond + + ((eq sort-column 'count) + (concat count-special + (format + "%08d" + (string-to-number (or (org-favtable--get-field 'count) + ""))) + ref)) + + ((eq sort-column 'last-accessed) + (concat count-special + (org-favtable--get-field 'last-accessed) + " " + ref)) + + ((eq sort-column 'ref) + (concat count-special + ref)) + + (t (error "This is a bug: unmatched case '%s'" sort-column))))) + + nil 'string<))) + + ;; align table + (org-table-align)) + + +(defun org-favtable--goto-top () + + ;; go to heading of node + (while (not (org-at-heading-p)) (forward-line -1)) + (forward-line 1) + ;; go to table within node, but make sure we do not get into another node + (while (and (not (org-at-heading-p)) + (not (org-at-table-p)) + (not (eq (point) (point-max)))) + (forward-line 1)) + + ;; check, if there really is a table + (unless (org-at-table-p) + (org-favtable--report-setup-error + (format "Cannot find favtable within node %s" org-favtable-id) t)) + + ;; go to first hline + (while (and (not (org-at-table-hline-p)) + (org-at-table-p)) + (forward-line 1)) + + ;; and check + (unless (org-at-table-hline-p) + (org-favtable--report-setup-error + "Cannot find hline within table of favorites" t)) + + (forward-line 1) + (org-table-goto-column 1)) + + + +(defun org-favtable--id-find () + "Find org-favtable-id" + (let ((marker (org-id-find org-favtable-id 'marker)) + marker-and-buffer) + + (if marker + (progn + (setq marker-and-buffer (cons (marker-buffer marker) (marker-position marker))) + (move-marker marker nil) + marker-and-buffer) + nil))) + + + +(defun org-favtable--parse-headings (numcols) + + (let (columns) + + ;; Associate names of special columns with column-numbers + (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0) + (count . 0) (sort . nil) (copy . nil)))) + + ;; For each column + (dotimes (col numcols) + (let* (field-flags ;; raw heading, consisting of file name and maybe + ;; flags (seperated by ";") + field ;; field name only + field-symbol ;; and as a symbol + flags ;; flags from field-flags + found) + + ;; parse field-flags into field and flags + (setq field-flags (org-trim (org-table-get-field (+ col 1)))) + (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags) + (progn + (setq field (downcase (or (match-string 1 field-flags) ""))) + ;; get flags as list of characters + (setq flags (mapcar 'string-to-char + (split-string + (downcase (match-string 2 field-flags)) + "" t)))) + ;; no flags + (setq field field-flags)) + + (unless (string= field "") (setq field-symbol (intern (downcase field)))) + + ;; Check, that no flags appear twice + (mapc (lambda (x) + (when (memq (car x) flags) + (if (cdr (assoc (cdr x) columns)) + (org-favtable--report-setup-error + (format "More than one heading is marked with flag '%c'" (car x)) t)))) + '((?s . sort) + (?c . copy))) + + ;; Process flags + (if (memq ?s flags) + (setcdr (assoc 'sort columns) field-symbol)) + (if (memq ?c flags) + (setcdr (assoc 'copy columns) (+ col 1))) + + ;; Store columns in alist + (setq found (assoc field-symbol columns)) + (when found + (if (> (cdr found) 0) + (org-favtable--report-setup-error + (format "'%s' appears two times as column heading" (downcase field)) t)) + (setcdr found (+ col 1))))) + + ;; check if all necessary informations have been specified + (mapc (lambda (col) + (unless (> (cdr (assoc col columns)) 0) + (org-favtable--report-setup-error + (format "column '%s' has not been set" col) t))) + '(ref link count created last-accessed)) + + ;; use ref as a default sort-column + (unless (cdr (assoc 'sort columns)) + (setcdr (assoc 'sort columns) 'ref)) + columns)) + + + +(defun org-favtable--report-setup-error (text &optional switch-to-node) + + (when switch-to-node + (org-id-goto org-favtable-id) + (delete-other-windows)) + + (when (y-or-n-p (concat + text + ";\n" + "the correct setup is explained in the documentation of 'org-favtable-id'.\n" + "Do you want to read it ? ")) + (org-favtable--show-help 'org-favtable-id)) + + (error "") + (setq org-favtable--last-action 'leave)) + + + +(defun org-favtable--show-help (function-or-variable) + + (let ((isfun (functionp function-or-variable))) + ;; bring up help-buffer for function or variable + (if isfun + (describe-function function-or-variable) + (describe-variable function-or-variable)) + + + ;; clean up help-buffer + (pop-to-buffer "*Help*") + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (while (progn + (kill-line 1) + (not (looking-at + (if isfun + "(" + "Documentation:"))))) + (kill-line (if isfun 2 3)) + (goto-char (point-max)) + (kill-line -2) + (goto-char (point-min))))) + + + +(defun org-favtable--update-line (ref-or-link) + + (let (initial + found + count-field + (ref-node-buffer-and-point (org-favtable--id-find))) + + (with-current-buffer (car ref-node-buffer-and-point) + + ;; search reference or link, if given (or assume, that we are already positioned right) + (when ref-or-link + (setq initial (point)) + (goto-char (cdr ref-node-buffer-and-point)) + (org-favtable--goto-top) + (while (and (org-at-table-p) + (not (or (string= ref-or-link (org-favtable--get-field 'ref)) + (string= ref-or-link (org-favtable--get-field 'link))))) + (forward-line))) + + (if (not (org-at-table-p)) + (error "Did not find reference or link '%s'" ref-or-link) + (setq count-field (org-favtable--get-field 'count)) + + ;; update count field only if number or empty; leave :missing: and :reuse: as is + (if (or (not count-field) + (string-match "^[0-9]+$" count-field)) + (org-favtable--get-field 'count + (number-to-string + (+ 1 (string-to-number (or count-field "0")))))) + + ;; update timestamp + (org-table-goto-column (org-favtable--column-num 'last-accessed)) + (org-table-blank-field) + (org-insert-time-stamp nil t t) + + (setq found t)) + + (if initial (goto-char initial)) + + found))) + + + +(defun org-favtable--occur-helper (action) + (let ((line-beg (line-beginning-position)) + key search link ref) + + ;; extract reference or link from text property (as put there before) + (setq ref (get-text-property line-beg 'org-favtable--ref)) + (if (string= ref "") (setq ref nil)) + (setq link (get-text-property line-beg 'org-favtable--link)) + (if (string= link "") (setq link nil)) + + (org-favtable action + (or link ref) ;; prefer link + (if link t nil)))) + + +(defun org-favtable--get-field (key &optional value) + (let (field) + (setq field (org-trim (org-table-get-field (cdr (assoc key org-favtable--columns)) value))) + (if (string= field "") (setq field nil)) + + field)) + + +(defun org-favtable--column-num (key) + (cdr (assoc key org-favtable--columns))) + + +(defun org-favtable-version () + "Show version of org-favtable" (interactive) + (message "org-favtable %s" org-favtable--version)) + + +(defun org-favtable--make-guarded-search (ref &optional dont-quote) + (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b")) + + +(defun org-favtable-get-ref-regex-format () + "return cons-cell with regular expression and format for references" + (unless org-favtable--ref-regex + (org-favtable 'parse)) + (cons (org-favtable--make-guarded-search org-favtable--ref-regex 'dont-quote) org-favtable--ref-format)) + + +(defadvice org-mark-ring-goto (after org-favtable--advice-text-to-yank activate) + "Make text from the favtable available for yank." + (when org-favtable--text-to-yank + (kill-new org-favtable--text-to-yank) + (message (format "Ready to yank '%s'" org-favtable--text-to-yank)) + (setq org-favtable--text-to-yank nil))) + + +(provide 'org-favtable) + +;; Local Variables: +;; fill-column: 75 +;; comment-column: 50 +;; End: + +;;; org-favtable.el ends here