From 9d5cc8e4227aa07f89e2fc02f4013dd950313c96 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 4 Sep 2009 00:20:14 +0200 Subject: [PATCH] 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'. --- lisp/ChangeLog | 12 ++++++++++++ lisp/org-agenda.el | 28 +++++++++++++++++++++++----- lisp/org.el | 19 ++++++++++++------- 3 files changed, 47 insertions(+), 12 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2c32b94f3..6673a2f56 100755 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,19 @@ +2009-09-04 Carsten Dominik + + * 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 * 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. diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 63e234d7a..ba2d5c092 100644 --- a/lisp/org-agenda.el +++ b/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." diff --git a/lisp/org.el b/lisp/org.el index 5cf52074d..044b9c04b 100644 --- a/lisp/org.el +++ b/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)))) -- 2.11.4.GIT