diff --git a/lisp/org.el b/lisp/org.el index 8e2bf7977..e9f0af9ed 100755 --- a/lisp/org.el +++ b/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. diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 0dbfcb733..efd8c3dc8 100644 --- a/testing/lisp/test-org.el +++ b/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