瀏覽代碼

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.
Nicolas Goaziou 9 年之前
父節點
當前提交
099d84c76d
共有 2 個文件被更改,包括 172 次插入48 次删除
  1. 51 48
      lisp/org-colview.el
  2. 121 0
      testing/lisp/test-org-colview.el

+ 51 - 48
lisp/org-colview.el

@@ -598,8 +598,12 @@ Where possible, use the standard interface for changing this line."
 	   (remove-text-properties
 	   (remove-text-properties
 	    (max (point-min) (1- bol)) eol '(read-only t)))
 	    (max (point-min) (1- bol)) eol '(read-only t)))
 	  (org-columns-eval eval))
 	  (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 ()
 (defun org-columns-edit-allowed ()
   "Edit the list of allowed values for the current property."
   "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."
 an integer, select that value."
   (interactive)
   (interactive)
   (org-columns-check-computed)
   (org-columns-check-computed)
-  (let* ((col (current-column))
+  (let* ((column (current-column))
 	 (key (get-char-property (point) 'org-columns-key))
 	 (key (get-char-property (point) 'org-columns-key))
 	 (value (get-char-property (point) 'org-columns-value))
 	 (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
 	 (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")))
     (unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")))
       (error "Allowed values for this property have not been defined"))
       (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
       (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)
 (defun org-colview-construct-allowed-dates (s)
   "Construct a list of three dates around the date in S.
   "Construct a list of three dates around the date in S.

+ 121 - 0
testing/lisp/test-org-colview.el

@@ -959,6 +959,127 @@
 	    ;; explanation.
 	    ;; explanation.
 	    (org-entry-get (point) "A")))))
 	    (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
 ;;; Dynamic block