mirrors/org-mode
0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-07-20 07:56:28 +00:00
Code Releases Activity

Better outline-path completion.

Browse source 
This now is more like file name completion.
This commit is contained in:
Carsten Dominik 2008-05-16 07:24:19 +02:00
parent 110b336275
commit 6d8ffe91e8
2 changed files with 44 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lisp/ChangeLog
View file

@ -1,3 +1,7 @@
2008-05-16 Carsten Dominik <dominik@science.uva.nl>
* org.el (org-olpath-completing-read): New function.
2008-05-15 Carsten Dominik <dominik@science.uva.nl>
* org-id.el: New file, move from contrib to core.

44
lisp/org.el
View file

@ -4217,6 +4217,7 @@ RET=jump to location [Q]uit and return to previous location
(defvar org-goto-start-pos) ; dynamically scoped parameter
;; FIXME: Docstring doe not mention both interfaces
(defun org-goto (&optional alternative-interface)
"Look up a different location in the current file, keeping current visibility.
@ -7576,20 +7577,54 @@ operation has put the subtree."
(unless org-refile-target-table
(error "No refile targets"))
(let* ((cbuf (current-buffer))
(cfunc (if org-refile-use-outline-path
'org-olpath-completing-read
'completing-read))
(extra (if org-refile-use-outline-path "/" ""))
(filename (buffer-file-name (buffer-base-buffer cbuf)))
(fname (and filename (file-truename filename)))
(tbl (mapcar
(lambda (x)
(if (not (equal fname (file-truename (nth 1 x))))
(cons (concat (car x) " (" (file-name-nondirectory
(nth 1 x)) ")")
(cons (concat (car x) extra " ("
(file-name-nondirectory (nth 1 x)) ")")
(cdr x))
x))
(cons (concat (car x) extra) (cdr x))))
org-refile-target-table))
(completion-ignore-case t))
(assoc (completing-read prompt tbl nil t nil 'org-refile-history)
(assoc (funcall cfunc prompt tbl nil t nil 'org-refile-history)
tbl)))
(defun org-olpath-completing-read (prompt collection &rest args)
"Read an outline path like a file name."
(let ((thetable collection))
(apply
'completing-read prompt
(lambda (string predicate &optional flag)
(let (rtn r s (l (length string)))
(cond
((eq flag nil)
;; try completion
(try-completion string thetable))
((eq flag t)
;; all-completions
(setq rtn (all-completions string thetable predicate))
(mapcar
(lambda (x)
(setq r (substring x l))
(if (string-match " ([^)]*)$" x)
(setq f (match-string 0 x))
(setq f ""))
(if (string-match "/" r)
(concat string (substring r 0 (match-end 0)) f)
x))
rtn))
((eq flag 'lambda)
;; exact match?
(assoc string thetable)))
))
args)))
;;;; Dynamic blocks
(defun org-find-dblock (name)
@ -14028,3 +14063,4 @@ Still experimental, may disappear in the future."
;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
;;; org.el ends here