|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: br-compl.el
|
|
|
4 ;; SUMMARY: Most functions for performing completion on OO constructs.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: matching, oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
24
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 27-Mar-90
|
|
24
|
12 ;; LAST-MOD: 20-Feb-97 at 06:58:31 by Bob Weiner
|
|
0
|
13 ;;
|
|
24
|
14 ;; Copyright (C) 1990-1995, 1997 Free Software Foundation, Inc.
|
|
0
|
15 ;; See the file BR-COPY for license information.
|
|
|
16 ;;
|
|
|
17 ;; This file is part of the OO-Browser.
|
|
|
18 ;;
|
|
|
19 ;; DESCRIPTION:
|
|
|
20 ;; DESCRIP-END.
|
|
|
21
|
|
|
22 (global-set-key "\M-\C-i" 'br-complete-symbol)
|
|
|
23
|
|
|
24 ;; ************************************************************************
|
|
|
25 ;; Other required Elisp libraries
|
|
|
26 ;; ************************************************************************
|
|
|
27
|
|
|
28 ;; Requires a number of functions from "br-lib.el", part of the OO-Browser
|
|
|
29 ;; package. See the code for functions called but not defined within this
|
|
|
30 ;; file.
|
|
|
31
|
|
|
32 ;; ************************************************************************
|
|
|
33 ;; Public functions
|
|
|
34 ;; ************************************************************************
|
|
|
35
|
|
|
36 (defun br-buffer-menu ()
|
|
|
37 "Display list of buffers for current browser language in the viewer window."
|
|
|
38 (interactive)
|
|
|
39 (or (br-in-view-window-p)
|
|
|
40 (setq *br-prev-listing-window* (selected-window)))
|
|
|
41 (let ((owind (selected-window))
|
|
|
42 (ovbuf (save-window-excursion
|
|
|
43 (br-to-view-window)
|
|
|
44 (current-buffer))))
|
|
|
45 (buffer-menu 'files-only)
|
|
|
46 (narrow-to-region (point) (point-max))
|
|
|
47 (let ((buffer-read-only nil)
|
|
|
48 (buf-name))
|
|
|
49 (while (setq buf-name (br-buffer-menu-buffer-name))
|
|
|
50 (if (not (string-match br-src-file-regexp buf-name))
|
|
|
51 (delete-region (point) (progn (forward-line 1) (point)))
|
|
|
52 (forward-line 1))))
|
|
|
53 (goto-char (point-min))
|
|
|
54 (widen)
|
|
|
55 (if (looking-at "^$") ;; No matching buffers
|
|
|
56 (progn
|
|
|
57 (switch-to-buffer ovbuf)
|
|
|
58 (select-window owind)
|
|
|
59 (beep)
|
|
|
60 (message
|
|
|
61 "(OO-Browser): No appropriate buffers available for selection."))
|
|
|
62 (set-window-start nil 1)
|
|
|
63 (substitute-key-definition 'Buffer-menu-select 'br-buffer-menu-select
|
|
|
64 Buffer-menu-mode-map)
|
|
|
65 (message "(OO-Browser): Select a buffer for display."))))
|
|
|
66
|
|
|
67 (defun br-buffer-menu-buffer-name ()
|
|
|
68 "Return name of buffer on curren buffer menu line or nil.
|
|
|
69 Leaves point at the beginning of the current line."
|
|
|
70 (if (= (point) (point-max))
|
|
|
71 nil
|
|
|
72 (beginning-of-line)
|
|
|
73 (forward-char Buffer-menu-buffer-column)
|
|
|
74 (let ((start (point)))
|
|
|
75 ;; End of buffer name marked by tab or two spaces.
|
|
|
76 (if (not (re-search-forward "\t\\| "))
|
|
|
77 nil
|
|
|
78 (skip-chars-backward " \t")
|
|
|
79 (prog1
|
|
|
80 (buffer-substring start (point))
|
|
|
81 (beginning-of-line))))))
|
|
|
82
|
|
|
83 (defun br-buffer-menu-select ()
|
|
|
84 "Display buffer associated with the line that point is on."
|
|
|
85 (interactive)
|
|
|
86 (substitute-key-definition 'br-buffer-menu-select 'Buffer-menu-select
|
|
|
87 Buffer-menu-mode-map)
|
|
|
88 (let ((buff (Buffer-menu-buffer t))
|
|
|
89 (menu (current-buffer)))
|
|
|
90 (if buff
|
|
|
91 (progn (switch-to-buffer buff)
|
|
|
92 (or (eq menu buff)
|
|
|
93 (bury-buffer menu)))
|
|
|
94 (beep))))
|
|
|
95
|
|
|
96 (defun br-complete-entry (&optional prompt)
|
|
|
97 "Interactively completes class or feature name and returns it or nil.
|
|
|
98 Optional PROMPT is initial prompt string for user."
|
|
|
99 (interactive)
|
|
|
100 (let ((default (and (br-in-browser)
|
|
|
101 (not (br-in-view-window-p))
|
|
|
102 (br-find-class-name)))
|
|
|
103 (completion-ignore-case t)
|
|
|
104 completions
|
|
|
105 element-name)
|
|
|
106 (if (not (br-class-path default)) (setq default nil))
|
|
|
107 ;; Prompt with possible completions of element-name.
|
|
|
108 (setq prompt (or prompt "Class/Element name:")
|
|
|
109 completions (append (br-class-completions)
|
|
|
110 (br-feature-completions))
|
|
|
111 element-name
|
|
|
112 (if completions
|
|
|
113 (completing-read
|
|
|
114 (format "%s (default %s) " prompt (or default "<None>"))
|
|
|
115 completions nil 'must-match)
|
|
|
116 (read-string
|
|
|
117 (format "%s (default %s) " prompt (or default "<None>")))))
|
|
|
118 (if (equal element-name "") (setq element-name default))
|
|
|
119 element-name))
|
|
|
120
|
|
|
121 (defun br-complete-symbol ()
|
|
|
122 "Complete symbol preceding point."
|
|
|
123 (interactive)
|
|
|
124 (cond ((and (fboundp 'br-lang-mode)
|
|
|
125 (eq major-mode (symbol-function 'br-lang-mode)))
|
|
|
126 (br-complete-type))
|
|
|
127 (t
|
|
|
128 (lisp-complete-symbol))))
|
|
|
129
|
|
|
130 (defun br-complete-class-name (&optional must-match prompt)
|
|
|
131 "Interactively completes class name if possible, and returns class name.
|
|
|
132 Optional MUST-MATCH means class name must match a completion table entry.
|
|
|
133 Optional PROMPT is intial prompt string for user."
|
|
|
134 (interactive)
|
|
|
135 (let ((default (br-find-class-name))
|
|
|
136 (completion-ignore-case t)
|
|
|
137 completions
|
|
|
138 class-name)
|
|
|
139 ;; Prompt with possible completions of class-name.
|
|
|
140 (setq prompt (or prompt "Class name:")
|
|
|
141 completions (br-class-completions)
|
|
|
142 class-name
|
|
|
143 (if completions
|
|
|
144 (completing-read
|
|
|
145 (format "%s (default %s) " prompt default)
|
|
|
146 completions nil must-match)
|
|
|
147 (read-string
|
|
|
148 (format "%s (default %s) " prompt default))))
|
|
|
149 (if (equal class-name "") default class-name)))
|
|
|
150
|
|
|
151 (defun br-lisp-mode-p ()
|
|
|
152 (or (eq major-mode 'lisp-mode)
|
|
|
153 (eq major-mode 'emacs-lisp-mode)
|
|
|
154 (eq major-mode 'scheme-mode)
|
|
|
155 (eq major-mode 'lisp-interaction-mode)))
|
|
|
156
|
|
|
157 (defun br-complete-type ()
|
|
|
158 "Perform in-buffer completion of a type or element identifier before point.
|
|
|
159 That symbol is compared against current Environment entries and any needed
|
|
|
160 characters are inserted."
|
|
|
161 (interactive)
|
|
|
162 (let* ((completion-ignore-case nil)
|
|
|
163 (end (point))
|
|
|
164 (beg (save-excursion
|
|
|
165 (if (br-lisp-mode-p)
|
|
|
166 nil
|
|
|
167 (skip-chars-backward "^()")
|
|
|
168 (if (eq (preceding-char) ?\()
|
|
|
169 (skip-chars-backward " \t\(")
|
|
|
170 (goto-char end))
|
|
|
171 )
|
|
|
172 (skip-chars-backward (concat br-identifier-chars ":"))
|
|
|
173 (point)))
|
|
|
174 (pattern (br-set-case (buffer-substring beg end)))
|
|
|
175 (type-p)
|
|
|
176 (completion-alist (if (string-match br-feature-signature-regexp
|
|
|
177 pattern)
|
|
|
178 (br-feature-completions)
|
|
|
179 (setq type-p t)
|
|
|
180 (br-class-completions)))
|
|
|
181 (completion (try-completion pattern completion-alist)))
|
|
|
182 (cond ((eq completion t))
|
|
|
183 ((null completion)
|
|
|
184 (message "Can't find completion for '%s'" pattern)
|
|
|
185 (ding))
|
|
|
186 ((not (string-equal pattern completion))
|
|
|
187 (delete-region beg end)
|
|
|
188 (insert (if type-p
|
|
|
189 (br-set-case-type completion)
|
|
|
190 completion)))
|
|
|
191 (t
|
|
|
192 (message "Making completion list...")
|
|
|
193 (let ((list (sort (all-completions pattern completion-alist)
|
|
|
194 'string-lessp)))
|
|
|
195 (let (new)
|
|
|
196 (while list
|
|
|
197 (setq new (cons (car list) new)
|
|
|
198 list (cdr list)))
|
|
|
199 (setq list (nreverse new)))
|
|
|
200 (with-output-to-temp-buffer "*Completions*"
|
|
|
201 (display-completion-list list)))
|
|
|
202 (message "Making completion list...%s" "done")))))
|
|
|
203
|
|
|
204 ;; Derived from saveconf.el.
|
|
|
205 (defun br-window-list ()
|
|
|
206 "Returns a list of Lisp window objects for all Emacs windows.
|
|
|
207 Do not count the minibuffer window even if it is active."
|
|
|
208 (let* ((first-window (next-window (previous-window (selected-window))))
|
|
|
209 (windows (cons first-window nil))
|
|
|
210 (current-cons windows)
|
|
|
211 (w (next-window first-window)))
|
|
|
212 (while (not (eq w first-window))
|
|
|
213 (setq current-cons (setcdr current-cons (cons w nil)))
|
|
|
214 (setq w (next-window w)))
|
|
|
215 windows))
|
|
|
216
|
|
|
217 ;; ************************************************************************
|
|
|
218 ;; Private functions
|
|
|
219 ;; ************************************************************************
|
|
|
220
|
|
|
221 (defun br-all-classes (&optional htable-type duplicates-flag)
|
|
|
222 "Return list of class names in Environment or optional HTABLE-TYPE.
|
|
|
223 HTABLE-TYPE may be \"sys\" or \"lib\" or an actual hash table.
|
|
|
224 List is not sorted unless optional DUPLICATES-FLAG is non-nil, which means cons
|
|
|
225 the the sorted list of duplicate classes onto the front of the unique class
|
|
|
226 names list."
|
|
|
227 (let ((classes
|
|
|
228 (apply 'append
|
|
|
229 (hash-map
|
|
|
230 (function (lambda (val-key-cons)
|
|
|
231 ;; Copy so that hash-table values are not
|
|
|
232 ;; disturbed.
|
|
|
233 (copy-sequence (car val-key-cons))))
|
|
|
234 (cond ((and (stringp htable-type)
|
|
|
235 (not (string-equal htable-type "")))
|
|
|
236 (br-get-htable (concat htable-type "-paths")))
|
|
|
237 ((hashp htable-type) htable-type)
|
|
|
238 (t (br-get-paths-htable)))))))
|
|
|
239 (if duplicates-flag
|
|
|
240 (br-duplicate-and-unique-strings (sort classes 'string-lessp))
|
|
|
241 classes)))
|
|
|
242
|
|
|
243 (defun br-class-completions ()
|
|
|
244 "Return alist of elements whose cars are all class names in lookup table."
|
|
|
245 (mapcar (function (lambda (elt) (cons elt nil)))
|
|
|
246 (br-class-list-filter (sort (br-all-classes) 'string-lessp))))
|
|
|
247
|
|
|
248 (defun br-find-class-name (&optional keep-indent)
|
|
|
249 "Return class name that point is within in a listing buffer, else nil.
|
|
|
250 Optional KEEP-INDENT non-nil means keep indentation preceding class name."
|
|
|
251 (if (= (point) (point-max)) (skip-chars-backward " \t\n"))
|
|
|
252 (save-excursion
|
|
|
253 (if (looking-at (concat "[ \t]*" br-feature-type-regexp "?[ \t]+"))
|
|
|
254 (goto-char (match-end 0)))
|
|
|
255 (let ((objc (string-equal br-lang-prefix "objc-"))
|
|
|
256 (class))
|
|
|
257 (if objc
|
|
|
258 ;; Include [] characters for default classes, <> for Objective-C
|
|
|
259 ;; protocols and () for Objective-C class categories.
|
|
|
260 (skip-chars-backward (concat "\]\[()<>" br-identifier-chars))
|
|
|
261 (skip-chars-backward (concat "\]\[" br-identifier-chars)))
|
|
|
262 (if (or (and objc
|
|
|
263 (or
|
|
|
264 ;; Objective-C protocol
|
|
|
265 (looking-at (concat "<" br-identifier ">"))
|
|
|
266 ;; Objective-C class(category)
|
|
|
267 (looking-at (concat br-identifier "(" br-identifier ")"))
|
|
|
268 ;; Objective-C class(category)
|
|
|
269 (if (looking-at
|
|
|
270 (concat "\\((" br-identifier ")\\)" br-identifier))
|
|
|
271 (setq class (concat (buffer-substring (match-end 1)
|
|
|
272 (match-end 0))
|
|
|
273 (buffer-substring
|
|
|
274 (match-beginning 1)
|
|
|
275 (match-end 1)))))))
|
|
|
276 (looking-at br-identifier)
|
|
|
277 ;; default class
|
|
|
278 (looking-at (concat "\\[" br-identifier "\\]")))
|
|
|
279 (progn (if keep-indent (beginning-of-line))
|
|
|
280 (br-set-case (or class
|
|
|
281 (buffer-substring (point)
|
|
|
282 (match-end 0)))))))))
|
|
|
283
|
|
|
284 (provide 'br-compl)
|
