contrib/lisp/org-index.el

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