diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el index ce53947b8..64974eb13 100644 --- a/contrib/lisp/org-index.el +++ b/contrib/lisp/org-index.el @@ -5,7 +5,7 @@ ;; Author: Marc Ihm ;; 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) + + ;; Remember position for leave + (if org-index--point-before + (setq org-index--point-saved org-index--point-before))) - ;; Return to initial position + ;; 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)) - - ;; 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")))))) - - ;; 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)) + (org-index--update-current-line)) - (if initial (goto-char initial)) - - found)))) + (if initial (goto-char initial)))))) + + +(defun org-index--update-current-line () + (let (newcount (count-field (org-index--get-field :count))) + + ;; 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))) + + ;; 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 ", move. finds node, goes to table, 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 "") fun-on-tab) + (define-key keymap [tab] fun-on-tab) (define-key keymap [(control ?i)] fun-on-tab) - (define-key keymap (kbd "") (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 "") (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,13 +1867,12 @@ 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)) @@ -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 " and 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: 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 "")) + (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."