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.
This commit is contained in:
Nicolas Goaziou
parent
a4ad618f62
commit
099d84c76d
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue