Преглед изворни кода

Use ellipses in narrow column-view columns.

Carsten Dominik пре 17 година
родитељ
комит
19f4b1815e
3 измењених фајлова са 76 додато и 13 уклоњено
  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>
 
 	* org-agenda.el (org-agenda-columns-remove-prefix-from-item): New
 	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-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))
 			     'default) :foreground))))
 	 (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.
     (unless props
       (if (eq major-mode 'org-agenda-mode)
@@ -335,8 +337,13 @@ This is the compiled version of the format.")
 		      width width)
 	    val (or (cdr ass) "")
 	    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
       (org-unmodified
        (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)))
 			  '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
   "Fthe full header line format, will be shifted by horizontal scrolling." )
 (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))))))
        (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)))
-       " " (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)))))))
 
+
+(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 ()
   "Show the full value of the property."
   (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))
 	 (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)
+	 pom property ass width f string ov column val modval s1 s2)
     ;; Check if the entry is in another buffer.
     (unless props
       (if (eq major-mode 'org-agenda-mode)
@@ -169,9 +169,10 @@ This is the compiled version of the format.")
 		       (if (org-mode-p)
 			   (org-columns-cleanup-item
 			    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
       (org-unmodified
        (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)))
 			  '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
   "Fthe full header line format, will be shifted by horizontal scrolling." )
 (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))))))
        (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)))
-       " " (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)))))))
 
-(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.
-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)
 	 (prefix (substring item 0 pl))
 	 (rest (substring item pl))
 	 (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
 	cleaned
       (concat prefix cleaned))))