diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-02-23 18:38:48 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-02-23 22:32:47 +0100 |
commit | 099d84c76d8907ac2d4f24735b803c37af20ba9f (patch) | |
tree | 7418c677eafb1e33dbb20cd53ce3bd91bad1d657 | |
parent | a4ad618f6215e1fc9b601d95cc60434996a0c88c (diff) | |
download | org-mode-099d84c76d8907ac2d4f24735b803c37af20ba9f.tar.gz |
org-colview: Fix editing values altering headings
* lisp/org-colview.el (org-columns-edit-value):
(org-columns-next-allowed-value): Make sure overlays are still in place
when a property altering current headline is modified. Refactor code.
Do not limit allowed values to 10.
* testing/lisp/test-org-colview.el (test-org-colview/columns-next-allowed-value):
New test.
-rw-r--r-- | lisp/org-colview.el | 99 | ||||
-rw-r--r-- | testing/lisp/test-org-colview.el | 121 |
2 files changed, 172 insertions, 48 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 463b4ee..61ffaa7 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -598,8 +598,12 @@ Where possible, use the standard interface for changing this line." (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) (org-columns-eval eval)) - (org-move-to-column col) - (org-columns-update key)))))) + ;; Some properties can modify headline (e.g., "TODO"), and + ;; possible shuffle overlays. Make sure they are still all at + ;; the right place on the current line. + (let ((org-columns-inhibit-recalculation)) (org-columns-redo)) + (org-columns-update key) + (org-move-to-column col)))))) (defun org-columns-edit-allowed () "Edit the list of allowed values for the current property." @@ -643,58 +647,57 @@ When PREVIOUS is set, go to the previous value. When NTH is an integer, select that value." (interactive) (org-columns-check-computed) - (let* ((col (current-column)) + (let* ((column (current-column)) (key (get-char-property (point) 'org-columns-key)) (value (get-char-property (point) 'org-columns-value)) - (bol (point-at-bol)) (eol (point-at-eol)) - (pom (or (get-text-property bol 'org-hd-marker) - (point))) ; keep despite of compiler waring + (pom (or (get-text-property (line-beginning-position) 'org-hd-marker) + (point))) (allowed - (or (org-property-get-allowed-values pom key) - (and (member (nth 3 (assoc key org-columns-current-fmt-compiled)) - '("X" "X/" "X%")) - '("[ ]" "[X]")) - (org-colview-construct-allowed-dates value))) - nval) - (when (integerp nth) - (setq nth (1- nth)) - (if (= nth -1) (setq nth 9))) - (when (equal key "ITEM") - (error "Cannot edit item headline from here")) + (let ((all + (or (org-property-get-allowed-values pom key) + (pcase (nth column org-columns-current-fmt-compiled) + (`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) '("[ ]" "[X]"))) + (org-colview-construct-allowed-dates value)))) + (if previous (reverse all) all)))) + (when (equal key "ITEM") (error "Cannot edit item headline from here")) (unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))) (error "Allowed values for this property have not been defined")) - (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")) - (setq nval (if previous 'earlier 'later)) - (if previous (setq allowed (reverse allowed))) + (let* ((l (length allowed)) + (new + (cond + ((member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")) + (if previous 'earlier 'later)) + ((integerp nth) + (when (> (abs nth) l) + (user-error "Only %d allowed values for property `%s'" l key)) + (nth (mod (1- nth) l) allowed)) + ((member value allowed) + (when (= l 1) (error "Only one allowed value for this property")) + (or (nth 1 (member value allowed)) (car allowed))) + (t (car allowed)))) + (sexp `(org-entry-put ,pom ,key ,new))) (cond - (nth - (setq nval (nth nth allowed)) - (if (not nval) - (error "There are only %d allowed values for property `%s'" - (length allowed) key))) - ((member value allowed) - (setq nval (or (car (cdr (member value allowed))) - (car allowed))) - (if (equal nval value) - (error "Only one allowed value for this property"))) - (t (setq nval (car allowed))))) - (cond - ((equal major-mode 'org-agenda-mode) - (org-columns-eval `(org-entry-put ,pom ,key ,nval)) - ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be updated. - (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) - (buffer (marker-buffer pom)) - (org-agenda-contributing-files - (list (with-current-buffer buffer - (buffer-file-name (buffer-base-buffer)))))) - (org-agenda-columns))) - (t - (let ((inhibit-read-only t)) - (remove-text-properties (max (1- bol) (point-min)) eol '(read-only t)) - (org-columns-eval `(org-entry-put ,pom ,key ,nval))) - (org-move-to-column col) - (org-columns-update key))))) + ((equal major-mode 'org-agenda-mode) + (org-columns-eval sexp) + ;; The following let preserves the current format, and makes + ;; sure that in only a single file things need to be updated. + (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) + (buffer (marker-buffer pom)) + (org-agenda-contributing-files + (list (with-current-buffer buffer + (buffer-file-name (buffer-base-buffer)))))) + (org-agenda-columns))) + (t + (let ((inhibit-read-only t)) + (remove-text-properties (line-end-position 0) (line-end-position) + '(read-only t)) + (org-columns-eval sexp)) + ;; Some properties can modify headline (e.g., "TODO"), and + ;; possible shuffle overlays. Make sure they are still all at + ;; the right place on the current line. + (let ((org-columns-inhibit-recalculation)) (org-columns-redo)) + (org-columns-update key) + (org-move-to-column column)))))) (defun org-colview-construct-allowed-dates (s) "Construct a list of three dates around the date in S. diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el index 922ee08..4010500 100644 --- a/testing/lisp/test-org-colview.el +++ b/testing/lisp/test-org-colview.el @@ -959,6 +959,127 @@ ;; explanation. (org-entry-get (point) "A"))))) +(ert-deftest test-org-colview/columns-next-allowed-value () + "Test `org-columns-next-allowed-value' specifications." + ;; Cannot shift "ITEM" property. + (should-error + (org-test-with-temp-text "* H" + (let ((org-columns-default-format "%ITEM")) (org-columns)) + (org-columns-next-allowed-value))) + ;; Throw an error when allowed values are not defined. + (should-error + (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value))) + ;; Throw an error when there's only one value to select. + (should-error + (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:A_ALL: 1\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value))) + ;; By default select the next allowed value. Where there is no more + ;; value, start again from first possible one. + (should + (equal "2" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 1\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value) + (org-entry-get (point) "A")))) + (should + (equal "3" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value) + (org-entry-get (point) "A")))) + (should + (equal "1" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 3\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value) + (org-entry-get (point) "A")))) + ;; PREVIOUS argument moves backward. + (should + (equal "1" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value 'previous) + (org-entry-get (point) "A")))) + (should + (equal "2" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 3\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value 'previous) + (org-entry-get (point) "A")))) + (should + (equal "3" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 1\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value 'previous) + (org-entry-get (point) "A")))) + ;; Select Nth element with optional argument NTH. + (should + (equal "1" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value nil 1) + (org-entry-get (point) "A")))) + ;; If NTH is negative, go backwards, 0 being the last one and -1 the + ;; penultimate. + (should + (equal "3" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value nil 0) + (org-entry-get (point) "A")))) + (should + (equal "2" + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value nil -1) + (org-entry-get (point) "A")))) + ;; Throw an error if NTH is greater than the number of allowed + ;; values. + (should-error + (org-test-with-temp-text + "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:" + (let ((org-columns-default-format "%A")) (org-columns)) + (org-columns-next-allowed-value nil 4) + (org-entry-get (point) "A"))) + ;; Pathological case: when shifting the value alters the current + ;; heading, make sure all columns are still at their correct + ;; location. + (should + (equal '("H" "" "" "" "TODO") + (let ((org-todo-keywords '((sequence "TODO" "DONE")))) + (org-test-with-temp-text "* H" + (let ((org-columns-default-format "%ITEM %A %B %C %TODO")) + (org-columns) + (forward-char 4) + (org-columns-next-allowed-value) + (list (get-char-property (- (point) 4) 'org-columns-value) + (get-char-property (- (point) 3) 'org-columns-value) + (get-char-property (- (point) 2) 'org-columns-value) + (get-char-property (- (point) 1) 'org-columns-value) + (get-char-property (point) 'org-columns-value))))))) + (should + (equal '("H" "VERYLONGTODO") + (let ((org-todo-keywords '((sequence "TODO" "VERYLONGTODO")))) + (org-test-with-temp-text "* TODO H" + (let ((org-columns-default-format "%ITEM %TODO")) + (org-columns) + (forward-char) + (org-columns-next-allowed-value) + (list (get-char-property (- (point) 1) 'org-columns-value) + (get-char-property (point) 'org-columns-value)))))))) + ;;; Dynamic block |