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'.
This commit is contained in:
Carsten Dominik 2009-09-04 00:20:14 +02:00
parent 26b82f8276
commit 9d5cc8e422
3 changed files with 47 additions and 12 deletions

View File

@ -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.

View File

@ -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."

View File

@ -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 have-zero end links link c)
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)) ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
(setq link (nth (1- nth) links))) (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))))