Browse Source

Agenda: Support for including a link in the category string

The category can contain a bracket link.  This commit makes sure that
the prefix in the agenda looks OK if there is a link, and that the
link is accessible with `C-c C-o 0'.
Carsten Dominik 15 years ago
parent
commit
9d5cc8e422
3 changed files with 47 additions and 12 deletions
  1. 12 0
      lisp/ChangeLog
  2. 23 5
      lisp/org-agenda.el
  3. 12 7
      lisp/org.el

+ 12 - 0
lisp/ChangeLog

@@ -1,7 +1,19 @@
+2009-09-04  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org.el (org-offer-links-in-entry): New argument ZERO to
+	implement a link with index zero.
+
+	* org-agenda.el (org-agenda-open-link): Pass the prefix to
+	`org-offer-links-in-entry'.
+
 2009-09-03  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org-agenda.el (org-agenda-quit): Provide the window argument for
 	`window-dedicated-p', Emacs 22 needs it.
+	(org-format-agenda-item): If the category is a link, arrange for
+	invisible text to replaced with spaces.
+	(org-compile-prefix-format): Add the extra space.
+	(org-prefix-category-length): New variable.
 
 	* org-exp.el (org-export-cleanup-toc-line): Remove footnote
 	references from TOC lines.

+ 23 - 5
lisp/org-agenda.el

@@ -4311,6 +4311,8 @@ The flag is set if the currently compiled format contains a `%T'.")
 (defvar org-prefix-has-effort nil
   "A flag, set by `org-compile-prefix-format'.
 The flag is set if the currently compiled format contains a `%e'.")
+(defvar org-prefix-category-length nil
+  "Used by `org-compile-prefix-format' to remember the category field widh.")
 
 (defun org-format-agenda-item (extra txt &optional category tags dotime
 				     noprefix remove-re)
@@ -4345,7 +4347,7 @@ Any match of REMOVE-RE will be removed from TXT."
 			   (if (stringp dotime) dotime "")
 			   (and org-agenda-search-headline-for-time txt))))
 	   (time-of-day (and dotime (org-get-time-of-day ts)))
-	   stamp plain s0 s1 s2 t1 t2 rtn srp
+	   stamp plain s0 s1 s2 t1 t2 rtn srp l
 	   duration)
       (and (org-mode-p) buffer-file-name
 	   (add-to-list 'org-agenda-contributing-files buffer-file-name))
@@ -4428,6 +4430,15 @@ Any match of REMOVE-RE will be removed from TXT."
 			 (t ""))
 	      extra (or extra "")
 	      category (if (symbolp category) (symbol-name category) category))
+	(when (string-match org-bracket-link-regexp category)
+	  (setq l (if (match-end 3)
+		      (- (match-end 3) (match-beginning 3))
+		    (- (match-end 1) (match-beginning 1))))
+	  (when (< l (or org-prefix-category-length 0))
+	    (setq category (copy-sequence category))
+	    (org-add-props category nil
+	      'extra-space (make-string
+			    (- org-prefix-category-length l 1) ?\ ))))
 	;; Evaluate the compiled format
 	(setq rtn (concat (eval org-prefix-format-compiled) txt)))
 
@@ -4515,7 +4526,7 @@ a double colon separates inherited tags from local tags."
 The resulting form is returned and stored in the variable
 `org-prefix-format-compiled'."
   (setq org-prefix-has-time nil org-prefix-has-tag nil
-	org-prefix-has-effort nil)
+	org-prefix-category-length nil	org-prefix-has-effort nil)
   (let ((s (cond
 	    ((stringp org-agenda-prefix-format)
 	     org-agenda-prefix-format)
@@ -4535,13 +4546,16 @@ The resulting form is returned and stored in the variable
       (if (equal var 'time) (setq org-prefix-has-time t))
       (if (equal var 'tag)  (setq org-prefix-has-tag  t))
       (if (equal var 'effort) (setq org-prefix-has-effort t))
+      (if (equal var 'category)
+	  (setq org-prefix-category-length
+		(abs (string-to-number (match-string 2 s)))))
       (setq f (concat "%" (match-string 2 s) "s"))
       (if opt
 	  (setq varform
 		`(if (equal "" ,var)
 		     ""
 		   (format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
-	(setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c)))))
+	(setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var))))))
       (setq s (replace-match "%s" t nil s))
       (push varform vars))
     (setq vars (nreverse vars))
@@ -5599,14 +5613,18 @@ at the text of the entry itself."
   (interactive "P")
   (let* ((marker (or (get-text-property (point) 'org-hd-marker)
 		     (get-text-property (point) 'org-marker)))
-	 (buffer (and marker (marker-buffer marker))))
+	 (buffer (and marker (marker-buffer marker)))
+	 (prefix (buffer-substring
+		  (point-at-bol)
+		  (+ (point-at-bol)
+		     (get-text-property (point) 'prefix-length)))))
     (unless buffer (error "Don't know where to look for links"))
     (with-current-buffer buffer
       (save-excursion
 	(save-restriction
 	  (widen)
 	  (goto-char marker)
-	  (org-offer-links-in-entry arg))))))
+	  (org-offer-links-in-entry arg prefix))))))
 
 (defun org-agenda-copy-local-variable (var)
   "Get a variable from a referenced buffer and install it here."

+ 12 - 7
lisp/org.el

@@ -8055,30 +8055,34 @@ application the system uses for this file type."
    (move-marker org-open-link-marker nil)
    (run-hook-with-args 'org-follow-link-hook)))
 
-(defun org-offer-links-in-entry (&optional nth)
+(defun org-offer-links-in-entry (&optional nth zero)
   "Offer links in the curren entry and follow the selected link.
 If there is only one link, follow it immediately as well.
-If NTH is an integer immediately pick the NTH link found."
+If NTH is an integer, immediately pick the NTH link found.
+If ZERO is a string, check also this string for a link, and if
+there is one, offer it as link number zero."
   (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|"
 		    "\\(" org-angle-link-re "\\)\\|"
 		    "\\(" org-plain-link-re "\\)"))
 	(cnt ?0)
 	(in-emacs (if (integerp nth) nil nth))
-	end
-	links link c)
+	have-zero end links link c)
+    (when (and (stringp zero) (string-match org-bracket-link-regexp zero))
+      (push (match-string 0 zero) links)
+      (setq cnt (1- cnt) have-zero t))
     (save-excursion
       (org-back-to-heading t)
       (setq end (save-excursion (outline-next-heading) (point)))
       (while (re-search-forward re end t)
 	(push (match-string 0) links))
       (setq links (org-uniquify (reverse links))))
-
+    
     (cond
      ((null links) (error "No links"))
      ((equal (length links) 1)
       (setq link (car links)))
-     ((and (integerp nth) (>= (length links) nth))
-      (setq link (nth (1- nth) links)))
+     ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
+      (setq link (nth (if have-zero nth (1- nth)) links)))
      (t ; we have to select a link
       (save-excursion
 	(save-window-excursion
@@ -8101,6 +8105,7 @@ If NTH is an integer immediately pick the NTH link found."
 	  (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
       (when (equal c ?q) (error "Abort"))
       (setq nth (- c ?0))
+      (if have-zero (setq nth (1+ nth)))
       (unless (and (integerp nth) (>= (length links) nth))
 	(error "Invalid link selection"))
       (setq link (nth (1- nth) links))))