contrib/lisp/org-favtable.el

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