diff options
author | Marc Ihm <marc@ihm.name> | 2018-02-06 20:52:23 +0100 |
---|---|---|
committer | Marc Ihm <marc@ihm.name> | 2018-02-06 20:52:23 +0100 |
commit | 7276466c4ec43cd82ef1845175c98fa81e689f64 (patch) | |
tree | 9e91ec171d82c93f35b6c09f4e11a0cc072c592f | |
parent | 3558e6e835e39c5e5479ff3ed8bc0f65807ef23e (diff) | |
download | org-mode-7276466c4ec43cd82ef1845175c98fa81e689f64.tar.gz |
patchlevel for org-index.el
-rw-r--r-- | contrib/lisp/org-index.el | 186 |
1 files changed, 110 insertions, 76 deletions
diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el index 853c431..9b430f2 100644 --- a/contrib/lisp/org-index.el +++ b/contrib/lisp/org-index.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2011-2018 Free Software Foundation, Inc. ;; Author: Marc Ihm <org-index@2484.de> -;; Version: 5.7.4 +;; Version: 5.7.5 ;; Keywords: outlines index ;; This file is not part of GNU Emacs. @@ -73,7 +73,7 @@ ;; Updates: ;; ;; The latest published version of this file can always be found at: -;; https://orgmode.org/w/?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD +;; http://orgmode.org/w/?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD ;; Development version under: ;; https://github.com/marcIhm/org-index ;; @@ -97,7 +97,7 @@ (require 'widget) ;; Version of this package -(defvar org-index-version "5.7.4" "Version of `org-index', format is major.minor.bugfix, where \"major\" are incompatible changes and \"minor\" are new features.") +(defvar org-index-version "5.7.5" "Version of `org-index', format is major.minor.bugfix, where \"major\" are incompatible changes and \"minor\" are new features.") ;; customizable options (defgroup org-index nil @@ -258,7 +258,7 @@ those pieces." (defvar org-index--context-node nil "Buffer and position for node in edit buffer.") (defvar org-index--short-help-buffer-name "*org-index commands*" "Name of buffer to display short help.") (defvar org-index--news-buffer-name "*org-index news*" "Name of buffer to display news.") -(defvar org-index--display-short-help nil "True, if short help should be displayed.") +(defvar org-index--short-help-wanted nil "True, if short help should be displayed.") (defvar org-index--short-help-displayed nil "True, if short help message has been displayed.") (defvar org-index--prefix-arg nil "True, if prefix argument has been received during input.") (defvar org-index--minibuffer-saved-key nil "Temporarily save entry of minibuffer keymap.") @@ -321,7 +321,7 @@ for its index table. To start building up your index, use subcommands 'add', 'ref' and 'yank' to create entries and use 'occur' to find them. -This is version 5.7.4 of org-index.el. +This is version 5.7.5 of org-index.el. The function `org-index' is the only interactive function of this @@ -400,7 +400,7 @@ of subcommands to choose from: Operates on active region or whole buffer. Call with prefix argument (`C-u') to remove highlights. - maintain: Index maintainance. + maintain: [m] Index maintainance. Offers some choices to check, update or fix your index. If you invoke `org-index' for the first time, an assistant will be @@ -472,10 +472,10 @@ interactive calls." command (mapconcat 'symbol-name org-index--commands ","))) ;; read command; if requested display help in read-loop - (setq org-index--display-short-help (eq command 'short-help)) + (setq org-index--short-help-wanted (eq command 'short-help)) (setq command (org-index--read-command)) (if org-index--prefix-arg (setq arg (or arg '(4)))) - (setq org-index--display-short-help nil)) + (setq org-index--short-help-wanted nil)) (setq org-index--last-command org-index--this-command) (setq org-index--this-command command) @@ -876,7 +876,7 @@ Optional argument ARG is passed on." (let (char command (c-u-text (if arg " C-u " ""))) (while (not char) (if (sit-for 1) - (message (concat "org-index (? for detailed prompt) -" c-u-text))) + (message (concat "org-index (<space> or ? for detailed prompt) -" c-u-text))) (setq char (key-description (read-key-sequence nil))) (if (string= char "C-g") (keyboard-quit)) (if (string= char "SPC") (setq char "?")) @@ -889,9 +889,8 @@ Optional argument ARG is passed on." (setq char nil))) (setq command (cdr (assoc char (org-index--get-shortcut-chars)))) (unless command - (message "No subcommand for '%s'; switching to detailed prompt" char) - (sit-for 1) - (setq command 'short-help)) + (when (yes-or-no-p (format "No subcommand for '%s'; switch to detailed prompt ? " char)) + (setq command 'short-help))) (org-index command nil arg))) @@ -935,7 +934,7 @@ Optional argument KEYS-VALUES specifies content of new line." (completing-read (concat "Please choose" - (if org-index--display-short-help "" " (? for short help)") + (if org-index--short-help-wanted "" " (<space> or ? for short help)") ": ") (append (mapcar 'symbol-name org-index--commands) (mapcar 'upcase-initials (mapcar 'symbol-name org-index--commands))) @@ -958,7 +957,7 @@ Optional argument KEYS-VALUES specifies content of new line." (local-set-key (kbd "C-u") (lambda () (interactive) (setq org-index--prefix-arg t) (message "C-u"))) - (if org-index--display-short-help (org-index--display-short-help))) + (if org-index--short-help-wanted (org-index--display-short-help))) (defun org-index--minibuffer-exit-function () @@ -968,18 +967,19 @@ Optional argument KEYS-VALUES specifies content of new line." (setq org-index--minibuffer-saved-key nil)) -(defun org-index--display-short-help () - "Helper function to show help in minibuffer." +(defun org-index--display-short-help (&optional prompt choices) + "Helper function to show help for minibuffer." (interactive) (with-temp-buffer-window org-index--short-help-buffer-name nil nil (setq org-index--short-help-displayed t) - (princ "Short help; shortcuts in []; capital letter acts like C-u.\n") - (princ (org-index--get-short-help-text))) + (princ (or prompt "Short help; shortcuts in []; capital letter acts like C-u.\n")) + (princ (or choices (org-index--get-short-help-text)))) (with-current-buffer org-index--short-help-buffer-name (let ((inhibit-read-only t)) - (shrink-window-if-larger-than-buffer (get-buffer-window)) + (fit-window-to-buffer (get-buffer-window)) + (setq window-size-fixed 'height) (goto-char (point-min)) (end-of-line) (goto-char (point-min))))) @@ -1725,14 +1725,27 @@ Optional argument NO-INC skips automatic increment on maxref." (defun org-index--do-maintain () "Choose among and perform some tasks to maintain index." - (let ((check-what) (max-mini-window-height 1.0) message-text) - (setq check-what (intern (org-completing-read "These checks and fixes are available:\n - statistics : compute statistics about index table\n - check : check ids by visiting their nodes\n - duplicates : check index for duplicate rows (ref or id)\n - clean : remove obsolete property org-index-id\n - update : update content of index lines, with an id \nPlease choose: " (list "statistics" "check" "duplicates" "clean" "update") nil t nil nil "statistics"))) + (let ((max-mini-window-height 1.0) + message-text choices choices-short check-what) + + (setq choices (list "statistics : compute statistics about index table\n" + "verify : verify ids by visiting their nodes\n" + "duplicates : check index for duplicate refs or ids\n" + "max : compute and check maximum ref\n" + "clean : remove obsolete property org-index-id\n" + "update : update content of index lines having an id\n")) + + (org-index--display-short-help "These checks and fixes are available:\n" (apply 'concat choices)) + + (setq choices-short (mapcar (lambda (x) (first (split-string x))) choices)) + (setq check-what (intern (org-completing-read "Please choose: " choices-short nil t nil nil (first choices-short)))) + (quit-windows-on org-index--short-help-buffer-name) + (message nil) (cond - ((eq check-what 'check) - (setq message-text (or (org-index--check-ids) - "No problems found"))) + ((eq check-what 'verify) + (setq message-text (org-index--verify-ids))) ((eq check-what 'statistics) (setq message-text (org-index--do-statistics))) @@ -1753,7 +1766,10 @@ Optional argument NO-INC skips automatic increment on maxref." ((eq check-what 'update) (if (y-or-n-p "Updating your index will overwrite certain columns with content from the associated heading and category. If unsure, you may try this for a single, already existing line of your index by invoking `add'. Are you SURE to proceed for ALL INDEX LINES ? ") (setq message-text (org-index--update-all-lines)) - (setq message-text "Canceled.")))) + (setq message-text "Canceled"))) + + ((eq check-what 'max) + (setq message-text (org-index--check-maximum)))) message-text)) @@ -2300,19 +2316,25 @@ Optional argument NO-ERROR suppresses error." (goto-char org-index--below-hline) (if (or ref-duplicates id-duplicates) (progn - ;; show results (pop-to-buffer-same-window (get-buffer-create "*org-index-duplicates*")) - (when ref-duplicates - (insert "These references appear more than once:\n") - (mapc (lambda (x) (insert " " x "\n")) ref-duplicates) - (insert "\n\n")) - (when id-duplicates - (insert "These ids appear more than once:\n") - (mapc (lambda (x) (insert " " x "\n")) id-duplicates)) + (erase-buffer) + (insert "\n") + (if ref-duplicates + (progn + (insert " These references appear more than once:\n") + (mapc (lambda (x) (insert " " x "\n")) ref-duplicates) + (insert "\n\n")) + (insert " No references appear more than once.\n")) + (if id-duplicates + (progn + (insert " These ids appear more than once:\n") + (mapc (lambda (x) (insert " " x "\n")) id-duplicates)) + (insert " No ids appear more than once.")) + (insert "\n") - "Some references or ids are duplicates") - "No duplicate references or ids found"))) + "Some references or ids are duplicate") + "No duplicate references or ids found"))) (defun org-index--find-duplicates-helper (column) @@ -2341,6 +2363,31 @@ Optional argument NO-ERROR suppresses error." duplicates)) +(defun org-index--check-maximum () + "Check maximum reference." + (let (ref-field ref-num (max 0) (max-prop)) + + (goto-char org-index--below-hline) + (setq max-prop (org-index--extract-refnum (org-entry-get org-index--point "max-ref"))) + + (while (org-at-table-p) + + (setq ref-field (org-index--get-or-set-field 'ref)) + (setq ref-num (if ref-field (org-index--extract-refnum ref-field) 0)) + + (if (> ref-num max) (setq max ref-num)) + + (forward-line)) + + (goto-char org-index--below-hline) + + (cond ((< max-prop max) + (format "Maximum ref from property max-ref (%d) is smaller than maximum ref from table (%d); you should correct this" max-prop max)) + ((> max-prop max) + (format "Maximum ref from property max-ref (%d) is larger than maximum ref from table (%d); you may correct this" max-prop max)) + (t (format "Maximum ref from property max-ref and maximum ref from table are equal (%d); as expected" max-prop))))) + + (defun org-index--do-statistics () "Compute statistics about index table." (let ((total-lines 0) (total-refs 0) @@ -2455,36 +2502,28 @@ CREATE-REF and TAG-WITH-REF if given." ret)) -(defun org-index--check-ids () +(defun org-index--verify-ids () "Check, that ids really point to a node." - (let ((lines 0) - id ids marker) + (let ((lines 0) (marker t) id) (goto-char org-index--below-hline) - (catch 'problem - (while (org-at-table-p) - - (when (setq id (org-index--get-or-set-field 'id)) - - ;; check for double ids - (when (member id ids) - (org-table-goto-column (org-index--column-num 'id)) - (throw 'problem "This id appears twice in index; please use command 'maintain' to check for duplicate ids")) - (cl-incf lines) - (setq ids (cons id ids)) - - ;; check, if id is valid - (setq marker (org-id-find id t)) - (unless marker - (org-table-goto-column (org-index--column-num 'id)) - (throw 'problem "This id cannot be found"))) - - (forward-line)) + (while (and marker (org-at-table-p)) - (goto-char org-index--below-hline) - nil))) + (when (setq id (org-index--get-or-set-field 'id)) + + ;; check, if id is valid + (setq marker (org-id-find id t))) + + (when marker (forward-line))) + + (if marker + (progn + (goto-char org-index--below-hline) + "All ids of index are valid") + (org-table-goto-column 1) + "The id of this row cannot be found; please fix and check again for rest of index"))) (defun org-index--update-all-lines () @@ -2493,24 +2532,19 @@ CREATE-REF and TAG-WITH-REF if given." (let ((lines 0) id kvs) - ;; check for double ids - (or - (org-index--check-ids) - - (progn - (goto-char org-index--below-hline) - (while (org-at-table-p) + (goto-char org-index--below-hline) + (while (org-at-table-p) - ;; update single line - (when (setq id (org-index--get-or-set-field 'id)) - (setq kvs (org-index--collect-values-for-add-update-remote id)) - (org-index--write-fields kvs) - (cl-incf lines)) - (forward-line)) - - (goto-char org-index--below-hline) - (org-table-align) - (format "Updated %d lines" lines))))) + ;; update single line + (when (setq id (org-index--get-or-set-field 'id)) + (setq kvs (org-index--collect-values-for-add-update-remote id)) + (org-index--write-fields kvs) + (cl-incf lines)) + (forward-line)) + + (goto-char org-index--below-hline) + (org-table-align) + (format "Updated %d lines" lines))) (defun org-index--collect-values-for-add-update (id &optional silent category) |