+++ /dev/null
-;;; org-reftable.el --- Ordered lookup table for reference numbers\r
-\r
-;; Copyright (C) 2011,2012 Free Software Foundation, Inc.\r
-\r
-;; Author: Marc-Oliver Ihm <org-reftable@ferntreffer.de>\r
-;; Keywords: hypermedia, matching\r
-;; Requires: org\r
-;; Download: http://orgmode.org/worg/code/elisp/org-reftable.el\r
-;; Version: 2.0.0\r
-\r
-;;; License:\r
-\r
-;; This program is free software; you can redistribute it and/or modify\r
-;; it under the terms of the GNU General Public License as published by\r
-;; the Free Software Foundation; either version 3, or (at your option)\r
-;; any later version.\r
-;;\r
-;; This program is distributed in the hope that it will be useful,\r
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
-;; GNU General Public License for more details.\r
-;;\r
-;; You should have received a copy of the GNU General Public License\r
-;; along with GNU Emacs; see the file COPYING. If not, write to the\r
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,\r
-;; Boston, MA 02110-1301, USA.\r
-\r
-;;; Commentary:\r
-\r
-;; Purpose:\r
-;;\r
-;; Create, search and look up numbers from a dedicated reference table.\r
-;; These numbers (e.g. "R237" or "-455-") may be used to refer to:\r
-;;\r
-;; - Nodes in Org-mode (insert them into the heading)\r
-;;\r
-;; - Things outside of org (e.g. mailfolders, directories, reports or\r
-;; pieces of paper)\r
-;;\r
-;; The table is kept sorted for most frequently or most recently used\r
-;; reference numbers. Additionally, lines can be selected by keywords, so\r
-;; that specific references can be found very easily. Earlier versions of \r
-;; this extension had been named org-refer-by-number.el.\r
-;;\r
-;;\r
-;; Setup:\r
-;;\r
-;; - Add these lines to your .emacs:\r
-;;\r
-;; (require 'org-reftable)\r
-;; ;; Later you should probably change this id, as will be explained below\r
-;; (setq org-reftable-id "00e26bef-1929-4110-b8b4-7eb9c9ab1fd4")\r
-;; ;; Optionally assign a key; pick your own favorite\r
-;; (global-set-key (kbd "C-+") 'org-reftable)\r
-;;\r
-;; - Just invoke `org-reftable', which will explain how to complete your\r
-;; setup by creating the necessary reference table.\r
-;;\r
-;;\r
-;; Further reading:\r
-;;\r
-;; - For the necessary setup read the documentation of `org-reftable-id'\r
-;; (which is, what `org-reftable' shows, as long as your setup is still\r
-;; incomplete).\r
-;;\r
-;; - For regular usage, see the function `org-reftable'.\r
-;;\r
-\r
-;;; Change Log:\r
-\r
-;; [2012-12-07 Fr] Version 2.0.0:\r
-;; - renamed the package from \"org-refer-by-number\" to \"org-reftable\"\r
-;; - The format of the reference table has changed ! You need to bring\r
-;; your existing table into the new format by hand (which however is\r
-;; easy and explained below)\r
-;; - Reference table can be sorted after usage count or date of last access\r
-;; - Ask user explicitly, which command to invoke\r
-\r
-;; [2012-09-22 Sa] Version 1.5.0:\r
-;; - New command "sort" to sort a buffer or region by reference number\r
-;; - New commands "highlight" and "unhighlight" to mark references\r
-\r
-;; [2012-07-13 Fr] Version 1.4.0:\r
-;; - New command "head" to find a headline with a reference number\r
-\r
-;; [2012-04-28 Sa] Version 1.3.0:\r
-;; - New commands occur and multi-occur\r
-;; - All commands can now be invoked explicitly\r
-;; - New documentation\r
-;; - Many bugfixes\r
-\r
-;; [2011-12-10 Sa] Version 1.2.0:\r
-;; - Fixed a bug, which lead to a loss of newly created reference numbers\r
-;; - Introduced single and double prefix arguments\r
-;; - Started this Change Log\r
-\r
-;;; Code:\r
-\r
-(require 'org-table)\r
-(require 'cl)\r
-\r
-(defvar org-reftable-preferred-command nil\r
- "Preferred command when choosing")\r
-\r
-(defvar org-reftable-commands '(occur head new enter leave goto help reorder sort update highlight unhighlight)\r
- "List of commands known to org-reftable:\r
- \r
-\r
- occur: If you supply a keyword (text): Apply emacs standard\r
- occur operation on the table of references; ask for a\r
- string (keyword) to select lines. Occur will only show you\r
- references which contain the given keyword, so you can easily\r
- find the right one\r
-\r
- If you supply a reference (number): Apply emacs standard\r
- multi-occur operation all org-mode buffers to search for a\r
- specific reference\r
-\r
- head: Scan all headings until the first one with the given\r
- reference number is found\r
-\r
- new: Create a new reference. Copy any previously selected text\r
-\r
- leave: Leave the table of references. If the last command has\r
- been \"new\", the new reference is copied and ready to yank\r
-\r
- enter: Just enter the node with the table of references\r
-\r
- goto: Search for a specific references within the table of\r
- references\r
-\r
- help: Show this list of commands\r
-\r
- all: Show all commands including the less frequently used ones\r
- given below.\r
-\r
- reorder: Temporarily reorder the table of references, e.g. by\r
- cound or last access\r
-\r
- sort: Sort a set of lines (either the active region or the\r
- whole buffer) by the references found within each line\r
-\r
- update: For the given reference update the line in the\r
- reference table\r
-\r
- highlight: Highlight references in region or buffer\r
-\r
- unhighlight: Remove highlights\r
-\r
-\r
-When prompting for a command, org-reftable puts the most likely\r
-chosen one (e.g. \"occur\" or \"new\") at the front of the list,\r
-so that you may just type RET. If this command needs additional\r
-input (like e.g. \"occur\" does, which needs a string to search\r
-for), you may supply this input right away, although you are\r
-still beeing prompted for the command (in that case your input\r
-will not match any of the given choices).\r
-\r
-")\r
-\r
-(defvar org-reftable-commands-some '(occur head new leave enter goto all help)\r
- "Subset of org-reftable-commands shown initially" )\r
-\r
-(defvar org-reftable-id nil \r
- "Id of the Org-mode node, which contains the reference table.\r
-\r
-Read below, on how to set up things. See the documentation of\r
-`org-reftable' for normal usage after setup.\r
-\r
-Setup requires two steps:\r
-\r
- - Adjust your .emacs initialization file\r
-\r
- - Create a suitable org-mode node\r
-\r
-\r
-Here are the lines, you should add to your .emacs:\r
-\r
- (require 'org-reftable)\r
- ;; Later you should probably change this id, as will be explained below\r
- (setq org-reftable-id \"00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\")\r
- ;; Optionally assign a key; pick your own favorite\r
- (global-set-key (kbd \"C-+\") 'org-reftable)\r
-\r
-Do not forget to restart emacs to make these lines effective.\r
-\r
-The id given above is an example, yours can be different.\r
-\r
-\r
-As a second step you need to create the org-mode node, where your\r
-reference numbers will be stored. It may look like this:\r
-\r
-\r
- * org-reftable\r
- :PROPERTIES:\r
- :ID: 00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\r
- :END:\r
-\r
-\r
- | | comment | | | |\r
- | ref | ;c | count;s | created | last-accessed |\r
- |-----+--------------------+---------+---------+---------------|\r
- | R1 | My first reference | | | |\r
-\r
-\r
-\r
-You may just want to copy this node into one of your org-files.\r
-Many things however can or should be adjusted:\r
-\r
- - The node needs not be a top level node.\r
-\r
- - Its name is completely at you choice. The node is found\r
- through its ID.\r
-\r
- - There are two lines of headings above the first hline. The\r
- first one is ignored by org-reftable, and you can use them to\r
- give meaningful names to columns; the second line however\r
- contains configuration information for org-reftable; please\r
- read further below for its format.\r
-\r
- - The sequence of columns does not matter. You may reorder them\r
- any way you like; e.g. make the comment-column the last\r
- columns within the table.\r
-\r
- - You can add further columns or even remove the\r
- \"Comment\"-column. The columns \"ref\" and \"created\"\r
- however are required. Columns \"cound\" and \"last-accessed\"\r
- are optional, but highly suggested anyway.\r
-\r
- - Your references need not start at \"R1\"; However, having an\r
- initial row is required (it servers a template for subsequent\r
- references).\r
-\r
- - Your reference need not have the form \"R1\"; you may just as\r
- well choose any text, that contains a single number,\r
- e.g. \"reference-{1}\" or \"#1\" or \"++1++\" or \"-1-\". The\r
- function `org-reftable' will inspect your first reference and\r
- create all subsequent references in the same way.\r
- \r
- - You may want to change the ID-Property of the node above and\r
- create a new one, which is unique (and not just a copy of\r
- mine). You need to change it in the lines copied to your .emacs\r
- too. However, this is not strictly required to make things\r
- work, so you may do this later, after trying out this package.\r
-\r
-\r
-Optionally you may tweak the second header line to adjust\r
-`org-reftable' a bit. In the ecample above it looks like this:\r
-\r
-\r
- | ref | ;c | count;s | created | last-accessed |\r
- |-----+--------------------+---------+---------+---------------|\r
-\r
-The different fields have different meanings:\r
-\r
- - ref : this denotes the column which contains you references\r
-\r
- - ;c : the flag \"c\" (\"c\" for \"copy\") denotes this column\r
- as the one beeing copied on command \"leave\". In the example above,\r
- it is the comment-column.\r
-\r
- - count;s : this is the column which counts last access, whence\r
- \"count\"; the flag \"s\" stands for \"sort\", so this is the\r
- column after which the table is sorted. You may also sort\r
- after columns \"ref\" or \"last-accessed\".\r
-\r
- - created : date when this reference was created.\r
-\r
- - last-accessed : date and time, when this reference was last accessed.\r
-\r
-\r
-After this two-step setup process you may invoke `org-reftable'\r
-to create a new reference number; read there for instructions on\r
-normal usage.\r
-\r
-If you have an existing reference table from a version of\r
-org-reftable before 2.0 (in fact earlier versions were rather\r
-named org-refer-by-number), you need to add a second headline\r
-like this, just about the hline to reflect the usage of columns\r
-in earlier versions:\r
-\r
- | ref | created |\r
-\r
-This will mark the first column as the actual references and the\r
-second column as the date of creation. However, to take advantage\r
-of the new features you should also add two other columns \"count;s\" \r
-(marked as the sort-column) and \"last-accessed\".\r
-\r
-")\r
-\r
-(defvar org-reftable-windowconfig-before nil \r
- "Saved window-configuration for `org-reftable'.\r
-This variable is only used internally.")\r
-\r
-(defvar org-reftable-marker-outside-before nil \r
- "Saved position in reftable-buffer bit outside of reftable (if at all).\r
-This variable is only used internally.")\r
-\r
-(defvar org-reftable-last-action nil \r
- "Last action performed by `org-reftable'.\r
-This variable is only used internally.")\r
-\r
-(defvar org-reftable-occur-buffer nil\r
- "Buffer (if any) with result from occur or multi-occur.\r
-This variable is only used internally.")\r
-\r
-(defvar org-reftable-ref-regex nil\r
- "Regular expression to search for\r
-This variable is only used internally.")\r
-\r
-\r
-\r
-(defun org-reftable (&optional what search) \r
- "Create, search and look up numbers from a dedicated reference table.\r
-These numbers (e.g. \"R237\" or \"-455-\") may be used to refer to:\r
-\r
- - Nodes in Org-mode (insert them into the heading)\r
-\r
- - Things outside of org (e.g. mailfolders, directories, reports or\r
- pieces of paper)\r
-\r
-The table is kept sorted for most frequently or most recently used\r
-reference numbers. Additionally, lines can be selected by keywords, so\r
-that specific references can be found easily.\r
-\r
-\r
-Read below for a detailed description of this function. See the\r
-documentation of `org-reftable-id' for the necessary\r
-setup.\r
-\r
-\r
-The function `org-reftable' operates on a dedicated table (called\r
-the reference table) within a special Org-mode node. The node has\r
-to be created as part of your initial setup. Each line of the\r
-reference table contains:\r
-\r
- - A reference \r
-\r
- - Its respective creation date\r
-\r
- - A number; counting, how often each reference has been\r
- used. This number is updated automatically and the table can\r
- be sorted according to it, so that most frequently used\r
- references appear at the top of the table and can be spotted\r
- easily.\r
-\r
- - Date and time of last access. This column can alternatively be\r
- used to sort the table.\r
-\r
-The reference table is found through the id of the containing\r
-node; this id must be stored within `org-reftable-id' (see there\r
-for details).\r
-\r
-\r
-The function `org-reftable' is the only interactive function of\r
-this package and its sole entry point; it offers several commands\r
-to create, find and look up these reference numbers. All of them\r
-are described in the docstring of `org-reftable-commands' (see\r
-there for details).\r
-\r
-\r
-Finally, org-reftable can also be invoked from elisp; the two\r
-optional arguments to be accepted are:\r
-\r
- search : string to search for\r
- what : symbol of the command to invoke\r
-\r
-An example would be:\r
-\r
- (org-reftable \"237\" 'head) ;; find heading with ref 237\r
-\r
-"\r
-\r
- (interactive "P")\r
-\r
- (let (within-node ; True, if we are within node with reference table\r
- result-is-visible ; True, if node or occur is visible in any window\r
- ref-node-buffer-and-point ; cons with buffer and point of reference node\r
- below-cursor ; word below cursor\r
- active-region ; active region (if any)\r
- guarded-search ; with guard against additional digits\r
- commands ; currently active set of selectable commands\r
- what-adjusted ; True, if we had to adjust what\r
- what-input ; Input on what question (need not necessary be "what")\r
- reorder-once ; Column to use for single time sorting\r
- parts ; Parts of a typical reference number (which\r
- ; need not be a plain number); these are:\r
- head ; Any header before number (e.g. "R")\r
- maxref ; Maximum number from reference table (e.g. "153")\r
- tail ; Tail after number (e.g. "}" or "")\r
- ref-regex ; Regular expression to match a reference\r
- numcols ; Number of columns in reference table\r
- columns ; Associate column names with numbers\r
- kill-new-text ; Text that will be appended to kill ring\r
- message-text ; Text that will be issued as an explanation,\r
- ; what we have done\r
- )\r
-\r
- ;;\r
- ;; Examine current buffer and location, before turning to reference table\r
- ;;\r
-\r
- ;; Get the content of the active region or the word under cursor\r
- (if (and transient-mark-mode\r
- mark-active)\r
- (setq active-region (buffer-substring (region-beginning) (region-end))))\r
- (setq below-cursor (thing-at-point 'symbol))\r
-\r
-\r
- ;; Find out, if we are within reference table or not\r
- (setq within-node (string= (org-id-get) org-reftable-id))\r
-\r
- ;; Find out, if point in any window is within node with reference table\r
- (mapc (lambda (x) (with-current-buffer (window-buffer x)\r
- (when (or \r
- (string= (org-id-get) org-reftable-id)\r
- (eq (window-buffer x) \r
- org-reftable-occur-buffer))\r
- (setq result-is-visible t))))\r
- (window-list))\r
- \r
-\r
-\r
- ;;\r
- ;; Get decoration of references and highest number from reference table\r
- ;;\r
-\r
- ;; Find node\r
- (setq ref-node-buffer-and-point (org-reftable-id-find))\r
- (unless ref-node-buffer-and-point\r
- (org-reftable-report-setup-error \r
- (format "Cannot find node with id \"%s\"" org-reftable-id)))\r
-\r
- ;; Get configuration of reftable\r
- (with-current-buffer (car ref-node-buffer-and-point)\r
- (unless (string= (org-id-get) org-reftable-id)\r
- ;; Get marker for point within reftable-buffer, but only if outside\r
- ;; of reftable (if point is within reftable, we will try to stay at\r
- ;; the same ref)\r
- (setq org-reftable-marker-outside-before (point-marker))\r
- (goto-char (cdr ref-node-buffer-and-point)))\r
-\r
- ;; parse table\r
- (setq parts (org-reftable-parse-and-adjust-table reorder-once)))\r
- \r
- ;; Give names to parts of configuration\r
- (setq head (nth 0 parts))\r
- (setq maxref (nth 1 parts))\r
- (setq tail (nth 2 parts))\r
- (setq numcols (nth 3 parts))\r
- (setq columns (nth 4 parts))\r
- (setq ref-regex (nth 5 parts))\r
- \r
- ;;\r
- ;; Find out, what we are supposed to do\r
- ;;\r
-\r
- (if (equal what '(4)) (setq what 'leave))\r
-\r
- ;; Set preferred action, that will be the default choice\r
- (setq org-reftable-preferred-command\r
- (if within-node\r
- (if (eq org-reftable-last-action 'new)\r
- 'leave\r
- 'occur)\r
- (if active-region\r
- 'new\r
- (if (and below-cursor (string-match ref-regex below-cursor))\r
- 'occur\r
- nil))))\r
- \r
- ;; Ask user\r
- (unless what\r
- (setq commands (copy-list org-reftable-commands-some))\r
- (while (progn\r
- (setq what-input\r
- (org-icompleting-read \r
- "Please choose: " \r
- (mapcar 'symbol-name \r
- ;; Construct unique list of commands with\r
- ;; preferred one at front\r
- (delq nil (delete-dups \r
- (append \r
- (list org-reftable-preferred-command)\r
- commands))))\r
- nil nil))\r
- (setq what (intern what-input))\r
- \r
- ;; user is not required to input one of the commands; if\r
- ;; not, take the first one and use the original input for\r
- ;; next question\r
- (if (memq what commands)\r
- ;; input matched one element of list, dont need original\r
- ;; input any more\r
- (setq what-input nil)\r
- ;; what-input will be used for next question, use first\r
- ;; command for what\r
- (setq what (or org-reftable-preferred-command\r
- (first commands)))\r
- ;; remove any trailing dot, that user might have added to\r
- ;; disambiguate his input\r
- (if (equal (substring what-input -1) ".")\r
- ;; but do this only, if dot was really necessary to\r
- ;; disambiguate\r
- (let ((shortened-what-input (substring what-input 0 -1)))\r
- (unless (test-completion shortened-what-input \r
- (mapcar 'symbol-name \r
- org-reftable-commands))\r
- (setq what-input shortened-what-input)))))\r
- \r
-\r
- ;; ask for reorder in loop, because we have to ask for\r
- ;; what right again\r
- (if (eq what 'reorder)\r
- (setq reorder-once\r
- (intern\r
- (org-icompleting-read \r
- "Please choose column to reorder reftable once: " \r
- (mapcar 'symbol-name '(ref count last-accessed))\r
- nil t))))\r
- \r
- ;; offer extended selection of commands, if asked for\r
- (if (eq what 'all)\r
- (setq commands (copy-list org-reftable-commands)))\r
-\r
- ;; maybe ask initial question again\r
- (memq what '(reorder all)))))\r
-\r
-\r
- ;;\r
- ;; Get search, if required\r
- ;;\r
-\r
- ;; These actions need a search string:\r
- (when (memq what '(goto occur head update))\r
-\r
- ;; Maybe we've got a search string from the arguments\r
- (unless search\r
- (let (search-from-table\r
- search-from-cursor)\r
- \r
- ;; Search string can come from several sources:\r
- ;; From ref column of table\r
- (when within-node\r
- (save-excursion (setq search-from-table (org-table-get-field (cdr (assoc 'ref columns)))))\r
- (if (string= search-from-table "") (setq search-from-table nil))) \r
- ;; From string below cursor\r
- (when (and (not within-node)\r
- below-cursor\r
- (string-match (concat "\\(" ref-regex "\\)") \r
- below-cursor))\r
- (setq search-from-cursor (match-string 1 below-cursor)))\r
- \r
- ;; Depending on requested action, get search from one of the sources above\r
- (cond ((eq what 'goto)\r
- (setq search (or what-input search-from-cursor)))\r
- ((memq what '(head occur))\r
- (setq search (or what-input search-from-table search-from-cursor))))))\r
-\r
-\r
- ;; If we still do not have a search string, ask user explicitly\r
- (unless search\r
- \r
- (if what-input \r
- (setq search what-input)\r
- (setq search (read-from-minibuffer\r
- (cond ((memq what '(goto occur head))\r
- "Text or reference number to search for: ")\r
- ((eq what 'update)\r
- "Reference number to update: ")))))\r
-\r
- (if (string-match "^\\s *[0-9]*\\s *$" search)\r
- (unless (string= search "")\r
- (setq search (format "%s%s%s" head (org-trim search) tail)))))\r
- \r
- ;; Clean up search string\r
- (if (string= search "") (setq search nil))\r
- (if search (setq search (org-trim search)))\r
-\r
- (setq guarded-search \r
- (concat (regexp-quote search)\r
- ;; if there is no tail in reference number, we\r
- ;; have to guard agains trailing digits\r
- (if (string= tail "") "\\($\\|[^0-9]\\)" "")))\r
-\r
-\r
- ;;\r
- ;; Do some sanity checking before really starting\r
- ;;\r
-\r
- ;; Correct requested action, if nothing to search\r
- (when (and (not search)\r
- (memq what '(search occur head)))\r
- (setq what 'enter)\r
- (setq what-adjusted t))\r
-\r
- ;; Check for invalid combinations of arguments; try to be helpful\r
- (if (string-match ref-regex search)\r
- (progn\r
- ;; Count searches and update last access date\r
- (if search (org-reftable-update-reference-line search columns))\r
- (if (eq what 'occur) (setq what 'multi-occur)))\r
- (when (memq what '(goto head))\r
- (error "Can do '%s' only for a number (not '%s'), try 'occur' to search for text" what search))))\r
-\r
- \r
- ;;\r
- ;; Prepare\r
- ;;\r
-\r
- ;; Move into table, if outside\r
- (when (memq what '(enter new goto occur multi-occur))\r
- ;; Save current window configuration\r
- (when (or (not result-is-visible)\r
- (not org-reftable-windowconfig-before))\r
- (setq org-reftable-windowconfig-before (current-window-configuration)))\r
-\r
- ;; Switch to reference table\r
- (org-pop-to-buffer-same-window (car ref-node-buffer-and-point))\r
- (goto-char (cdr ref-node-buffer-and-point))\r
- (show-subtree)\r
- (org-show-context))\r
-\r
-\r
- ;;\r
- ;; Actually do, what is requested\r
- ;;\r
-\r
- (cond\r
-\r
-\r
- ((eq what 'help)\r
- \r
- (let ((help-what\r
- ;; which sort of help ?\r
- (intern\r
- (concat \r
- "help-"\r
- (org-icompleting-read \r
- "Help on: "\r
- (mapcar 'symbol-name '(commands usage setup)) \r
- nil t)))))\r
-\r
- ;; help is taken from docstring of functions or variables\r
- (cond ((eq help-what 'help-commands)\r
- (org-reftable-show-help 'org-reftable-commands))\r
- ((eq help-what 'help-usage)\r
- (org-reftable-show-help 'org-reftable))\r
- ((eq help-what 'help-setup)\r
- (org-reftable-show-help 'org-reftable-id)))))\r
-\r
-\r
- ((eq what 'multi-occur) \r
- \r
- ;; Conveniently position cursor on number to search for\r
- (org-reftable-goto-top)\r
- (let (found (initial (point)))\r
- (while (and (not found)\r
- (forward-line)\r
- (org-at-table-p))\r
- (save-excursion \r
- (setq found (string= search \r
- (org-trim (org-table-get-field (cdr (assoc 'ref columns))))))))\r
- (if found \r
- (org-table-goto-column (cdr (assoc 'ref columns)))\r
- (goto-char initial)))\r
-\r
- ;; Construct list of all org-buffers\r
- (let (buff org-buffers)\r
- (dolist (buff (buffer-list))\r
- (set-buffer buff)\r
- (if (string= major-mode "org-mode")\r
- (setq org-buffers (cons buff org-buffers))))\r
-\r
- ;; Do multi-occur\r
- (multi-occur org-buffers guarded-search)\r
- (if (get-buffer "*Occur*")\r
- (progn \r
- (setq message-text (format "multi-occur for '%s'" search))\r
- (setq org-reftable-occur-buffer (get-buffer "*Occur*"))\r
- (other-window 1)\r
- (toggle-truncate-lines 1))\r
- (setq message-text (format "Did not find '%s'" search)))))\r
-\r
-\r
- ((eq what 'head)\r
-\r
- (message (format "Scanning headlines for '%s' ..." search))\r
- (let (buffer point)\r
- (if (catch 'found\r
- (progn\r
- ;; loop over all headlines, stop on first match\r
- (org-map-entries \r
- (lambda () \r
- (when (looking-at (concat ".*\\b" guarded-search))\r
- (setq buffer (current-buffer))\r
- (setq point (point))\r
- (throw 'found t))) \r
- nil 'agenda)\r
- nil))\r
- (progn\r
- (setq message-text (format "Found '%s'" search))\r
- (org-pop-to-buffer-same-window buffer)\r
- (goto-char point)\r
- (org-reveal))\r
- (setq message-text (format "Did not find '%s'" search)))))\r
-\r
-\r
- ((eq what 'leave)\r
-\r
- (when result-is-visible\r
-\r
- ;; If we are within the occur-buffer, switch over to get current line\r
- (if (and (string= (buffer-name) "*Occur*")\r
- (eq org-reftable-last-action 'occur))\r
- (occur-mode-goto-occurrence))\r
-\r
- (let (copy-column) \r
- ;; Try to copy requested column\r
- (setq copy-column (cdr (assoc \r
- (if (eq org-reftable-last-action 'new)\r
- 'goto\r
- 'copy)\r
- columns)))\r
- \r
- ;; Add to kill ring\r
- (if (memq org-reftable-last-action '(new enter goto occur))\r
- (setq kill-new-text \r
- (org-trim (org-table-get-field copy-column))))))\r
-\r
- ;; Restore position within buffer with reference table\r
- (with-current-buffer (car ref-node-buffer-and-point)\r
- (when org-reftable-marker-outside-before\r
- (goto-char (marker-position org-reftable-marker-outside-before))\r
- (move-marker org-reftable-marker-outside-before nil)))\r
-\r
- ;; Restore windowconfig\r
- (if org-reftable-windowconfig-before \r
- (progn \r
- ;; Restore initial window configuration\r
- (set-window-configuration org-reftable-windowconfig-before)\r
- (setq org-reftable-windowconfig-before nil)\r
- ;; Goto initial position\r
- (recenter)\r
- (setq message-text "Back"))\r
- ;; We did not have a window-configuration to restore, so we cannot\r
- ;; pretend we have returned back\r
- (setq message-text "Cannot leave; nowhere to go to")\r
- (setq kill-new-text nil)))\r
-\r
-\r
- ((eq what 'goto)\r
-\r
- ;; Go downward in table to requested reference\r
- (let (found (initial (point)))\r
- (org-reftable-goto-top)\r
- (while (and (not found)\r
- (forward-line)\r
- (org-at-table-p))\r
- (save-excursion \r
- (setq found \r
- (string= search \r
- (org-trim (org-table-get-field (cdr (assoc 'ref columns))))))))\r
- (if found\r
- (progn\r
- (setq message-text (format "Found '%s'" search))\r
- (org-table-goto-column (cdr (assoc 'ref columns)))\r
- (if (looking-back " ") (backward-char)))\r
- (setq message-text (format "Did not find '%s'" search))\r
- (goto-char initial)\r
- (forward-line)\r
- (setq what 'missed))))\r
-\r
-\r
- ((eq what 'occur)\r
-\r
- ;; search for string: occur\r
- (save-restriction\r
- (org-narrow-to-subtree)\r
- (occur search)\r
- (widen)\r
- (if (get-buffer "*Occur*")\r
- (with-current-buffer "*Occur*"\r
-\r
- ;; install helpful keyboard-shortcuts within occur-buffer\r
- (let ((keymap (make-sparse-keymap)))\r
- (set-keymap-parent keymap occur-mode-map)\r
-\r
- (define-key keymap (kbd "RET") \r
- (lambda () (interactive) \r
- (org-reftable-occur-helper 'head)))\r
-\r
- (define-key keymap (kbd "<C-return>") \r
- (lambda () (interactive) \r
- (org-reftable-occur-helper 'multi-occur)))\r
-\r
- (use-local-map keymap))\r
- (setq org-reftable-ref-regex ref-regex)\r
-\r
- ;; insert some help text\r
- (other-window 1)\r
- (toggle-truncate-lines 1)\r
- (let ((inhibit-read-only t)) \r
- (insert (substitute-command-keys \r
- "Type RET to find heading, C-RET for multi-occur, \\[next-error-follow-minor-mode] for follow-mode.\n\n")))\r
- (forward-line 1)\r
- (setq message-text\r
- (format "Occur for '%s'" search)))\r
- (setq message-text\r
- (format "Did not find any matches for '%s'" search)))))\r
-\r
-\r
- ((eq what 'new)\r
-\r
- ;; add a new row\r
- (org-reftable-goto-top)\r
- (let ((new (format "%s%d%s" head (1+ maxref) tail)))\r
-\r
- (org-table-insert-row)\r
-\r
- ;; fill special columns with standard values\r
- (org-table-goto-column (cdr (assoc 'ref columns)))\r
- (insert new)\r
- (org-table-goto-column (cdr (assoc 'created columns)))\r
- (org-insert-time-stamp nil nil t)\r
-\r
- ;; goto first nonempty field\r
- (catch 'empty\r
- (dotimes (col numcols)\r
- (org-table-goto-column (+ col 1))\r
- (if (string= (org-trim (org-table-get-field)) "")\r
- (throw 'empty t)))\r
- ;; none found, goto first\r
- (org-table-goto-column 1))\r
-\r
- (org-table-align)\r
- (if active-region (setq kill-new-text active-region))\r
- (setq message-text (format "Adding a new row '%s'" new))))\r
-\r
-\r
- ((eq what 'enter)\r
-\r
- ;; simply go into table\r
- (org-reftable-goto-top)\r
- (show-subtree)\r
- (recenter)\r
- (if what-adjusted\r
- (setq message-text "Nothing to search for; at reference table")\r
- (setq message-text "At reference table")))\r
-\r
-\r
- ((eq what 'sort)\r
-\r
- ;; sort lines according to contained reference\r
- (let (begin end where)\r
- (catch 'aborted\r
- ;; either active region or whole buffer\r
- (if (and transient-mark-mode\r
- mark-active)\r
- ;; sort only region\r
- (progn\r
- (setq begin (region-beginning))\r
- (setq end (region-end))\r
- (setq where "region"))\r
- ;; sort whole buffer\r
- (setq begin (point-min))\r
- (setq end (point-max))\r
- (setq where "whole buffer")\r
- ;; make sure\r
- (unless (y-or-n-p "Sort whole buffer ")\r
- (setq message-text "Sort aborted")\r
- (throw 'aborted nil)))\r
- \r
- (save-excursion\r
- (save-restriction\r
- (goto-char (point-min))\r
- (narrow-to-region begin end)\r
- (sort-subr nil 'forward-line 'end-of-line \r
- (lambda ()\r
- (if (looking-at (concat "^.*\\b" ref-regex "\\b"))\r
- (string-to-number (match-string 1))\r
- 0))))\r
- (highlight-regexp ref-regex)\r
- (setq message-text (format "Sorted %s from character %d to %d, %d lines" \r
- where begin end\r
- (count-lines begin end)))))))\r
- \r
-\r
- ((eq what 'update)\r
-\r
- ;; simply update line in reftable\r
- (save-excursion\r
- (beginning-of-line)\r
- (if (org-reftable-update-reference-line search columns)\r
- (setq message-text (format "Updated reference '%s'" search))\r
- (setq message-text (format "Did not find reference '%s'" search)))))\r
-\r
-\r
- ((memq what '(highlight unhighlight))\r
-\r
- (let ((where "buffer"))\r
- (save-excursion\r
- (save-restriction\r
- (when (and transient-mark-mode\r
- mark-active)\r
- (narrow-to-region (region-beginning) (region-end))\r
- (setq where "region"))\r
-\r
- (if (eq what 'highlight)\r
- (progn\r
- (highlight-regexp ref-regex)\r
- (setq message-text (format "Highlighted references in %s" where)))\r
- (unhighlight-regexp ref-regex)\r
- (setq message-text (format "Removed highlights for references in %s" where)))))))\r
-\r
-\r
- (t (error "This is a bug: Unmatched condition '%s'" what)))\r
-\r
-\r
- ;; remember what we have done for next time\r
- (setq org-reftable-last-action what)\r
- \r
- ;; tell, what we have done and what can be yanked\r
- (if kill-new-text (setq kill-new-text \r
- (substring-no-properties kill-new-text)))\r
- (if (string= kill-new-text "") (setq kill-new-text nil))\r
- (let ((m (concat \r
- message-text\r
- (if (and message-text kill-new-text) \r
- " and r" \r
- (if kill-new-text "R" ""))\r
- (if kill-new-text (format "eady to yank '%s'" kill-new-text) ""))))\r
- (unless (string= m "") (message m)))\r
- (if kill-new-text (kill-new kill-new-text))))\r
-\r
-\r
-\r
-(defun org-reftable-parse-and-adjust-table (&optional sort-column)\r
- "Trim reference table, only used internally"\r
-\r
- (let ((maxref 0)\r
- top\r
- bottom\r
- field\r
- parts\r
- numcols\r
- columns\r
- head\r
- tail\r
- ref-regex\r
- initial-ref\r
- initial-point)\r
-\r
- (setq initial-point (point))\r
- (org-reftable-goto-top)\r
- (setq top (point))\r
- \r
- (goto-char top)\r
- \r
- ;; count columns\r
- (org-table-goto-column 100)\r
- (setq numcols (- (org-table-current-column) 1))\r
- (org-table-goto-column 1)\r
- \r
- ;; get contents of columns\r
- (forward-line -2)\r
- (unless (org-at-table-p)\r
- (org-reftable-report-setup-error \r
- "Reference table starts with a hline" t))\r
- \r
- (setq columns (org-reftable-parse-headings numcols))\r
- \r
- ;; Go beyond end of table\r
- (while (org-at-table-p) (forward-line 1))\r
- \r
- ;; Kill all empty rows at bottom\r
- (while (progn\r
- (forward-line -1)\r
- (org-table-goto-column 1)\r
- (string= "" (org-trim (org-table-get-field (cdr (assoc 'ref columns))))))\r
- (org-table-kill-row))\r
- (forward-line)\r
- (setq bottom (point))\r
- (forward-line -1)\r
- \r
- ;; Retrieve any decorations around the number within ref-field of\r
- ;; the first row\r
- (goto-char top)\r
- (setq field (org-trim (org-table-get-field (cdr (assoc 'ref columns)))))\r
- (or (numberp (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" field))\r
- (org-reftable-report-setup-error \r
- (format "reference column in first line of reference table '%s' does not contain a number" field) t))\r
- \r
- ;; These are the decorations used within the first row of the\r
- ;; reference table\r
- (setq head (match-string 1 field))\r
- (setq tail (match-string 3 field))\r
- (setq ref-regex (concat (regexp-quote head)\r
- "\\([0-9]+\\)" \r
- (regexp-quote tail)))\r
-\r
- ;; Save initial ref\r
- (save-excursion\r
- (let (field)\r
- (goto-char initial-point)\r
- (setq field (org-table-get-field (cdr (assoc 'ref columns))))\r
- (if (string-match ref-regex field)\r
- (setq initial-ref (concat head (match-string 1 field) tail)))))\r
-\r
- ;; Go through table to find maximum number\r
- (let ((ref 0)\r
- field)\r
- (while (org-at-table-p) \r
- (setq field (org-trim (org-table-get-field (cdr (assoc 'ref columns)))))\r
- (if (string-match ref-regex field)\r
- (setq ref (string-to-number (match-string 1 field)))\r
- \r
- (unless (string= "" field)\r
- (org-reftable-report-setup-error \r
- (format "Reference field in line of reference table '%s' does not contain a number" field) t)))\r
- (if (> ref maxref) (setq maxref ref))\r
- (forward-line 1)))\r
- \r
- (setq parts (list head maxref tail numcols columns ref-regex))\r
- \r
- ;; sort table after sort-column\r
- (unless sort-column (setq sort-column (cdr (assoc 'sort columns))))\r
- (goto-char top)\r
- (forward-line 0)\r
- (save-restriction\r
- (narrow-to-region (point) bottom)\r
- (sort-subr t\r
- 'forward-line \r
- 'end-of-line \r
- (lambda ()\r
- (let (ref\r
- (ref-field (org-table-get-field \r
- (cdr (assoc 'ref columns)))))\r
- (string-match ref-regex ref-field)\r
- ;; get reference with leading zeroes, so it can be\r
- ;; sorted as text\r
- (setq ref (format \r
- "%06d" \r
- (string-to-number \r
- (match-string 1 ref-field))))\r
- \r
- ;; Construct different sort-keys according to\r
- ;; requested sort column; append ref as a secondary\r
- ;; sort key\r
-\r
- ;; \r
- (cond ((eq sort-column 'count)\r
- (concat (format \r
- "%08d" \r
- (string-to-number \r
- (org-table-get-field \r
- (cdr (assoc 'count columns))))) \r
- " " ref))\r
- \r
- ((eq sort-column 'last-accessed)\r
- (concat (org-table-get-field \r
- (cdr (assoc 'last-accessed columns))) \r
- " " ref))\r
- \r
- ((eq sort-column 'ref)\r
- ref)\r
- \r
- (t \r
- (error "Bug !")))))\r
- nil\r
- 'string<)\r
- )\r
-\r
- ;; align table\r
- (org-table-align)\r
- \r
- ;; go back to top of table\r
- (goto-char top)\r
-\r
- ;; Goto back to initial ref, because reformatting of table above might\r
- ;; have moved point\r
- (when initial-ref\r
- (while (and (org-at-table-p)\r
- (not (string= initial-ref (org-trim (org-table-get-field (cdr (assoc 'ref columns)))))))\r
- (forward-line))\r
- ;; did not find ref, go back to top\r
- (if (not (org-at-table-p)) (goto-char top)))\r
-\r
- parts))\r
-\r
-\r
-\r
-(defun org-reftable-goto-top ()\r
- "Goto topmost reference line in reftable"\r
-\r
- ;; go to heading of node\r
- (while (not (org-at-heading-p)) (forward-line -1))\r
- (forward-line 1)\r
- ;; go to table within node, but make sure we do not get into another node\r
- (while (and (not (org-at-heading-p))\r
- (not (org-at-table-p))\r
- (not (eq (point) (point-max)))) \r
- (forward-line 1))\r
- \r
- ;; check, if there really is a table\r
- (unless (org-at-table-p)\r
- (org-reftable-report-setup-error \r
- "Cannot find reference table within reference node" t))\r
-\r
- ;; go to first hline\r
- (while (and (not (org-at-table-hline-p))\r
- (org-at-table-p))\r
- (forward-line 1))\r
- \r
- ;; and check\r
- (unless (org-at-table-hline-p)\r
- (org-reftable-report-setup-error \r
- "Cannot find hline within reference table" t)) \r
-\r
- (forward-line 1)\r
- (org-table-goto-column 1))\r
-\r
-\r
-\r
-(defun org-reftable-id-find ()\r
- "Find org-reftable-id"\r
- (let ((marker (org-id-find org-reftable-id 'marker))\r
- marker-and-buffer)\r
-\r
- (if marker \r
- (progn \r
- (setq marker-and-buffer (cons (marker-buffer marker) (marker-position marker)))\r
- (move-marker marker nil)\r
- marker-and-buffer)\r
- nil)))\r
-\r
-\r
-\r
-(defun org-reftable-parse-headings (numcols)\r
- "Parse headings to find special columns"\r
-\r
- (let (columns)\r
-\r
- ;; Associate names of special columns with column-numbers\r
- (setq columns (copy-tree '((ref . 0) (created . 0) (last-accessed . 0) \r
- (count . 0) (sort . nil) (copy . nil))))\r
-\r
- ;; For each column\r
- (dotimes (col numcols)\r
- (let* (field-flags ;; raw heading, consisting of file name and maybe\r
- ;; flags (seperated by ";")\r
- field ;; field name only\r
- field-symbol ;; and as a symbol\r
- flags ;; flags from field-flags\r
- found)\r
-\r
- ;; parse field-flags into field and flags\r
- (setq field-flags (org-trim (org-table-get-field (+ col 1))))\r
- (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags)\r
- (progn \r
- (setq field (downcase (or (match-string 1 field-flags) "")))\r
- ;; get flags as list of characters\r
- (setq flags (mapcar 'string-to-char \r
- (split-string \r
- (downcase (match-string 2 field-flags)) \r
- "" t))))\r
- ;; no flags\r
- (setq field field-flags))\r
-\r
- (unless (string= field "") (setq field-symbol (intern (downcase field))))\r
-\r
- ;; Check, that no flags appear twice\r
- (mapc (lambda (x)\r
- (when (memq (car x) flags)\r
- (if (cdr (assoc (cdr x) columns))\r
- (org-reftable-report-setup-error \r
- (format "More than one heading is marked with flag '%c'" (car x)) t))))\r
- '((?s . sort)\r
- (?c . copy)))\r
- \r
- ;; Process flags\r
- (if (memq ?s flags)\r
- (setcdr (assoc 'sort columns) field-symbol))\r
- (if (memq ?c flags)\r
- (setcdr (assoc 'copy columns) (+ col 1)))\r
- \r
- ;; Store columns in alist\r
- (setq found (assoc field-symbol columns))\r
- (when found\r
- (if (> (cdr found) 0) \r
- (org-reftable-report-setup-error \r
- (format "'%s' appears two times as column heading" (downcase field)) t))\r
- (setcdr found (+ col 1)))))\r
-\r
- ;; check if all necessary informations have been specified\r
- (unless (> (cdr (assoc 'ref columns)) 0)\r
- (org-reftable-report-setup-error \r
- "column 'ref' has not been set" t))\r
-\r
- ;; use ref as a default sort-column\r
- (unless (cdr (assoc 'sort columns))\r
- (setcdr (assoc 'sort columns) 'ref))\r
- columns))\r
-\r
-\r
-\r
-(defun org-reftable-report-setup-error (text &optional switch-to-node)\r
- "Report error, which might be related with incomplete setup; offer help"\r
-\r
- (when switch-to-node \r
- (org-id-goto org-reftable-id)\r
- (delete-other-windows))\r
- \r
- (when (y-or-n-p (concat\r
- text \r
- ";\n"\r
- "the correct setup is explained in the documentation of 'org-reftable-id'.\n" \r
- "Do you want to read it ? "))\r
- (org-reftable-show-help 'org-reftable-id))\r
-\r
- (error "")\r
- (setq org-reftable-windowconfig-before nil)\r
- (move-marker org-reftable-marker-outside-before nil)\r
- (setq org-reftable-last-action 'leave))\r
-\r
-\r
-\r
-(defun org-reftable-show-help (function-or-variable)\r
- "Show help on command or function and trim help buffer displayed"\r
-\r
- (let ((isfun (functionp function-or-variable)))\r
- ;; bring up help-buffer for function or variable\r
- (if isfun\r
- (describe-function function-or-variable)\r
- (describe-variable function-or-variable))\r
-\r
- \r
- ;; clean up help-buffer\r
- (pop-to-buffer "*Help*")\r
- (let ((inhibit-read-only t)) \r
- (goto-char (point-min))\r
- (while (progn\r
- (kill-line 1)\r
- (not (looking-at \r
- (if isfun\r
- "(" \r
- "Documentation:")))))\r
- (kill-line (if isfun 2 1))\r
- (goto-char (point-max))\r
- (kill-line -2)\r
- (goto-char (point-min)))))\r
- \r
-\r
-\r
-(defun org-reftable-update-reference-line (reference columns)\r
- "Update access count and time of reference number"\r
-\r
- (let ((initial (point))\r
- found\r
- (ref-node-buffer-and-point (org-reftable-id-find)))\r
- (with-current-buffer (car ref-node-buffer-and-point)\r
- (goto-char (cdr ref-node-buffer-and-point))\r
- (org-reftable-goto-top)\r
- (while (and (org-at-table-p)\r
- (if (string= reference (org-trim (org-table-get-field (cdr (assoc 'ref columns)))))\r
- (progn (org-table-get-field (cdr (assoc 'count columns))\r
- (number-to-string \r
- (+ 1 (string-to-number \r
- (org-table-get-field (cdr (assoc 'count columns)))))))\r
- (org-table-goto-column (cdr (assoc 'last-accessed columns)))\r
- (org-table-blank-field)\r
- (org-insert-time-stamp nil t t)\r
- (org-table-align)\r
- (setq found t)\r
- nil)\r
- t))\r
- (forward-line))\r
- (goto-char initial))\r
- found))\r
-\r
-\r
-\r
-(defun org-reftable-occur-helper (action)\r
- "Internal helper function for occur in org-reftable"\r
- (save-excursion\r
- (beginning-of-line)\r
- (if (looking-at (concat ".*\\b\\(" org-reftable-ref-regex "\\)\\b"))\r
- (org-reftable action (match-string 1)))))\r
-\r
-\r
-(provide 'org-reftable)\r
-\r
-;; Local Variables:\r
-;; fill-column: 75\r
-;; comment-column: 50\r
-;; End:\r
-\r
-;;; org-reftable.el ends here\r
-\r
projects / worg.git / commitdiff