Rewrite org-format-outline-path

* lisp/org.el (org-format-outline-path): Avoid out-of-range error when
  the length of PREFIX is greater than the value given for WIDTH.
  Prevent result from extending beyond WIDTH.  Simplify code.
* testing/lisp/test-org.el (test-org/format-outline-path): Add tests.

Reported-by: Simon Thum <simon.thum@gmx.de>
<http://permalink.gmane.org/gmane.emacs.orgmode/102241>

lisp/org.el

@@ -11751,38 +11751,27 @@ such as the file name.
 SEPARATOR is inserted between the different parts of the path,
 the default is \"/\"."
   (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
-	      (if prefix (or separator "/"))
-	      (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 (or separator "/"))))))
+  (unless (> width 0)
+    (user-error "Argument `width' must be positive"))
+  (setq separator (or separator "/"))
+  (let* ((org-odd-levels-only nil)
+	 (fpath (concat
+		 prefix (and prefix path separator)
+		 (mapconcat
+		  (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s))
+		  (loop for head in path
+			for n upto (length path)
+			collect (org-add-props
+				    head nil 'face
+				    (nth (% n org-n-level-faces) org-level-faces)))
+		  separator))))
+    (when (> (length fpath) width)
+      (if (< width 7)
+	  ;; It's unlikely that `width' will be this small, but don't
+	  ;; waste characters by adding ".." if it is.
+	  (setq fpath (substring fpath 0 width))
+	(setf (substring fpath (- width 2)) "..")))
+    fpath))
 
 (defun org-display-outline-path (&optional file current separator just-return-string)
   "Display the current outline path in the echo area.

testing/lisp/test-org.el

@@ -1311,6 +1311,40 @@
 	    '(org-block-todo-from-children-or-siblings-or-parent)))
        (org-entry-blocked-p)))))
 
+(ert-deftest test-org/format-outline-path ()
+  (should
+   (string= (org-format-outline-path (list "one" "two" "three"))
+	    "one/two/three"))
+  ;; Empty path.
+  (should
+   (string= (org-format-outline-path '())
+	    ""))
+  ;; Empty path and prefix.
+  (should
+   (string= (org-format-outline-path '() nil ">>")
+	    ">>"))
+  ;; Trailing whitespace in headings.
+  (should
+   (string= (org-format-outline-path (list "one\t" "tw o " "three  "))
+	    "one/tw o/three"))
+  ;; Non-default prefix and separators.
+  (should
+   (string= (org-format-outline-path (list "one" "two" "three") nil ">>" "|")
+	    ">>|one|two|three"))
+  ;; Truncate.
+  (should
+   (string= (org-format-outline-path (list "one" "two" "three" "four") 10)
+	    "one/two/.."))
+  ;; Give a very narrow width.
+  (should
+   (string= (org-format-outline-path (list "one" "two" "three" "four") 2)
+	    "on"))
+  ;; Give a prefix that extends beyond the width.
+  (should
+   (string= (org-format-outline-path (list "one" "two" "three" "four") 10
+				     ">>>>>>>>>>")
+	    ">>>>>>>>..")))
+
 
 ;;; Keywords