Browse Source

Use ellipses in narrow column-view columns.

Carsten Dominik 17 years ago
parent
commit
19f4b1815e
3 changed files with 76 additions and 13 deletions
  1. 9 1
      lisp/ChangeLog
  2. 41 4
      lisp/org-colview-xemacs.el
  3. 26 8
      lisp/org-colview.el

+ 9 - 1
lisp/ChangeLog

@@ -1,9 +1,17 @@
+2008-05-29  Carsten Dominik  <dominik@science.uva.nl>
+
+	* org-colview.el (org-columns-add-ellipses): New function.
+	(org-columns-compact-links): New function.
+	(org-columns-cleanup-item): Call `org-columns-compact-links'.
+	(org-columns-display-here): Call `org-agenda-columns-cleanup-item'
+	when in agenda.
+
 2008-05-28  Carsten Dominik  <dominik@science.uva.nl>
 2008-05-28  Carsten Dominik  <dominik@science.uva.nl>
 
 
 	* org-agenda.el (org-agenda-columns-remove-prefix-from-item): New
 	* org-agenda.el (org-agenda-columns-remove-prefix-from-item): New
 	option.
 	option.
 
 
-	* org-colview.el (org-agenda-columns-cleanu-item): New function.
+	* org-colview.el (org-agenda-columns-cleanup-item): New function.
 
 
 	* org-exp.el (org-export-ascii-preprocess): Renamed from
 	* org-exp.el (org-export-ascii-preprocess): Renamed from
 	`org-export-ascii-clean-string'.
 	`org-export-ascii-clean-string'.

+ 41 - 4
lisp/org-colview-xemacs.el

@@ -314,7 +314,9 @@ 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)))
-	 pom property ass width f string ov column val modval)
+	 (pl (get-text-property (point-at-bol) 'prefix-length))
+	 (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
+	 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.
     (unless props
     (unless props
       (if (eq major-mode 'org-agenda-mode)
       (if (eq major-mode 'org-agenda-mode)
@@ -335,8 +337,13 @@ This is the compiled version of the format.")
 		      width width)
 		      width width)
 	    val (or (cdr ass) "")
 	    val (or (cdr ass) "")
 	    modval (if (equal property "ITEM")
 	    modval (if (equal property "ITEM")
-		       (org-columns-cleanup-item val org-columns-current-fmt-compiled))
-	    string (format f (or modval val)))
+		       (if (org-mode-p)
+			   (org-columns-cleanup-item
+			    val org-columns-current-fmt-compiled)
+			 (org-agenda-columns-cleanup-item
+			  val pl cphr org-columns-current-fmt-compiled))))
+      (setq s2 (org-columns-add-ellipses (or modval val) width))
+      (setq string (format f s2))
       ;; Create the overlay
       ;; Create the overlay
       (org-unmodified
       (org-unmodified
        (setq ov (org-columns-new-overlay
        (setq ov (org-columns-new-overlay
@@ -383,6 +390,14 @@ 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
@@ -470,9 +485,31 @@ This is the compiled version of the format.")
 	 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
 	 '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 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
        (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
        (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
-       " " (match-string 4 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)))))))
        (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))))
 
 
+
+(defun org-columns-compact-links (s)
+  "Replace [[link][desc]] with [desc] or [link]."
+  (while (string-match org-bracket-link-regexp s)
+    (setq s (replace-match
+	     (concat "[" (match-string (if (match-end 3) 3 1) s) "]")
+	     t t s)))
+  s)
+
+(defvar org-agenda-columns-remove-prefix-from-item)
+(defun org-agenda-columns-cleanup-item (item pl cphr fmt)
+  "Cleanup the tiem property for agenda column view.
+See also the variable `org-agenda-columns-remove-prefix-from-item'."
+  (let* ((org-complex-heading-regexp cphr)
+	 (prefix (substring item 0 pl))
+	 (rest (substring item pl))
+	 (fake (concat "* " rest))
+	 (cleaned (org-trim (substring (org-columns-cleanup-item fake fmt) 1))))
+    (if org-agenda-columns-remove-prefix-from-item
+	cleaned
+      (concat prefix cleaned))))
+
 (defun org-columns-show-value ()
 (defun org-columns-show-value ()
   "Show the full value of the property."
   "Show the full value of the property."
   (interactive)
   (interactive)

+ 26 - 8
lisp/org-colview.el

@@ -141,7 +141,7 @@ This is the compiled version of the format.")
 	 (face (list color 'org-column ref-face))
 	 (face (list color 'org-column ref-face))
 	 (pl (get-text-property (point-at-bol) 'prefix-length))
 	 (pl (get-text-property (point-at-bol) 'prefix-length))
 	 (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)
+	 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.
     (unless props
     (unless props
       (if (eq major-mode 'org-agenda-mode)
       (if (eq major-mode 'org-agenda-mode)
@@ -169,9 +169,10 @@ This is the compiled version of the format.")
 		       (if (org-mode-p)
 		       (if (org-mode-p)
 			   (org-columns-cleanup-item
 			   (org-columns-cleanup-item
 			    val org-columns-current-fmt-compiled)
 			    val org-columns-current-fmt-compiled)
-			 (org-agenda-columns-cleanu-item
-			  val pl cphr org-columns-current-fmt-compiled)))
-	    string (format f (or modval val)))
+			 (org-agenda-columns-cleanup-item
+			  val pl cphr org-columns-current-fmt-compiled))))
+      (setq s2 (org-columns-add-ellipses (or modval val) width))
+      (setq string (format f s2))
       ;; Create the overlay
       ;; Create the overlay
       (org-unmodified
       (org-unmodified
        (setq ov (org-columns-new-overlay
        (setq ov (org-columns-new-overlay
@@ -203,6 +204,14 @@ 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
@@ -283,17 +292,26 @@ for the duration of the command.")
 	 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
 	 '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 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
        (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
        (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
-       " " (match-string 4 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)))))))
        (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))))
 
 
-(defun org-agenda-columns-cleanu-item (item pl cphr fmt)
+(defun org-columns-compact-links (s)
+  "Replace [[link][desc]] with [desc] or [link]."
+  (while (string-match org-bracket-link-regexp s)
+    (setq s (replace-match
+	     (concat "[" (match-string (if (match-end 3) 3 1) s) "]")
+	     t t s)))
+  s)
+
+(defvar org-agenda-columns-remove-prefix-from-item)
+(defun org-agenda-columns-cleanup-item (item pl cphr fmt)
   "Cleanup the tiem property for agenda column view.
   "Cleanup the tiem property for agenda column view.
-See also the variable `org-agenda-columns-remove-prefix'."
+See also the variable `org-agenda-columns-remove-prefix-from-item'."
   (let* ((org-complex-heading-regexp cphr)
   (let* ((org-complex-heading-regexp cphr)
 	 (prefix (substring item 0 pl))
 	 (prefix (substring item 0 pl))
 	 (rest (substring item pl))
 	 (rest (substring item pl))
 	 (fake (concat "* " rest))
 	 (fake (concat "* " rest))
-	 (cleaned (substring (org-columns-cleanup-item fake fmt) 1)))
+	 (cleaned (org-trim (substring (org-columns-cleanup-item fake fmt) 1))))
     (if org-agenda-columns-remove-prefix-from-item
     (if org-agenda-columns-remove-prefix-from-item
 	cleaned
 	cleaned
       (concat prefix cleaned))))
       (concat prefix cleaned))))