--- /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
--- /dev/null
+
+* Table operations --- filter or combine tables
+
+ This section within the library of babel provides table operations.
+ See the documentation just below for details and working examples.
+
+ Author : Marc-Oliver Ihm <ihm@ferntreffer.de>
+ Version : 1.0
+
+** Documentation
+
+*** Introduction
+
+ The table operations (currently four) are grouped in two categories:
+
+ - Filtering the rows of a single table: keeping or removing
+ - Combining two tables into one: merging or intersecting
+
+ All four operations are demonstrated below.
+
+*** Example tables
+
+ To demonstrate we need three tables: upper, lower and keys:
+
+#+name: upper
+| 1 | A |
+| 3 | C |
+| 4 | D |
+| 10 | J |
+| 2 | B |
+
+#+name: lower
+| Position | Letter |
+|----------+--------|
+| 2 | b |
+| 4 | d |
+| 5 | e |
+| 6 | h |
+
+#+name: keys
+| Position |
+|----------|
+| 1 |
+| 2 |
+| 4 |
+
+ The tables upper and lower both have two columns and associate a position in
+ the alphabet with the matching letter. E.g. the row "| 1 | A |" from table
+ upper, just states that the letter "A" comes at position 1 in the alphabet.
+
+ Nearly the same is true for table lower, only that it contains lower case
+ letters. Some of its letters (e.g. "b") have counterparts in table upper
+ ("B"), some (e.g. "e") dont.
+
+ The table keys finally, contains keys (i.e. positions within the alphabet),
+ that can be used to select rows from either table upper or lower.
+
+ Note, that tables may have column headings or not.
+
+*** Filtering a table
+
+**** Keeping rows
+
+ Let's say, we want to select the upper-case letters (i.e. rows from the
+ table upper), that are given in table keys (i.e. the first, second and
+ fourth letter).
+
+ This can be described as filtering table upper and keeping only those rows,
+ that appear in table keys.
+
+ As a babel-call, this reads:
+
+#+call: table-operations-filter-keep(upper,keys)
+
+#+results: table-operations-filter-keep(upper,keys)
+| 1 | A |
+| 4 | D |
+| 2 | B |
+
+ ,which gives exactly those rows from table upper, that are specified in
+ keys.
+
+**** Removing rows
+
+ Now, if on the contrary you want to filter table upper to remove any rows,
+ which are given in table keys:
+
+#+call: table-operations-filter-remove(upper,keys) :colnames yes
+
+#+results: table-operations-filter-remove(upper,keys)
+| Position | t2c2 |
+|----------+------|
+| 3 | C |
+| 10 | J |
+
+ ,which is the expected result.
+
+ Please note, that the call contains the header argument ":colnames yes",
+ which causes the result table to contain the headings "Position" and
+ "t2c2". These headings are taken from the input-tables upper and
+ keys. However, as upper does not contain any headings, the heading "t2c2"
+ is generated artificially; it stands for "table 2 column 2".
+
+ If you do not want to have column names in the result table, just leave out
+ the header argument ":colnames yes" like in the first example. Note
+ however, that ":colnames no" does not give the expected effect.
+
+*** Combining tables
+
+ Now, lets have a look at the tables upper and lower alone and see how to
+ combine them.
+
+ Note, that we only look at combining two tables for simplicity, however, all
+ operations can be easily scaled up to seven tables.
+
+**** Merging rows
+
+ We have two tables, one with upper case letters and one with lower
+ case. What now, if you want to have only one table, which contains both,
+ upper and lower case letters ?
+
+ You may want to merge them:
+
+#+call: table-operations-combine-merge(upper,lower) :colnames yes
+
+#+results: table-operations-combine-merge(upper,lower)
+| Position | t1c2 | Letter |
+|----------+------+--------|
+| 1 | A | |
+| 2 | B | b |
+| 3 | C | |
+| 4 | D | d |
+| 5 | | e |
+| 6 | | h |
+| 10 | J | |
+
+
+ This result combines both upper and lower case letters and lists them by
+ their position within the alphabet.
+
+**** Intersecting rows
+
+ If you only want the rows, that are complete (i.e. have both upper and
+ lower case letters) you may compute the intersection:
+
+#+call: table-operations-combine-intersect(upper,lower)
+
+#+results: table-operations-combine-intersect(upper,lower)
+| 2 | B | b |
+| 4 | D | d |
+
+
+ ,which has only those keys and letters, that appear in both tables.
+
+ Note, that we have ommitted the headeragument ":colnames yes" so that the
+ result table has no headings.
+
+** Internals
+
+ This section is not required if you just want to use table operations as
+ described above. Only if you are curious about its implementation or
+ development, you might want to have a look.
+
+*** Implementation
+
+ Here is the actual lisp code, that implements the functionality of table
+ operations.
+
+**** table-operations-filter
+***** Directly callable blocks
+
+#+name: table-operations-filter-keep
+#+begin_src emacs-lisp :noweb yes :results silent :var table=() :var filter=()
+ <<lob-table-operations-helper-get-headings-defun>>
+ <<lob-table-operations-filter-defun>>
+ (let ((filter-and-table (list filter table)))
+ (lob-table-operations-filter 'keep filter-and-table))
+#+end_src
+
+#+name: table-operations-filter-remove
+#+begin_src emacs-lisp :noweb yes :results silent :var table=() :var filter=() :colnames nil
+ <<lob-table-operations-helper-get-headings-defun>>
+ <<lob-table-operations-filter-defun>>
+ (let ((filter-and-table (list filter table)))
+ (lob-table-operations-filter 'remove filter-and-table))
+#+end_src
+
+***** Included defuns
+
+#+name: lob-table-operations-filter-defun
+#+begin_src emacs-lisp
+ (defun lob-table-operations-filter (what filter-and-table)
+ "Internal function for table operations in orgmode library of babel"
+
+ (let (keys
+ result-table
+ headings-all-tables
+ filter
+ table)
+
+ ;; seperate headings from rest of tables
+ (setq headings-all-tables
+ (lob-table-operations-helper-get-headings filter-and-table))
+
+ ;; extract arguments
+ (setq filter (car filter-and-table))
+ (setq table (cadr filter-and-table))
+
+ ;; remove hlines
+ (setq table (org-babel-del-hlines table))
+ (setq filter (org-babel-del-hlines filter))
+ (setq keys (mapcar 'car filter))
+
+ ;; start result with headings (reversed)
+ (setq result-table (cons 'hline (cons headings-all-tables nil)))
+
+ (dolist (line table) ; loop over table lines
+ (if (equal (not (not (member (car line) keys)))
+ (equal what 'keep)) ; 'keep or 'remove ?
+ (setq result-table (cons line result-table))))
+ (nreverse result-table)))
+#+end_src
+
+**** table-operations-combine
+***** Directly callable blocks
+
+#+name: table-operations-combine-merge
+#+begin_src emacs-lisp :noweb yes :results silent :var t1=() :var t2=() :var t3=() :var t4=() :var t5=() :var t6=() :var t7=()
+ <<lob-table-operations-helper-get-headings-defun>>
+ <<lob-table-operations-combine-defun>>
+ (let ((tables (list t1 t2 t3 t4 t5 t6 t7)))
+ (lob-table-operations-combine 'merge tables))
+#+end_src
+
+#+name: table-operations-combine-intersect
+#+begin_src emacs-lisp :noweb yes :results silent :var t1=() :var t2=() :var t3=() :var t4=() :var t5=() :var t6=() :var t7=()
+ <<lob-table-operations-helper-get-headings-defun>>
+ <<lob-table-operations-combine-defun>>
+ (let ((tables (list t1 t2 t3 t4 t5 t6 t7)))
+ (lob-table-operations-combine 'intersect tables))
+#+end_src
+
+***** Included defuns
+
+#+name: lob-table-operations-combine-defun
+#+begin_src emacs-lisp
+ (defun lob-table-operations-combine (what tables)
+ "Internal function for table-operations in orgmode library of babel"
+ (let (is-all-numbers
+ format-specifier
+ rest-of-tables
+ rests-of-tables
+ rest-of-rests-of-tables
+ rest-of-table
+ headings-all-tables
+ widths-of-tables
+ current-key
+ current-key-in-intersection
+ result-table
+ result-line
+ i)
+
+ ;; remove possible empty trailing tables
+ (setq rest-of-tables tables)
+ (while (cadr rest-of-tables) (setq rest-of-tables (cdr rest-of-tables)))
+ (setcdr rest-of-tables nil)
+
+ ;; seperate headings from rest of tables
+ (setq headings-all-tables (lob-table-operations-helper-get-headings
+ tables))
+ (setq result-table (cons 'hline (cons headings-all-tables nil)))
+
+ ;; remove all remaining hlines
+ (setq tables (mapcar 'org-babel-del-hlines tables))
+
+ ;; Find out, if all keys in all tables are numbers or if
+ ;; there are strings among them
+ (setq is-all-numbers
+ (catch 'not-a-number
+ (dolist (table tables)
+ (dolist (line table)
+ (unless (numberp (car line))
+ (throw 'not-a-number 'nil))))
+ 't))
+
+ (setq format-specifier (if is-all-numbers "%g" "%s"))
+ ;; Prepare functions to treat table contents in a unified way
+ (flet ((convert (x)
+ (if is-all-numbers
+ x
+ (if (numberp x)
+ (number-to-string x)
+ x)))
+ (less-than (x y)
+ (if is-all-numbers (< x y)
+ (string< (convert x)
+ (convert y))))
+ (compare (x y)
+ (if is-all-numbers (= x y)
+ (string= (convert x)
+ (convert y)))))
+
+ ;; sort tables
+ (setq tables (mapcar (lambda (table)
+ (sort table (lambda (x y)
+ (less-than (car x)
+ (car y)))))
+ tables))
+
+ ;; compute and remember table widths
+ (setq widths-of-tables (mapcar (lambda (x) (length (car x))) tables))
+
+ ;; copy initially and shorten below
+ (setq rests-of-tables (copy-list tables))
+
+ ;; loop as long as the rest of table still contains lines
+ (while (progn
+ ;; find lowest key among all tables, which is the key for the
+ ;; next line of the result
+ (setq current-key nil)
+ (setq current-key-in-intersection 't) ; remember for later
+ (dolist (rest-of-table rests-of-tables) ; loop over all tables
+ (when (and rest-of-table ; and compare against all keys
+ (or (null current-key)
+ (less-than (caar rest-of-table)
+ current-key)))
+ (setq current-key (caar rest-of-table))))
+ current-key)
+
+ (progn
+
+ (setq result-line (list current-key))
+
+ ;; go through all tables and collect one line for the result table
+ (setq i 0) ; table-count
+ ;; cannot use dolist like above, because we need to modify the
+ ;; cons-cells
+ (setq rest-of-rests-of-tables rests-of-tables)
+ (while (progn
+ (setq rest-of-table (car rest-of-rests-of-tables))
+ (incf i)
+ ;; if table contains current key
+ (if (and rest-of-table
+ (compare current-key (caar rest-of-table)))
+ ;; then copy rest of line
+ (progn (nconc result-line (cdar rest-of-table))
+ ;; and shorten rest
+ (setcar rest-of-rests-of-tables
+ (cdar rest-of-rests-of-tables))
+ ;; and check, if current-key appears again
+ (when (and (caadr rest-of-table)
+ (compare current-key
+ (caadr rest-of-table)))
+ (error (concat "Key '"
+ format-specifier
+ "' appears twice within "
+ "input table %i")
+ (convert current-key) i)
+ )
+ )
+ ;; otherwise fill with nil and do not shorte
+ ;; rest of table
+ (progn
+ (setq current-key-in-intersection nil)
+ (nconc result-line (make-list (1-
+ (elt widths-of-tables
+ (1- i)))
+ ""))))
+
+ (setq rest-of-rests-of-tables
+ (cdr rest-of-rests-of-tables))
+ rest-of-rests-of-tables)) ; condition for loop
+ (if (or (eq what 'merge) current-key-in-intersection)
+ ;; store away line
+ (setq result-table (cons
+ result-line
+ result-table)))))
+
+ (nreverse result-table))))
+#+end_src
+
+**** Common helper functions
+
+#+name: lob-table-operations-helper-get-headings-defun
+#+begin_src emacs-lisp
+ (defun lob-table-operations-helper-get-headings (tables)
+ "Internal function for table-operations in orgmode library of babel"
+ (let ((rest-of-tables tables)
+ (i 1)
+ headings-all-tables
+ headings-one-table
+ heading-of-key)
+ (while rest-of-tables
+ (progn
+ (setq table (car rest-of-tables))
+ (if (eq (cadr table) 'hline)
+ ;; second line is a hline, so first is a heading
+ (progn
+ ; take headings from first table row
+ (setq headings-one-table (cdar table))
+ (unless heading-of-key (setq heading-of-key (caar table)))
+ (unless (string= heading-of-key (caar table))
+ (error "Name of first column is not the same in all tables"))
+ (setcar rest-of-tables
+ (cdar rest-of-tables))) ; and shorten rest
+ ;; table does not contain headings, so make them up
+ (setq headings-one-table
+ (mapcar
+ (lambda (x) (format "t%dc%d" i x))
+ (number-sequence 2 (length (car table))))))
+ (setq headings-all-tables (append headings-all-tables
+ headings-one-table))
+ (setq rest-of-tables (cdr rest-of-tables))
+ (incf i)
+ rest-of-tables)) ; condition for while loop
+ (unless heading-of-key (setq heading-of-key "key"))
+ (setq headings-all-tables (cons heading-of-key headings-all-tables))
+ headings-all-tables))
+
+#+end_src
+
+**** Debugging and testing
+***** Clean up
+#+begin_src emacs-lisp
+ (save-excursion
+ (beginning-of-buffer)
+ (while (re-search-forward "^#\\+results:.*\n\\(^\|.+\n\\)*\n" nil t)
+ (replace-match ""))
+ )
+#+end_src
+
+#+results:
+
+***** Byte Compilation
+
+ (byte-compile 'lob-table-operations-combine)
+ (byte-compile 'lob-table-operations-filter)
+
+*** Development
+**** Versions and history
+
+ [2012-03-18 So] Version 1.0:
+ - Added handling of hlines and table headings
+
+ [2012-01-07 Sa] Version 0.01:
+ - Restructured as a single org-file; no special .el-file needed any more
+ - Combined and restructured documentation and implementation
+
+**** Bugs and Todos
+
+ - [X] Brush up documentation
+ - [X] Stay below 80 columns
+ - [X] Tests with more than two columns per table
+ - [X] Tests with more than two tables for merging
+ - [X] Handle optional table captions
+ - [X] Handle hlines
+ - [X] flet within lob-table-operations-combine
+ - [-] flet within directly callable blocks; try to avoid global functions
+ Not feasible, because that hinders debugging to much
+ - [X] Use :results silent
+
+**** Testcases
+
+#+name: upper-wide
+| Position | c1 | c2 | c3 | c4 |
+|----------+----+----+----+----|
+| 1 | A1 | A2 | A3 | A4 |
+| 3 | C1 | C2 | C3 | C4 |
+| 4 | D1 | D2 | D3 | D4 |
+| 10 | J1 | J2 | J3 | J4 |
+| 2 | B1 | B2 | B3 | B4 |
+
+#+name: lower-wide
+| 2 | b1 | b2 | b3 | b4 |
+| 4 | d1 | d2 | d3 | d4 |
+| 5 | e1 | e2 | e3 | e4 |
+| 6 | h1 | h2 | h3 | h4 |
+
+#+name: upper-lower-wide
+| 2 | Bb1 | Bb2 | Bb3 | Bb4 |
+| 6 | Hh1 | Hh2 | Hh3 | Hh4 |
+| 4 | Dd1 | Dd2 | Dd3 | Dd4 |
+| 10 | Jj1 | Jj2 | Jj3 | Jj4 |
+
+#+call: table-operations-filter-keep(upper-wide,keys)
+
+#+results: table-operations-filter-keep(upper-wide,keys)
+| 1 | A1 | A2 | A3 | A4 |
+| 4 | D1 | D2 | D3 | D4 |
+| 2 | B1 | B2 | B3 | B4 |
+
+#+call: table-operations-filter-remove(lower-wide,keys) :colnames yes
+
+#+results: table-operations-filter-remove(lower-wide,keys)
+| Position | t2c2 | t2c3 | t2c4 | t2c5 |
+|----------+------+------+------+------|
+| 5 | e1 | e2 | e3 | e4 |
+| 6 | h1 | h2 | h3 | h4 |
+
+#+call: table-operations-combine-merge(upper-wide,lower-wide) :colnames yes
+
+#+results: table-operations-combine-merge(upper-wide,lower-wide)
+| Position | c1 | c2 | c3 | c4 | t2c2 | t2c3 | t2c4 | t2c5 |
+|----------+----+----+----+----+------+------+------+------|
+| 1 | A1 | A2 | A3 | A4 | | | | |
+| 2 | B1 | B2 | B3 | B4 | b1 | b2 | b3 | b4 |
+| 3 | C1 | C2 | C3 | C4 | | | | |
+| 4 | D1 | D2 | D3 | D4 | d1 | d2 | d3 | d4 |
+| 5 | | | | | e1 | e2 | e3 | e4 |
+| 6 | | | | | h1 | h2 | h3 | h4 |
+| 10 | J1 | J2 | J3 | J4 | | | | |
+
+#+call: table-operations-combine-intersect(upper-wide,lower-wide)
+
+#+results: table-operations-combine-intersect(upper-wide,lower-wide)
+| 2 | B1 | B2 | B3 | B4 | b1 | b2 | b3 | b4 |
+| 4 | D1 | D2 | D3 | D4 | d1 | d2 | d3 | d4 |
+
+#+call: table-operations-combine-merge(upper-wide,lower-wide,upper-lower-wide) :colnames yes
+
+#+results: table-operations-combine-merge(upper-wide,lower-wide,upper-lower-wide)
+| Position | c1 | c2 | c3 | c4 | t2c2 | t2c3 | t2c4 | t2c5 | t3c2 | t3c3 | t3c4 | t3c5 |
+|----------+----+----+----+----+------+------+------+------+------+------+------+------|
+| 1 | A1 | A2 | A3 | A4 | | | | | | | | |
+| 2 | B1 | B2 | B3 | B4 | b1 | b2 | b3 | b4 | Bb1 | Bb2 | Bb3 | Bb4 |
+| 3 | C1 | C2 | C3 | C4 | | | | | | | | |
+| 4 | D1 | D2 | D3 | D4 | d1 | d2 | d3 | d4 | Dd1 | Dd2 | Dd3 | Dd4 |
+| 5 | | | | | e1 | e2 | e3 | e4 | | | | |
+| 6 | | | | | h1 | h2 | h3 | h4 | Hh1 | Hh2 | Hh3 | Hh4 |
+| 10 | J1 | J2 | J3 | J4 | | | | | Jj1 | Jj2 | Jj3 | Jj4 |
+
+#+call: table-operations-combine-intersect(upper-wide,lower-wide,upper-lower-wide)
+
+#+results: table-operations-combine-intersect(upper-wide,lower-wide,upper-lower-wide)
+| 2 | B1 | B2 | B3 | B4 | b1 | b2 | b3 | b4 | Bb1 | Bb2 | Bb3 | Bb4 |
+| 4 | D1 | D2 | D3 | D4 | d1 | d2 | d3 | d4 | Dd1 | Dd2 | Dd3 | Dd4 |
+
+**** Keeping the margins
+
+ (setq-default fill-column 80)
+ (column-marker-3 80)
+
+
projects / worg.git / commitdiff