summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-23 18:38:48 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-23 22:32:47 +0100
commit099d84c76d8907ac2d4f24735b803c37af20ba9f (patch)
tree7418c677eafb1e33dbb20cd53ce3bd91bad1d657
parenta4ad618f6215e1fc9b601d95cc60434996a0c88c (diff)
downloadorg-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.el99
-rw-r--r--testing/lisp/test-org-colview.el121
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