ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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>
This commit is contained in:
Kyle Meyer 2015-10-26 22:49:45 -04:00
parent 3efb519ff5
commit 1c740023f7
2 changed files with 55 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
lisp/org.el
View File

@ -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 "/"))
(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 (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 "/"))))))
(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.

34
testing/lisp/test-org.el
View File

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