Fix for assistant to create index; fix for occur-command

This commit is contained in:
Marc-Oliver Ihm 2014-04-26 22:48:09 +02:00
parent cacef8fefb
commit 233c11df42
1 changed files with 114 additions and 114 deletions

View File

@ -5,7 +5,7 @@
;; Author: Marc Ihm <org-index@2484.de>
;; Keywords: outlines, hypermedia, matching
;; Requires: org
;; Version: 2.4.2
;; Version: 2.4.3
;; This file is not part of GNU Emacs.
@ -72,6 +72,10 @@
;;; Change Log:
;; [2014-04-26 Sa] Version 2.4.3:
;; - Some Bugfixes and enhancements for occur-command
;; - Fixes for assistant to create index table
;;
;; [2014-02-01 Sa] Version 2.4.2:
;; - Follow mode in occur-buffer
;; - Reorder for x-columns
@ -164,6 +168,7 @@
(defvar org-index--text-to-yank nil) ; Text, that can be yanked after call (mostly a reference)
(defvar org-index--last-ref) ; Last reference created or visited
(defvar org-index--point-before nil) ; Point in buffer with index table
(defvar org-index--point-saved nil) ; Saved point if we want to return
(defvar org-index--silent nil) ; t, if user should not be queried
(defvar org-index--preferred-command) ; command, that is presented first
(defvar org-index--active-region) ; Active region, initially. I.e. what has been marked
@ -172,7 +177,8 @@
(defvar org-index--active-window-index nil) ; Active window with index table (if any)
(defvar org-index--occur-follow-mode nil) ; True, if follow mode in occur-buffer is on
(setq org-index--commands '(occur head ref link leave put enter goto help + reorder fill sort update highlight unhighlight missing statistics)) ; list of commands available
(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
(defun org-index (&optional ARG)
"Mark and find your favorite things and org-locations easily:
@ -185,7 +191,7 @@ References are essentially small numbers (e.g. \"R237\" or \"-455-\"),
which are created by this package; they are well suited to be used
outside of org. Links are normal org-mode links.
This is version 2.4.0 of org-index.
This is version 2.4.3 of org-index.
The function `org-index' operates on a dedicated table, the index
table, which lives within its own Org-mode node. The table and
@ -224,10 +230,6 @@ Commands known:
list of words seperated by space or comma (\",\"), to select
lines that contain all of the given words.
If you supply a number (e.g. \"237\"): Apply emacs standard
multi-occur operation on all org-mode buffers to search for
this specific reference.
You may also read the note at the end of this help on saving
the keystroke RET with this frequent default command.
@ -278,6 +280,9 @@ Commands known:
update: For the given reference, update the line in the
index table, i.e. increment its count.
multi-occur: Apply emacs standard multi-occur operation on all
org-mode buffers to search for the given reference.
highlight: Highlight references in active region or buffer.
unhighlight: Remove those highlights.
@ -393,10 +398,6 @@ command \"head\" for reference \"237\".
(setq what 'enter)
(setq what-adjusted t))
;; For a proper reference as input, we do multi-occur
(if (and (eq what 'occur) search-ref)
(setq what 'multi-occur))
;; Check for invalid combinations of arguments; try to be helpful
(when (and (memq what '(head goto))
(not search-ref)
@ -443,9 +444,13 @@ command \"head\" for reference \"237\".
;; Sort and align
(org-index--sort reorder-once)
(org-index--align))
(org-index--align)
;; Return to initial position
;; Remember position for leave
(if org-index--point-before
(setq org-index--point-saved org-index--point-before)))
;; prepare to return to initial position in index table
(when initial-ref-or-link
(while (and (org-at-table-p)
(not (or
@ -526,15 +531,15 @@ command \"head\" for reference \"237\".
(org-mark-ring-goto))
;; Return to saved position in index buffer
(when org-index--point-before
(when org-index--point-saved
;; buffer displayed in window need to set point there first
(if (eq (window-buffer org-index--active-window-index)
org-index--buffer)
(set-window-point org-index--active-window-index org-index--point-before))
(set-window-point org-index--active-window-index (marker-position org-index--point-saved)))
;; set position in buffer in any case and second
(with-current-buffer org-index--buffer
(goto-char org-index--point-before)))
(setq org-index--point-before nil))
(goto-char org-index--point-saved)))
(setq org-index--point-saved nil))
((eq what 'goto)
@ -1026,7 +1031,8 @@ retrieves the value of the count-column for reference 12.
(unless search
;; Search string can come from several sources:
;; From link or ref columns of table
(when org-index--within-node
(when (and org-index--within-node
(org-at-table-p))
(setq search-from-table (or (org-index--get-field :link)
(org-index--get-field :ref))))
@ -1085,16 +1091,16 @@ retrieves the value of the count-column for reference 12.
;; Check id
(unless org-index-id
(setq org-index-id (org-index--create-new-index
t
(format "No index table has been created yet." org-index-id))))
(org-index--create-new-index
t
(format "No index table has been created yet." org-index-id)))
;; Find node
(let (marker)
(setq marker (org-id-find org-index-id 'marker))
(unless marker (setq org-index-id (org-index--create-new-index
t
(format "Cannot find node with id \"%s\"" org-index-id))))
(unless marker (org-index--create-new-index
t
(format "Cannot find node with id \"%s\"" org-index-id)))
; Try again with new node
(setq marker (org-id-find org-index-id 'marker))
(unless marker (error "Could not create node"))
@ -1121,9 +1127,10 @@ retrieves the value of the count-column for reference 12.
;; get current position in index-buffer
(with-current-buffer org-index--buffer
(unless (string= (org-id-get) org-index-id)
(unless org-index--point-before
(setq org-index--point-before (point))))))
(setq org-index--point-before
(if (string= (org-id-get) org-index-id)
nil
(point-marker)))))
(defun org-index--parse-table ()
@ -1555,7 +1562,6 @@ retrieves the value of the count-column for reference 12.
You can add further columns or even remove the last column. All
other columns are required.
Finally: This node needs not be a top level node; its name is
completely at you choice; it is found through its ID only.
@ -1576,15 +1582,15 @@ retrieves the value of the count-column for reference 12.
(org-show-context)
(show-subtree)
(recenter 1)
(if (y-or-n-p "This is your new index table; Do you want to save its id to make it permanent ? ")
(setq org-index-id id)
(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 ? ")
(progn
(customize-save-variable 'org-index-id id)
(message "Saved org-index-id '%s' to %s" org-index-id custom-file))
(error "Saved org-index-id '%s' to %s" id custom-file))
(let (sq)
(setq sq (format "(setq org-index-id \"%s\")" org-index-id))
(setq sq (format "(setq org-index-id \"%s\")" id))
(kill-new sq)
(message "Did not make the id of the new index permamanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq))
id))
(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))))
;; we had an error with the existing index table, so present old
;; and new one together
;; show existing index
@ -1606,9 +1612,8 @@ retrieves the value of the count-column for reference 12.
(defun org-index--update-line (ref-or-link)
(let (initial
found
count-field)
(let ((newcount 0)
initial)
(with-current-buffer org-index--buffer
(unless buffer-read-only
@ -1624,33 +1629,34 @@ retrieves the value of the count-column for reference 12.
(if (not (org-at-table-p))
(error "Did not find reference or link '%s'" ref-or-link)
(setq count-field (org-index--get-field :count))
(org-index--update-current-line))
;; update count field only if number or empty; leave :missing: and :reuse: as is
(if (or (not count-field)
(string-match "^[0-9]+$" count-field))
(org-index--get-field :count
(number-to-string
(+ 1 (string-to-number (or count-field "0"))))))
(if initial (goto-char initial))))))
;; update timestamp
(org-table-goto-column (org-index--column-num :last))
(org-table-blank-field)
(org-insert-time-stamp nil t t)
(setq found t))
(defun org-index--update-current-line ()
(let (newcount (count-field (org-index--get-field :count)))
(if initial (goto-char initial))
;; update count field only if number or empty; leave :missing: and :reuse: as is
(when (or (not count-field)
(string-match "^[0-9]+$" count-field))
(setq newcount (+ 1 (string-to-number (or count-field "0"))))
(org-index--get-field :count
(number-to-string newcount)))
found))))
;; update timestamp
(org-table-goto-column (org-index--column-num :last))
(org-table-blank-field)
(org-insert-time-stamp nil t t)))
(defun org-index--get-field (key &optional value)
(let (field)
(setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))
(if (string= field "") (setq field nil))
(save-excursion
(setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))
(if (string= field "") (setq field nil))
(org-no-properties field)))
(org-no-properties field))))
(defun org-index--column-num (key)
@ -1741,8 +1747,6 @@ retrieves the value of the count-column for reference 12.
(org-index--update-line link)
(org-id-goto link)
(org-reveal)
(if (eq (current-buffer) org-index--buffer)
(setq org-index--point-before nil))
(setq message-text "Followed link"))
(message (format "Scanning headlines for '%s' ..." ref))
@ -1768,8 +1772,6 @@ retrieves the value of the count-column for reference 12.
nil))
(progn
(if (eq buffer org-index--buffer)
(setq org-index--point-before nil))
(setq message-text (format "Found '%s'" (or ref link)))
(if other
(progn
@ -1791,7 +1793,8 @@ retrieves the value of the count-column for reference 12.
(word "") ; last word to search for growing and shrinking on keystrokes
(prompt "Search for: ")
(hint "")
words ; list of other words that must match too
(key-help "<up>, <down> move. <return> finds node, <S-return> goes to table, <M-return> updates count. TAB finds in other window.\n")
words ; list of other words that must match too
occur-buffer
lines-to-show ; number of lines to show in window
start-of-lines ; position, where lines begin
@ -1805,6 +1808,8 @@ retrieves the value of the count-column for reference 12.
in-c-backspace ; true while processing C-backspace
show-headings ; true, if headings should be shown
fun-on-ret ; function to be executed, if return is pressed
fun-on-s-ret ; shift
fun-on-m-ret ; shift
fun-on-tab ; function to be executed, if letter TAB is pressed
ret from to key)
@ -1819,16 +1824,29 @@ retrieves the value of the count-column for reference 12.
(set-keymap-parent keymap org-mode-map)
(setq fun-on-ret (lambda () (interactive) (org-index--occur-find-heading nil)))
(define-key keymap (kbd "RET") fun-on-ret)
(define-key keymap [return] fun-on-ret)
(setq fun-on-s-ret (lambda () (interactive)
(when (org-at-table-p)
(org-table-goto-column (org-index--column-num :ref))
(org-index 'goto))))
(define-key keymap [S-return] fun-on-s-ret)
(setq fun-on-m-ret (lambda () (interactive)
(when (org-at-table-p)
(org-index--update-current-line)
(org-table-align)
(org-table-goto-column (org-index--column-num :count))
(message (format "New count is %s" (org-trim (org-table-get-field))))
(org-index--update-line (org-index--get-field :ref)))))
(define-key keymap [M-return] fun-on-m-ret)
(setq fun-on-tab (lambda () (interactive)
(org-index--occur-find-heading t)
(setq org-index--occur-follow-mode (not org-index--occur-follow-mode))))
(define-key keymap (kbd "<tab>") fun-on-tab)
(define-key keymap [tab] fun-on-tab)
(define-key keymap [(control ?i)] fun-on-tab)
(define-key keymap (kbd "<up>") (lambda () (interactive)
(define-key keymap [up] (lambda () (interactive)
(forward-line -1)
(if org-index--occur-follow-mode (org-index--occur-find-heading t))))
(define-key keymap (kbd "<down>") (lambda () (interactive)
(define-key keymap [down] (lambda () (interactive)
(forward-line 1)
(if org-index--occur-follow-mode (org-index--occur-find-heading t))))
(use-local-map keymap)))
@ -1849,14 +1867,13 @@ retrieves the value of the count-column for reference 12.
;; fill in header
(erase-buffer)
(insert (concat "Incremental search, showing one window of matches. '?' toggles help.\n\n"))
(setq start-of-lines (point))
(setq start-of-lines (point-marker))
(setq start-of-help start-of-lines)
(setq cursor-type 'hollow)
;; get window size of occur-buffer as number of lines to be searched
(setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1))
;; fill initially
(setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol))
(when (nth 0 ret)
@ -1887,7 +1904,7 @@ retrieves the value of the count-column for reference 12.
(if (string= search-text "") "" " ")
hint))))
(setq hint "")
(setq exit-gracefully (member key (list 'up 'down 'left 'right 'RET ?\C-g ?\C-m 'C-return ?\C-i 'TAB)))))
(setq exit-gracefully (member key (list 'up 'down 'left 'right 'RET ?\C-g ?\C-m 'C-return 'S-return ?\C-i 'TAB)))))
(not exit-gracefully))
@ -1960,21 +1977,23 @@ retrieves the value of the count-column for reference 12.
(setq word ""))
((eq key ??) ; tab: toggle display of headlines and help
((eq key ??) ; question mark: toggle display of headlines and help
(setq show-headings (not show-headings))
(goto-char start-of-lines)
(if show-headings
(progn
(forward-line -1)
(kill-line)
(setq start-of-help (point))
(if (display-graphic-p)
(insert "<backspace> and <c-backspace> erase, cursor keys move. RET finds node, C-RET all matches.\nTAB finds in other window. Comma seperates words, any other key adds to search word.\n\n")
(insert "BACKSPACE to erase, to finish. Then cursor keys and RET to find node.\n\n"))
; (kill-line)
(setq start-of-help (point-marker))
(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. ")
(insert key-help)
(goto-char start-of-help)
(fill-paragraph)
(goto-char start-of-lines)
(insert org-index--headings))
(delete-region start-of-help start-of-lines)
(insert "\n"))
(setq start-of-lines (point)))
(insert "\n\n"))
(setq start-of-lines (point-marker)))
((and (integerp key)
@ -2038,7 +2057,7 @@ retrieves the value of the count-column for reference 12.
(forward-line 1)))
;; get all the rest
(when (eq key (kbd "<c-return>"))
(when (eq key 'C-return)
(message "Getting all matches ...")
(setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at)))
(message "done.")
@ -2052,15 +2071,18 @@ retrieves the value of the count-column for reference 12.
(delete-region (point-min) (point))
(insert (format (concat (if exit-gracefully "Search is done;" "Search aborted;")
(if (or at-end (eq key 'C-return))
" showing all %d matches."
" showing only some matches.")
" Use cursor keys to move, press RET or TAB to find node.\n\n")
" showing all %d matches. "
" showing only some matches. ")
key-help)
numlines))
(insert "\n")
(setq start-of-lines (point-marker))
(goto-char (point-min))
(fill-paragraph)
(goto-char start-of-lines)
(if show-headings (insert "\n\n" org-index--headings)))
(forward-line))
(setq buffer-read-only t)
;; perform action according to last char
(forward-line -1)
(cond
@ -2077,11 +2099,12 @@ retrieves the value of the count-column for reference 12.
((eq key 'down)
(forward-line 1))
((eq key 'left)
(forward-char -1))
((eq key 'M-return)
(funcall fun-on-m-ret))
((eq key 'S-return)
(funcall fun-on-s-ret)))))
((eq key 'right)
(forward-char 1)))))
(defun org-index--occur-find-heading (x)
"helper for keymap of occur"
@ -2168,35 +2191,12 @@ retrieves the value of the count-column for reference 12.
(let ((found-all t))
(setq line (downcase line))
(catch 'not-found
(dolist (w words)
(or (search w line)
(throw 'not-found nil)))
t)))
(dolist (w words)
(or (search w line)
(throw 'not-found nil)))
t)))
(defun org-index--dump-variables ()
"Dump variables of org-index; mostly for debugging"
(interactive)
"Dump all variables of org-index for debugging"
(let ((buff (get-buffer-create "*org-index-dump-variables*"))
(maxlen 0)
vars name value)
(with-current-buffer buff
(erase-buffer)
(mapatoms (lambda (s) (when (and (boundp s)
(string-prefix-p "org-index-" (symbol-name s)))
(setq name (symbol-name s))
(setq value (symbol-value s))
(setq vars (cons (cons name value) vars))
(if (> (length name) maxlen)
(setq maxlen (length name))))))
(setq vars (sort vars (lambda (x y) (string< (car x) (car y)))))
(mapc (lambda (x) (insert (format (format "%%-%ds: %%s\n" (+ maxlen 1)) (car x) (cdr x))))
vars)
(pop-to-buffer buff))))
(defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate)
"Make text from org-index available for yank."