contrib/lisp/org-index.el

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