Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 54 lines (45 sloc) 2.551 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
6679b0e @aufflick use a few less columns
authored
14 (mapcar (lambda (x)
4048c72 @aufflick need to escape spaces in path before passing to cd
authored
15 (and (file-directory-p (concat cdsrc-completions-prefix dirname x))
6679b0e @aufflick use a few less columns
authored
16 (not (string-match "^\\." x))
17 (concat x "/")))
bb483e6 @aufflick made safe for non-shell buffers
authored
18 (directory-files (concat cdsrc-completions-prefix dirname)))))))
6679b0e @aufflick use a few less columns
authored
19
20 ;; return differently based on what mode we were called in
21 ;; see http://www.gnu.org/software/emacs/manual/html_node/elisp/Programmed-Completion.html
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
22 (cond
23 ((not mode) (cond
6679b0e @aufflick use a few less columns
authored
24 ((and (eq 0 (length completions)) (eq 0 (length filename)))
25 't) ;; in our case, only report exact match when no nested dirs left
26 ((> (length completions) 1)
27 (concat dirname (or (reduce 'safe-fill-common-string-prefix completions) filename)))
28 ((eq (length completions) 1)
29 (concat dirname (car completions)))
30 ('t
31 nil)))
32
25c1538 @aufflick tricky stuff not so tricky :)
authored
33 ((eq mode 't) completions)
6679b0e @aufflick use a few less columns
authored
34
50c5bb8 @aufflick working, but would prefer the subsequent level completion to only sho…
authored
35 ((eq mode 'lambda) (member (concat filename "/") completions))
6679b0e @aufflick use a few less columns
authored
36
263f384 @aufflick comments
authored
37 ('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
38 )))
43a7a32 @aufflick program completions sure is hard! part way...
authored
39
40 (defun cdsrc (path)
bb483e6 @aufflick made safe for non-shell buffers
authored
41 "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
42 (interactive (list
6679b0e @aufflick use a few less columns
authored
43 (let ((completion-ignore-case 't))
44 (completing-read
45 (concat "Enter subdir of " cdsrc-completions-prefix ": ")
a380acd @aufflick unnecessary
authored
46 'cdsrc-completions))))
bb483e6 @aufflick made safe for non-shell buffers
authored
47 (let ((path2 (concat cdsrc-completions-prefix path)))
48 (cd path2)
49 (if (string-match mode-name "Shell")
50 (progn (end-of-buffer)
51 (comint-kill-input)
4048c72 @aufflick need to escape spaces in path before passing to cd
authored
52 (comint-send-string (current-buffer) (concat "cd " (replace-regexp-in-string " " "\\\\ " path2)))
bb483e6 @aufflick made safe for non-shell buffers
authored
53 (comint-send-input)))))
Something went wrong with that request. Please try again.