Implement showing the outline path in the echo area while in the agenda

lisp/ChangeLog

@@ -1,5 +1,10 @@
 2009-11-13  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org-agenda.el (org-agenda-show-outline-path): New option.
+	(org-agenda-do-context-action): New function.
+	(org-agenda-next-line, org-agenda-previous-line): Use
+	`org-agenda-do-context-action'.
+
 	* org.el (org-use-speed-commands): Allow function value.
 	(org-speed-commands-default): Make headline motion safe, so that
 	these commands always end on a headline.
@@ -7,6 +12,9 @@
 	(org-speed-move-safe): New function.
 	(org-self-insert-command): Use the function value of
 	`org-use-speed-commands'.
+	(org-get-outline-path): Improve docstring.
+	(org-format-outline-path): New function.
+	(org-display-outline-path): New function.
 
 2009-11-12  John Wiegley  <jwiegley@gmail.com>
 

lisp/org-agenda.el

@@ -671,6 +671,11 @@ Needs to be set before org.el is loaded."
   :group 'org-agenda-startup
   :type 'boolean)
 
+(defcustom org-agenda-show-outline-path t
+  "Non-il means, show outline path in echo area after line motion."
+  :group 'org-agenda-startup
+  :type 'boolean)
+
 (defcustom org-agenda-start-with-entry-text-mode nil
   "The initial value of entry-text-mode in a newly created agenda window."
   :group 'org-agenda-startup
@@ -5672,15 +5677,23 @@ When called with a prefix argument, include all archive files as well."
   "Move cursor to the next line, and show if follow-mode is active."
   (interactive)
   (call-interactively 'next-line)
-  (if (and org-agenda-follow-mode (org-get-at-bol 'org-marker))
-      (org-agenda-show)))
+  (org-agenda-do-context-action))
+
 (defun org-agenda-previous-line ()
   "Move cursor to the previous line, and show if follow-mode is active."
 
   (interactive)
   (call-interactively 'previous-line)
-  (if (and org-agenda-follow-mode (org-get-at-bol 'org-marker))
-      (org-agenda-show)))
+  (org-agenda-do-context-action))
+
+(defun org-agenda-do-context-action ()
+  "Show outline path and, maybe, follow-mode window."
+  (let ((m (org-get-at-bol 'org-marker)))
+    (if (and org-agenda-follow-mode m)
+	(org-agenda-show))
+    (if (and m org-agenda-show-outline-path)
+	(message (org-with-point-at m
+		   (org-display-outline-path t))))))
 
 (defun org-agenda-show-priority ()
   "Show the priority of the current item.

lisp/org-colview.el

@@ -93,10 +93,8 @@ This is the compiled version of the format.")
 		(while (and (org-invisible-p2) (not (eobp)))
 		  (beginning-of-line 2))
 		(move-to-column col)
-		(if (and (eq major-mode 'org-agenda-mode)
-			 (org-bound-and-true-p org-agenda-follow-mode)
-			 (org-get-at-bol 'org-marker))
-		    (org-agenda-show)))))		
+		(if (eq major-mode 'org-agenda-mode)
+		    (org-agenda-do-context-action)))))
 (org-defkey org-columns-map [up]
 	    (lambda () (interactive)
 	      (let ((col (current-column)))
@@ -104,10 +102,8 @@ This is the compiled version of the format.")
 		(while (and (org-invisible-p2) (not (bobp)))
 		  (beginning-of-line 0))
 		(move-to-column col)
-		(if (and (eq major-mode 'org-agenda-mode)
-			 (org-bound-and-true-p org-agenda-follow-mode)
-			 (org-get-at-bol 'org-marker))
-		    (org-agenda-show)))))
+		(if (eq major-mode 'org-agenda-mode)
+		    (org-agenda-do-context-action)))))
 (org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
 (org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
 (org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value)

lisp/org.el

@@ -8985,7 +8985,10 @@ on the system \"/user@host:\"."
 (defvar org-olpa (make-vector 20 nil))
 
 (defun org-get-outline-path (&optional fastp level heading)
-  "Return the outline path to the current entry, as a list."
+  "Return the outline path to the current entry, as a list.
+The parameters FASTP, LEVEL, and HEADING are for use be a scanner
+routine which makes outline path derivations for an entire file,
+avoiding backtracing."
   (if fastp
       (progn
 	(if (> level 19)
@@ -9002,6 +9005,59 @@ on the system \"/user@host:\"."
 	    (push (org-match-string-no-properties 4) rtn)))
 	rtn))))
 
+(defun org-format-outline-path (path &optional width prefix)
+  "Format the outlie path PATH for display.
+Width is the maximum number of characters that is available.
+Prefix is a prefix to be included in the returned string,
+such as the file name."
+  (setq width (or width 79))
+  (if prefix (setq width (- width (length prefix))))
+  (if (not path)
+      (or prefix "")
+    (let* ((nsteps (length path))
+	   (total-width (+ nsteps (apply '+ (mapcar 'length path))))
+	   (maxwidth (if (<= total-width width)
+			 10000  ;; everything fits
+		       ;; we need to shorten the level headings
+		       (/ (- width nsteps) nsteps)))
+	   (org-odd-levels-only nil)
+	   (n 0)
+	   (total (1+ (length prefix))))
+      (setq maxwidth (max maxwidth 10))
+      (concat prefix
+	      (mapconcat
+	       (lambda (h)
+		 (setq n (1+ n))
+		 (if (and (= n nsteps) (< maxwidth 10000))
+		     (setq maxwidth (- total-width total)))
+		 (if (< (length h) maxwidth)
+		     (progn (setq total (+ total (length h) 1)) h)
+		   (setq h (substring h 0 (- maxwidth 2))
+			 total (+ total maxwidth 1))
+		   (if (string-match "[ \t]+\\'" h)
+		       (setq h (substring h 0 (match-beginning 0))))
+		   (setq h (concat  h "..")))
+		 (org-add-props h nil 'face
+				(nth (% (1- n) org-n-level-faces)
+				     org-level-faces))
+		 h)
+	       path "/")))))
+
+(defun org-display-outline-path (&optional file current)
+  "Display the current outline path in the echo area."
+  (interactive "P")
+  (let ((bfn (buffer-file-name (buffer-base-buffer)))
+	(path (and (org-mode-p) (org-get-outline-path))))
+    (if current (setq path (append path
+				   (save-excursion
+				     (org-back-to-heading t)
+				     (if (looking-at org-complex-heading-regexp)
+					 (list (match-string 4)))))))
+    (message (org-format-outline-path
+	      path
+	      (1- (frame-width))
+	      (and file bfn (concat (file-name-nondirectory bfn) "/"))))))
+
 (defvar org-refile-history nil
   "History for refiling operations.")