Browse Source

Fix bugs with ellipsis generation in column view.

Ellipsis generation can now be controlled with `org-columns-ellipses'.
Carsten Dominik 17 years ago
parent
commit
2f60e2b921
4 changed files with 53 additions and 32 deletions
  1. 4 0
      lisp/ChangeLog
  2. 21 14
      lisp/org-colview-xemacs.el
  3. 17 18
      lisp/org-colview.el
  4. 11 0
      lisp/org.el

+ 4 - 0
lisp/ChangeLog

@@ -1,3 +1,7 @@
+2008-05-30  Carsten Dominik  <dominik@science.uva.nl>
+
+	* org.el (org-columns-ellipses): New option.
+
 2008-05-29  Carsten Dominik  <dominik@science.uva.nl>
 2008-05-29  Carsten Dominik  <dominik@science.uva.nl>
 
 
 	* org-colview.el (org-columns-add-ellipses): New function.
 	* org-colview.el (org-columns-add-ellipses): New function.

+ 21 - 14
lisp/org-colview-xemacs.el

@@ -314,7 +314,7 @@ This is the compiled version of the format.")
 				  (get-text-property (point-at-bol) 'face))
 				  (get-text-property (point-at-bol) 'face))
 			     'default) :foreground))))
 			     'default) :foreground))))
 	 (face (if (featurep 'xemacs) color (list color 'org-column)))
 	 (face (if (featurep 'xemacs) color (list color 'org-column)))
-	 (pl (get-text-property (point-at-bol) 'prefix-length))
+	 (pl (or (get-text-property (point-at-bol) 'prefix-length) 0))
 	 (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
 	 (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
 	 pom property ass width f string ov column val modval s1 s2)
 	 pom property ass width f string ov column val modval s1 s2)
     ;; Check if the entry is in another buffer.
     ;; Check if the entry is in another buffer.
@@ -394,9 +394,10 @@ This is the compiled version of the format.")
   "Truncate STRING with WIDTH characters, with ellipses."
   "Truncate STRING with WIDTH characters, with ellipses."
   (cond 
   (cond 
    ((<= (length string) width) string)
    ((<= (length string) width) string)
-   ((= width 1) ".")
-   ((= width 2) "..")
-   (t (concat (substring string 0 (- width 2)) ".."))))
+   ((<= width (length org-columns-ellipses))
+    (substring org-columns-ellipses 0 width))
+   (t (concat (substring string 0 (- width (length org-columns-ellipses)))
+	      org-columns-ellipses))))
 
 
 (defvar org-columns-full-header-line-format nil
 (defvar org-columns-full-header-line-format nil
   "Fthe full header line format, will be shifted by horizontal scrolling." )
   "Fthe full header line format, will be shifted by horizontal scrolling." )
@@ -480,14 +481,19 @@ This is the compiled version of the format.")
   (if (not org-complex-heading-regexp)
   (if (not org-complex-heading-regexp)
       item
       item
     (when (string-match org-complex-heading-regexp item)
     (when (string-match org-complex-heading-regexp item)
-      (concat
-       (org-add-props (concat (match-string 1 item) " ") nil
-	 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
-       (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
-       (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
-       " " (save-match-data (org-columns-compact-links (match-string 4 item)))
-       (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))))
-
+      (setq item
+	    (concat
+	     (org-add-props (match-string 1 item) nil
+	       'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+	     (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
+	     (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
+	     " " (save-match-data (org-columns-compact-links (match-string 4 item)))
+	     (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
+      (add-text-properties
+       0 (1+ (match-end 1))
+       (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+       item)
+      item)))
 
 
 (defun org-columns-compact-links (s)
 (defun org-columns-compact-links (s)
   "Replace [[link][desc]] with [desc] or [link]."
   "Replace [[link][desc]] with [desc] or [link]."
@@ -641,7 +647,8 @@ Where possible, use the standard interface for changing this line."
   "Edit the current headline, the part without TODO keyword, TAGS."
   "Edit the current headline, the part without TODO keyword, TAGS."
   (org-back-to-heading)
   (org-back-to-heading)
   (when (looking-at org-todo-line-regexp)
   (when (looking-at org-todo-line-regexp)
-    (let ((pre (buffer-substring (match-beginning 0) (match-beginning 3)))
+    (let ((pos (point))
+	  (pre (buffer-substring (match-beginning 0) (match-beginning 3)))
 	  (txt (match-string 3))
 	  (txt (match-string 3))
 	  (post "")
 	  (post "")
 	  txt2)
 	  txt2)
@@ -650,7 +657,7 @@ Where possible, use the standard interface for changing this line."
 		txt (substring txt 0 (match-beginning 0))))
 		txt (substring txt 0 (match-beginning 0))))
       (setq txt2 (read-string "Edit: " txt))
       (setq txt2 (read-string "Edit: " txt))
       (when (not (equal txt txt2))
       (when (not (equal txt txt2))
-	(beginning-of-line 1)
+	(goto-char pos)
 	(insert pre txt2 post)
 	(insert pre txt2 post)
 	(delete-region (point) (point-at-eol))
 	(delete-region (point) (point-at-eol))
 	(org-set-tags nil t)))))
 	(org-set-tags nil t)))))

+ 17 - 18
lisp/org-colview.el

@@ -139,7 +139,7 @@ This is the compiled version of the format.")
 		       'default))
 		       'default))
 	 (color (list :foreground (face-attribute ref-face :foreground)))
 	 (color (list :foreground (face-attribute ref-face :foreground)))
 	 (face (list color 'org-column ref-face))
 	 (face (list color 'org-column ref-face))
-	 (pl (get-text-property (point-at-bol) 'prefix-length))
+	 (pl (or (get-text-property (point-at-bol) 'prefix-length) 0))
 	 (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
 	 (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
 	 pom property ass width f string ov column val modval s1 s2)
 	 pom property ass width f string ov column val modval s1 s2)
     ;; Check if the entry is in another buffer.
     ;; Check if the entry is in another buffer.
@@ -204,14 +204,6 @@ This is the compiled version of the format.")
 			  (min (point-max) (1+ (point-at-eol)))
 			  (min (point-max) (1+ (point-at-eol)))
 			  'read-only "Type `e' to edit property")))))
 			  'read-only "Type `e' to edit property")))))
 
 
