Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 40 lines (35 sloc) 2.193 kB
bb483e6 @aufflick made safe for non-shell buffers
authored
1 (setq cdsrc-completions-prefix "~/src/_Pumptheory/")
2
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
3 (defun safe-fill-common-string-prefix (s1 s2)
4 (if (and s1 s2)
5 (fill-common-string-prefix s1 s2)
6 nil))
7
43a7a32 @aufflick program completions sure is hard! part way...
authored
8 (defun cdsrc-completions (str pred mode)
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
9 (let ((dirname (replace-regexp-in-string "[^/]+$" "" str))
10 (filename (replace-regexp-in-string "^.*/" "" str))
11 (slashpos (or (string-match "/.*$" str) 0)))
12
13 (let ((completions (all-completions filename (delq nil
bb483e6 @aufflick made safe for non-shell buffers
authored
14 (mapcar (lambda (x) (and (funcall 'file-directory-p (concat cdsrc-completions-prefix dirname x))
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
15 (not (string-match "^\\." x))
16 (concat x "/")))
bb483e6 @aufflick made safe for non-shell buffers
authored
17 (directory-files (concat cdsrc-completions-prefix dirname)))))))
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
18 (cond
19 ((not mode) (cond
263f384 @aufflick comments
authored
20 ((and (eq 0 (length completions)) (eq 0 (length filename))) 't) ;; in our case, only report exact match when no nested dirs left
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
21 ((> (length completions) 1) (concat dirname (or (reduce 'safe-fill-common-string-prefix completions) filename)))
f02d8ff @aufflick works where there is a single exact match
authored
22 ((eq (length completions) 1) (concat dirname (car completions)))
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
23 ('t nil)))
25c1538 @aufflick tricky stuff not so tricky :)
authored
24 ((eq mode 't) completions)
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
25 ((eq mode 'lambda) (member (concat filename "/") completions))
263f384 @aufflick comments
authored
26 ('t (cons (list 'boundaries slashpos) (length filename)))) ;; let completion know our completions only apply after the last /
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
27 )))
43a7a32 @aufflick program completions sure is hard! part way...
authored
28
29 (defun cdsrc (path)
bb483e6 @aufflick made safe for non-shell buffers
authored
30 "Changes to a subdir of cdsrc-completions-prefix in the current active interactive shell buffer"
43a7a32 @aufflick program completions sure is hard! part way...
authored
31 (interactive (list
bb483e6 @aufflick made safe for non-shell buffers
authored
32 (let ((completion-ignore-case 't)) (completing-read (concat "Enter subdir of " cdsrc-completions-prefix ": ") (symbol-function 'cdsrc-completions)))))
33 (let ((path2 (concat cdsrc-completions-prefix path)))
34 (cd path2)
35 (if (string-match mode-name "Shell")
36 (progn (end-of-buffer)
37 (comint-kill-input)
38 (comint-send-string (current-buffer) (concat "cd " path2))
39 (comint-send-input)))))
Something went wrong with that request. Please try again.