Ver Fonte

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 há 16 anos atrás
pai
commit
9d5cc8e422
3 ficheiros alterados com 47 adições e 12 exclusões
  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>
 2009-09-03  Carsten Dominik  <carsten.dominik@gmail.com>
 
 
 	* org-agenda.el (org-agenda-quit): Provide the window argument for
 	* org-agenda.el (org-agenda-quit): Provide the window argument for
 	`window-dedicated-p', Emacs 22 needs it.
 	`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
 	* org-exp.el (org-export-cleanup-toc-line): Remove footnote
 	references from TOC lines.
 	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
 (defvar org-prefix-has-effort nil
   "A flag, set by `org-compile-prefix-format'.
   "A flag, set by `org-compile-prefix-format'.
 The flag is set if the currently compiled format contains a `%e'.")
 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
 (defun org-format-agenda-item (extra txt &optional category tags dotime
 				     noprefix remove-re)
 				     noprefix remove-re)
@@ -4345,7 +4347,7 @@ Any match of REMOVE-RE will be removed from TXT."
 			   (if (stringp dotime) dotime "")
 			   (if (stringp dotime) dotime "")
 			   (and org-agenda-search-headline-for-time txt))))
 			   (and org-agenda-search-headline-for-time txt))))
 	   (time-of-day (and dotime (org-get-time-of-day ts)))
 	   (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)
 	   duration)
       (and (org-mode-p) buffer-file-name
       (and (org-mode-p) buffer-file-name
 	   (add-to-list 'org-agenda-contributing-files 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 ""))
 			 (t ""))
 	      extra (or extra "")
 	      extra (or extra "")
 	      category (if (symbolp category) (symbol-name category) category))
 	      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
 	;; Evaluate the compiled format
 	(setq rtn (concat (eval org-prefix-format-compiled) txt)))
 	(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
 The resulting form is returned and stored in the variable
 `org-prefix-format-compiled'."
 `org-prefix-format-compiled'."
   (setq org-prefix-has-time nil org-prefix-has-tag nil
   (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
   (let ((s (cond
 	    ((stringp org-agenda-prefix-format)
 	    ((stringp org-agenda-prefix-format)
 	     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 'time) (setq org-prefix-has-time t))
       (if (equal var 'tag)  (setq org-prefix-has-tag  t))
       (if (equal var 'tag)  (setq org-prefix-has-tag  t))
       (if (equal var 'effort) (setq org-prefix-has-effort 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"))
       (setq f (concat "%" (match-string 2 s) "s"))
       (if opt
       (if opt
 	  (setq varform
 	  (setq varform
 		`(if (equal "" ,var)
 		`(if (equal "" ,var)
 		     ""
 		     ""
 		   (format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
 		   (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))
       (setq s (replace-match "%s" t nil s))
       (push varform vars))
       (push varform vars))
     (setq vars (nreverse vars))
     (setq vars (nreverse vars))
@@ -5599,14 +5613,18 @@ at the text of the entry itself."
   (interactive "P")
   (interactive "P")
   (let* ((marker (or (get-text-property (point) 'org-hd-marker)
   (let* ((marker (or (get-text-property (point) 'org-hd-marker)
 		     (get-text-property (point) 'org-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"))
     (unless buffer (error "Don't know where to look for links"))
     (with-current-buffer buffer
     (with-current-buffer buffer
       (save-excursion
       (save-excursion
 	(save-restriction
 	(save-restriction
 	  (widen)
 	  (widen)
 	  (goto-char marker)
 	  (goto-char marker)
-	  (org-offer-links-in-entry arg))))))
+	  (org-offer-links-in-entry arg prefix))))))
 
 
 (defun org-agenda-copy-local-variable (var)
 (defun org-agenda-copy-local-variable (var)
   "Get a variable from a referenced buffer and install it here."
   "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)
    (move-marker org-open-link-marker nil)
    (run-hook-with-args 'org-follow-link-hook)))
    (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.
   "Offer links in the curren entry and follow the selected link.
 If there is only one link, follow it immediately as well.
 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 "\\)\\|"
   (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|"
 		    "\\(" org-angle-link-re "\\)\\|"
 		    "\\(" org-angle-link-re "\\)\\|"
 		    "\\(" org-plain-link-re "\\)"))
 		    "\\(" org-plain-link-re "\\)"))
 	(cnt ?0)
 	(cnt ?0)
 	(in-emacs (if (integerp nth) nil nth))
 	(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
     (save-excursion
       (org-back-to-heading t)
       (org-back-to-heading t)
       (setq end (save-excursion (outline-next-heading) (point)))
       (setq end (save-excursion (outline-next-heading) (point)))
       (while (re-search-forward re end t)
       (while (re-search-forward re end t)
 	(push (match-string 0) links))
 	(push (match-string 0) links))
       (setq links (org-uniquify (reverse links))))
       (setq links (org-uniquify (reverse links))))
-
+    
     (cond
     (cond
      ((null links) (error "No links"))
      ((null links) (error "No links"))
      ((equal (length links) 1)
      ((equal (length links) 1)
       (setq link (car links)))
       (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
      (t ; we have to select a link
       (save-excursion
       (save-excursion
 	(save-window-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*"))))
 	  (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
       (when (equal c ?q) (error "Abort"))
       (when (equal c ?q) (error "Abort"))
       (setq nth (- c ?0))
       (setq nth (- c ?0))
+      (if have-zero (setq nth (1+ nth)))
       (unless (and (integerp nth) (>= (length links) nth))
       (unless (and (integerp nth) (>= (length links) nth))
 	(error "Invalid link selection"))
 	(error "Invalid link selection"))
       (setq link (nth (1- nth) links))))
       (setq link (nth (1- nth) links))))