-(defun org-columns-add-ellipses (string width)
-  "Truncate STRING with WIDTH characters, with ellipses."
-  (cond 
-   ((<= (length string) width) string)
-   ((= width 1) ".")
-   ((= width 2) "..")
-   (t (concat (substring string 0 (- width 2)) ".."))))
-
 (defvar org-columns-full-header-line-format nil
 (defvar org-columns-full-header-line-format nil
   "Fthe full header line format, will be shifted by horizontal scrolling." )
   "Fthe full header line format, will be shifted by horizontal scrolling." )
 (defvar org-previous-header-line-format nil
 (defvar org-previous-header-line-format nil
@@ -287,13 +279,19 @@ for the duration of the command.")
   (if (not org-complex-heading-regexp)
   (if (not org-complex-heading-regexp)
       item
       item
     (when (string-match org-complex-heading-regexp item)
     (when (string-match org-complex-heading-regexp item)
-      (concat
-       (org-add-props (concat (match-string 1 item) " ") nil
-	 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
-       (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
-       (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
-       " " (save-match-data (org-columns-compact-links (match-string 4 item)))
-       (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))))
+      (setq item
+	    (concat
+	     (org-add-props (match-string 1 item) nil
+	       'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+	     (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
+	     (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
+	     " " (save-match-data (org-columns-compact-links (match-string 4 item)))
+	     (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
+      (add-text-properties
+       0 (1+ (match-end 1))
+       (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+       item)
+      item)))
 
 
 (defun org-columns-compact-links (s)
 (defun org-columns-compact-links (s)
   "Replace [[link][desc]] with [desc] or [link]."
   "Replace [[link][desc]] with [desc] or [link]."
@@ -444,7 +442,8 @@ Where possible, use the standard interface for changing this line."
   "Edit the current headline, the part without TODO keyword, TAGS."
   "Edit the current headline, the part without TODO keyword, TAGS."
   (org-back-to-heading)
   (org-back-to-heading)
   (when (looking-at org-todo-line-regexp)
   (when (looking-at org-todo-line-regexp)
-    (let ((pre (buffer-substring (match-beginning 0) (match-beginning 3)))
+    (let ((pos (point))
+	  (pre (buffer-substring (match-beginning 0) (match-beginning 3)))
 	  (txt (match-string 3))
 	  (txt (match-string 3))
 	  (post "")
 	  (post "")
 	  txt2)
 	  txt2)
@@ -453,7 +452,7 @@ Where possible, use the standard interface for changing this line."
 		txt (substring txt 0 (match-beginning 0))))
 		txt (substring txt 0 (match-beginning 0))))
       (setq txt2 (read-string "Edit: " txt))
       (setq txt2 (read-string "Edit: " txt))
       (when (not (equal txt txt2))
       (when (not (equal txt txt2))
-	(beginning-of-line 1)
+	(goto-char pos)
 	(insert pre txt2 post)
 	(insert pre txt2 post)
 	(delete-region (point) (point-at-eol))
 	(delete-region (point) (point-at-eol))
 	(org-set-tags nil t)))))
 	(org-set-tags nil t)))))

+ 11 - 0
lisp/org.el

@@ -1883,6 +1883,17 @@ This variable can be set on the per-file basis by inserting a line
   :group 'org-properties
   :group 'org-properties
   :type 'string)
   :type 'string)
 
 
+(defcustom org-columns-ellipses ".."
+  "The ellipses to be used when a field in column view is truncated.
+When this is the empty string, as many characters as possible are shown,
+but then there will be no visual indication that the field has been truncated.
+When this is a string of length N, the last N characters of a truncated
+field are replaced by this string.  If the column is narrower than the
+ellipses string, only part of the ellipses string will be shown."
+  :group 'org-properties
+  :type 'string)
+
+
 (defcustom org-effort-property "Effort"
 (defcustom org-effort-property "Effort"
   "The property that is being used to keep track of effort estimates.
   "The property that is being used to keep track of effort estimates.
 Effort estimates given in this property need to have the format H:MM."
 Effort estimates given in this property need to have the format H:MM."