Commit | Line | Data |
---|---|---|
f32b3b91 CD |
1 | ;;; idlwave.el --- IDL and WAVE CL editing mode for GNU Emacs |
2 | ;; Copyright (c) 1994-1997 Chris Chase | |
3 | ;; Copyright (c) 1999 Carsten Dominik | |
15e42531 | 4 | ;; Copyright (c) 1999, 2000 Free Software Foundation |
f32b3b91 CD |
5 | |
6 | ;; Author: Chris Chase <chase@att.com> | |
7 | ;; Maintainer: Carsten Dominik <dominik@strw.leidenuniv.nl> | |
15e42531 CD |
8 | ;; Version: 4.2 |
9 | ;; Date: $Date: 2000/06/15 17:58:23 $ | |
f32b3b91 CD |
10 | ;; Keywords: languages |
11 | ||
12 | ;; This file is part of the GNU Emacs. | |
13 | ||
14 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
15 | ;; it under the terms of the GNU General Public License as published by | |
16 | ;; the Free Software Foundation; either version 2, or (at your option) | |
17 | ;; any later version. | |
18 | ||
19 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
26 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
27 | ;; Boston, MA 02111-1307, USA. | |
28 | ||
29 | ;;; Commentary: | |
30 | ||
31 | ;; In distant past, based on pascal.el. Though bears little | |
32 | ;; resemblance to that now. | |
33 | ;; | |
34 | ;; Incorporates many ideas, such as abbrevs, action routines, and | |
35 | ;; continuation line indenting, from wave.el. | |
36 | ;; wave.el original written by Lubos Pochman, Precision Visuals, Boulder. | |
37 | ;; | |
38 | ;; See the mode description ("C-h m" in idlwave-mode or "C-h f idlwave-mode") | |
39 | ;; for features, key bindings, and info. | |
40 | ;; Also, Info format documentation is available with `M-x idlwave-info' | |
41 | ;; | |
42 | ;; | |
43 | ;; INSTALLATION | |
44 | ;; ============ | |
45 | ;; | |
46 | ;; Follow the instructions in the INSTALL file of the distribution. | |
47 | ;; In short, put this file on your load path and add the following | |
48 | ;; lines to your .emacs file: | |
49 | ;; | |
50 | ;; (autoload 'idlwave-mode "idlwave" "IDLWAVE Mode" t) | |
8c7b4ec8 | 51 | ;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t) |
f32b3b91 CD |
52 | ;; (setq auto-mode-alist (cons '("\\.pro\\'" . idlwave-mode) auto-mode-alist)) |
53 | ;; | |
54 | ;; | |
55 | ;; SOURCE | |
56 | ;; ====== | |
57 | ;; | |
58 | ;; The newest version of this file is available from the maintainers | |
59 | ;; Webpage. | |
60 | ;; | |
61 | ;; http://www.strw.leidenuniv.el/~dominik/Tools/idlwave | |
62 | ;; | |
63 | ;; DOCUMENTATION | |
64 | ;; ============= | |
65 | ;; | |
66 | ;; IDLWAVE is documented online in info format. | |
67 | ;; A printable version of the documentation is available from the | |
68 | ;; maintainers webpage (see under SOURCE) | |
69 | ;; | |
70 | ;; | |
71 | ;; ACKNOWLEDGMENTS | |
72 | ;; =============== | |
73 | ;; | |
74 | ;; Thanks to the following people for their contributions and comments: | |
75 | ;; | |
76 | ;; Ulrik Dickow <dickow@nbi.dk> | |
77 | ;; Eric E. Dors <edors@lanl.gov> | |
78 | ;; Stein Vidar H. Haugan <s.v.h.haugan@astro.uio.no> | |
79 | ;; David Huenemoerder <dph@space.mit.edu> | |
80 | ;; Kevin Ivory <Kevin.Ivory@linmpi.mpg.de> | |
81 | ;; Xuyong Liu <liu@stsci.edu> | |
82 | ;; Simon Marshall <Simon.Marshall@esrin.esa.it> | |
83 | ;; Laurent Mugnier <mugnier@onera.fr> | |
84 | ;; Lubos Pochman <lubos@rsinc.com> | |
85 | ;; Patrick M. Ryan <pat@jaameri.gsfc.nasa.gov> | |
86 | ;; Marty Ryba <ryba@ll.mit.edu> | |
87 | ;; Phil Williams <williams@irc.chmcc.org> | |
88 | ;; J.D. Smith <jdsmith@astrosun.tn.cornell.edu> | |
89 | ;; Phil Sterne <sterne@dublin.llnl.gov> | |
90 | ;; | |
91 | ;; CUSTOMIZATION: | |
92 | ;; ============= | |
93 | ;; | |
94 | ;; IDLWAVE has customize support - so if you want to learn about the | |
95 | ;; variables which control the behavior of the mode, use | |
96 | ;; `M-x idlwave-customize'. | |
97 | ;; | |
98 | ;; You can set your own preferred values with Customize, or with Lisp | |
99 | ;; code in .emacs. For an example of what to put into .emacs, check | |
100 | ;; the TexInfo documentation. | |
101 | ;; | |
102 | ;; KNOWN PROBLEMS: | |
103 | ;; ============== | |
104 | ;; | |
105 | ;; Moving the point backwards in conjunction with abbrev expansion | |
106 | ;; does not work as I would like it, but this is a problem with | |
107 | ;; emacs abbrev expansion done by the self-insert-command. It ends | |
108 | ;; up inserting the character that expanded the abbrev after moving | |
109 | ;; point backward, e.g., "\cl" expanded with a space becomes | |
110 | ;; "LONG( )" with point before the close paren. This is solved by | |
111 | ;; using a temporary function in `post-command-hook' - not pretty, | |
595ab50b | 112 | ;; but it works. |
f32b3b91 CD |
113 | ;; |
114 | ;; Tabs and spaces are treated equally as whitespace when filling a | |
115 | ;; comment paragraph. To accomplish this, tabs are permanently | |
116 | ;; replaced by spaces in the text surrounding the paragraph, which | |
117 | ;; may be an undesirable side-effect. Replacing tabs with spaces is | |
118 | ;; limited to comments only and occurs only when a comment | |
119 | ;; paragraph is filled via `idlwave-fill-paragraph'. | |
120 | ;; | |
121 | ;; "&" is ignored when parsing statements. | |
122 | ;; Avoid muti-statement lines (using "&") on block begin and end | |
123 | ;; lines. Multi-statement lines can mess up the formatting, for | |
124 | ;; example, multiple end statements on a line: endif & endif. | |
125 | ;; Using "&" outside of block begin/end lines should be okay. | |
126 | ;; | |
127 | ;; It is possible that the parser which decides what to complete has | |
128 | ;; problems with pointer dereferencing statements. I don't use | |
129 | ;; pointers often enough to find out - please report any problems. | |
130 | ;; | |
f32b3b91 CD |
131 | ;; Completion and Routine Info do not know about inheritance. Thus, |
132 | ;; Keywords inherited from superclasses are not displayed and cannot | |
133 | ;; completed. | |
134 | ;; | |
135 | ;; When forcing completion of method keywords, the initial | |
136 | ;; query for a method has multiple entries for some methods. Would | |
595ab50b | 137 | ;; be too difficult to fix this hardly used case. |
f32b3b91 CD |
138 | ;; |
139 | \f | |
140 | ;;; Code: | |
141 | ||
142 | (eval-when-compile (require 'cl)) | |
143 | ||
144 | (eval-and-compile | |
145 | ;; Kludge to allow `defcustom' for Emacs 19. | |
146 | (condition-case () (require 'custom) (error nil)) | |
147 | (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) | |
148 | nil ;; We've got what we needed | |
149 | ;; We have the old or no custom-library, hack around it! | |
150 | (defmacro defgroup (&rest args) nil) | |
151 | (defmacro defcustom (var value doc &rest args) | |
152 | (` (defvar (, var) (, value) (, doc)))))) | |
153 | ||
154 | (defgroup idlwave nil | |
155 | "Major mode for editing IDL/WAVE CL .pro files" | |
156 | :tag "IDLWAVE" | |
157 | :link '(url-link :tag "Home Page" | |
158 | "http://strw.leidenuniv.nl/~dominik/Tools/idlwave") | |
595ab50b CD |
159 | :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" |
160 | "idlw-shell.el") | |
f32b3b91 CD |
161 | :link '(emacs-commentary-link :tag "Commentary in idlwave.el" "idlwave.el") |
162 | :link '(custom-manual "(idlwave)Top") | |
163 | :prefix "idlwave" | |
164 | :group 'languages) | |
165 | ||
166 | ;;; Variables for indentation behavior --------------------------------------- | |
167 | ||
168 | (defgroup idlwave-code-formatting nil | |
169 | "Indentation and formatting options for IDLWAVE mode." | |
170 | :group 'idlwave) | |
171 | ||
172 | (defcustom idlwave-main-block-indent 0 | |
173 | "*Extra indentation for the main block of code. | |
174 | That is the block between the FUNCTION/PRO statement and the END | |
175 | statement for that program unit." | |
176 | :group 'idlwave-code-formatting | |
177 | :type 'integer) | |
178 | ||
179 | (defcustom idlwave-block-indent 4 | |
180 | "*Extra indentation applied to block lines. | |
181 | If you change this, you probably also want to change `idlwave-end-offset'." | |
182 | :group 'idlwave-code-formatting | |
183 | :type 'integer) | |
184 | ||
185 | (defcustom idlwave-end-offset -4 | |
186 | "*Extra indentation applied to block END lines. | |
187 | A value equal to negative `idlwave-block-indent' will make END lines | |
188 | line up with the block BEGIN lines." | |
189 | :group 'idlwave-code-formatting | |
190 | :type 'integer) | |
191 | ||
192 | (defcustom idlwave-continuation-indent 2 | |
193 | "*Extra indentation applied to continuation lines. | |
194 | This extra offset applies to the first of a set of continuation lines. | |
195 | The following lines receive the same indentation as the first. | |
196 | Also, the value of this variable applies to continuation lines inside | |
197 | parenthesis. When the current line contains an open unmatched ([{, | |
198 | the next line is indented to that parenthesis plus the value of this variable." | |
199 | :group 'idlwave-code-formatting | |
200 | :type 'integer) | |
201 | ||
202 | (defcustom idlwave-hanging-indent t | |
203 | "*If set non-nil then comment paragraphs are indented under the | |
204 | hanging indent given by `idlwave-hang-indent-regexp' match in the first line | |
205 | of the paragraph." | |
206 | :group 'idlwave-code-formatting | |
207 | :type 'boolean) | |
208 | ||
209 | (defcustom idlwave-hang-indent-regexp "- " | |
210 | "*Regular expression matching the position of the hanging indent | |
211 | in the first line of a comment paragraph. The size of the indent | |
212 | extends to the end of the match for the regular expression." | |
213 | :group 'idlwave-code-formatting | |
214 | :type 'regexp) | |
215 | ||
216 | (defcustom idlwave-use-last-hang-indent nil | |
217 | "*If non-nil then use last match on line for `idlwave-indent-regexp'." | |
218 | :group 'idlwave-code-formatting | |
219 | :type 'boolean) | |
220 | ||
221 | (defcustom idlwave-fill-comment-line-only t | |
222 | "*If non-nil then auto fill will only operate on comment lines." | |
223 | :group 'idlwave-code-formatting | |
224 | :type 'boolean) | |
225 | ||
226 | (defcustom idlwave-auto-fill-split-string t | |
227 | "*If non-nil then auto fill will split strings with the IDL `+' operator. | |
228 | When the line end falls within a string, string concatenation with the | |
229 | '+' operator will be used to distribute a long string over lines. | |
230 | If nil and a string is split then a terminal beep and warning are issued. | |
231 | ||
232 | This variable is ignored when `idlwave-fill-comment-line-only' is | |
233 | non-nil, since in this case code is not auto-filled." | |
234 | :group 'idlwave-code-formatting | |
235 | :type 'boolean) | |
236 | ||
237 | (defcustom idlwave-split-line-string t | |
238 | "*If non-nil then `idlwave-split-line' will split strings with `+'. | |
239 | When the splitting point of a line falls inside a string, split the string | |
240 | using the `+' string concatenation operator. If nil and a string is | |
241 | split then a terminal beep and warning are issued." | |
242 | :group 'idlwave-code-formatting | |
243 | :type 'boolean) | |
244 | ||
245 | (defcustom idlwave-no-change-comment ";;;" | |
246 | "*The indentation of a comment that starts with this regular | |
247 | expression will not be changed. Note that the indentation of a comment | |
248 | at the beginning of a line is never changed." | |
249 | :group 'idlwave-code-formatting | |
250 | :type 'string) | |
251 | ||
252 | (defcustom idlwave-begin-line-comment nil | |
253 | "*A comment anchored at the beginning of line. | |
254 | A comment matching this regular expression will not have its | |
255 | indentation changed. If nil the default is \"^;\", i.e., any line | |
256 | beginning with a \";\". Expressions for comments at the beginning of | |
257 | the line should begin with \"^\"." | |
258 | :group 'idlwave-code-formatting | |
259 | :type '(choice (const :tag "Any line beginning with `;'" nil) | |
260 | 'regexp)) | |
261 | ||
262 | (defcustom idlwave-code-comment ";;[^;]" | |
263 | "*A comment that starts with this regular expression on a line by | |
264 | itself is indented as if it is a part of IDL code. As a result if | |
265 | the comment is not preceded by whitespace it is unchanged." | |
266 | :group 'idlwave-code-formatting | |
267 | :type 'regexp) | |
268 | ||
269 | ;; Comments not matching any of the above will be indented as a | |
270 | ;; right-margin comment, i.e., to a minimum of `comment-column'. | |
271 | ||
272 | ||
273 | ;;; Routine Info and Completion --------------------------------------- | |
274 | ||
15e42531 CD |
275 | (defgroup idlwave-routine-info nil |
276 | "Routine Info options for IDLWAVE mode." | |
f32b3b91 CD |
277 | :group 'idlwave) |
278 | ||
279 | (defcustom idlwave-scan-all-buffers-for-routine-info t | |
15e42531 CD |
280 | "*Non-nil means, scan buffers for IDL programs when updating info. |
281 | The scanning is done by the command `idlwave-update-routine-info'. | |
282 | The following values are allowed: | |
283 | ||
284 | nil Don't scan any buffers. | |
285 | t Scan all idlwave-mode buffers in the current editing session. | |
286 | current Scan only the current buffer, but no other buffers." | |
287 | :group 'idlwave-routine-info | |
288 | :type '(choice | |
289 | (const :tag "No buffer" nil) | |
290 | (const :tag "All buffers" t) | |
291 | (const :tag "Current buffer only" 'current))) | |
f32b3b91 CD |
292 | |
293 | (defcustom idlwave-query-shell-for-routine-info t | |
294 | "*Non-nil means query the shell for info about compiled routines. | |
295 | Querying the shell is useful to get information about compiled modules, | |
296 | and it is turned on by default. However, when you have a complete library | |
297 | scan, this is not necessary." | |
15e42531 | 298 | :group 'idlwave-routine-info |
f32b3b91 CD |
299 | :type 'boolean) |
300 | ||
15e42531 CD |
301 | (defcustom idlwave-auto-routine-info-updates |
302 | '(find-file save-buffer kill-buffer compile-buffer) | |
303 | "*Controls under what circumstances routine info is updated automatically. | |
304 | Possible values: | |
305 | nil Never | |
306 | t All available | |
307 | (...) A list of circumstances. Allowed members are: | |
308 | find-file Add info for new IDLWAVE buffers. | |
309 | save-buffer Update buffer info when buffer is saved | |
310 | kill-buffer Remove buffer info when buffer gets killed | |
311 | compile-buffer Update shell info after `idlwave-shell-save-and...'" | |
312 | :group 'idlwave-routine-info | |
313 | :type '(choice | |
314 | (const :tag "Never" nil) | |
315 | (const :tag "As often as possible" t) | |
316 | (set :tag "Checklist" :greedy t | |
317 | (const :tag "When visiting a file" find-file) | |
318 | (const :tag "When saving a buffer" save-buffer) | |
319 | (const :tag "After a buffer was killed" kill-buffer) | |
320 | (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) | |
321 | ||
322 | (defcustom idlwave-rinfo-max-source-lines 5 | |
323 | "*Maximum number of source files displayed in the Routine Info window. | |
324 | When an integer, it is the maximum number of source files displayed. | |
325 | t means to show all source files." | |
326 | :group 'idlwave-routine-info | |
327 | :type 'integer) | |
328 | ||
f32b3b91 CD |
329 | (defcustom idlwave-library-path nil |
330 | "Library path for Windows and MacOS. Not needed under Unix. | |
331 | When selecting the directories to scan for IDL library routine info, | |
332 | IDLWAVE can under UNIX query the shell for the exact search path. | |
333 | However, under Windows and MacOS, the IDLWAVE shell does not work. In this | |
334 | case, this variable specifies the path where IDLWAVE can find library files. | |
335 | The shell will only be asked when this variable is nil. | |
336 | The value is a list of directories. A directory preceeded by a `+' will | |
595ab50b | 337 | be searched recursively. If you set this variable on a UNIX system, the shell |
15e42531 CD |
338 | will not be asked. |
339 | See also `idlwave-system-directory'." | |
340 | :group 'idlwave-routine-info | |
f32b3b91 CD |
341 | :type '(repeat (directory))) |
342 | ||
15e42531 CD |
343 | (defcustom idlwave-system-directory "" |
344 | "The IDL system directory for Windows and MacOS. Not needed under UNIX. | |
345 | Set this to the value of the `!DIR' system variable in IDL. IDLWAVE uses | |
346 | this to find out which of the library routines belong to the official system | |
347 | library. All files inside the `lib' subdirectory are considered system | |
348 | library files - so don't install private stuff in this directory. | |
349 | On UNIX systems, IDLWAVE queries the shell for the value of `!DIR'. | |
350 | See also `idlwave-library-path'." | |
351 | :group 'idlwave-routine-info | |
352 | :type 'directory) | |
353 | ||
354 | (defcustom idlwave-libinfo-file "~/.idlcat.el" | |
f32b3b91 CD |
355 | "*File for routine information of the IDL library. |
356 | When this points to a file, the file will be loaded when IDLWAVE first | |
357 | accesses routine info (or does completion). | |
358 | When you scan the library with `idlwave-create-libinfo-file', this file | |
359 | will be used to store the result." | |
15e42531 | 360 | :group 'idlwave-routine-info |
f32b3b91 CD |
361 | :type 'file) |
362 | ||
15e42531 CD |
363 | (defcustom idlwave-special-lib-alist nil |
364 | "Alist of regular expressions matching special library directories. | |
365 | When listing routine source locations, IDLWAVE gives a short hint where | |
366 | the file defining the routine is located. By default it lists `SystemLib' | |
367 | for routines in the system library `!DIR/lib' and `Library' for anything | |
368 | else. This variable can define additional types. The car of each entry | |
369 | is a regular expression matching the file name (they normally will match | |
370 | on the path). The cdr is the string to be used as identifier. Max 10 | |
371 | chars are allowed." | |
372 | :group 'idlwave-routine-info | |
373 | :type '(repeat | |
374 | (cons regexp string))) | |
375 | ||
376 | (defgroup idlwave-online-help nil | |
377 | "Online Help options for IDLWAVE mode." | |
378 | :group 'idlwave) | |
379 | ||
380 | (defcustom idlwave-help-directory "" | |
381 | "The directory where idlw-help.txt and idlw-help.el are stored." | |
382 | :group 'idlwave-online-help | |
383 | :type 'file) | |
384 | ||
385 | (defcustom idlwave-help-use-dedicated-frame t | |
386 | "*Non-nil means, use a separate frame for Online Help if possible." | |
387 | :group 'idlwave-online-help | |
388 | :type 'boolean) | |
389 | ||
390 | (defcustom idlwave-help-frame-parameters | |
391 | '((height . 20) (unsplittable . t)) | |
392 | "The frame parameters for the special Online Help frame. | |
393 | See also `idlwave-help-use-dedicated-frame'. | |
394 | If you do not set the frame width here, the value specified in | |
395 | `idlw-help.el' will be used." | |
396 | :group 'idlwave-online-help | |
397 | :type '(repeat | |
398 | (cons symbol sexp))) | |
399 | ||
400 | (defcustom idlwave-max-popup-menu-items 20 | |
401 | "Maximum number of items per pane in popup menus. | |
402 | Currently only used for class selection during completion help." | |
403 | :group 'idlwave-online-help | |
404 | :type 'integer) | |
405 | ||
406 | (defcustom idlwave-extra-help-function 'idlwave-help-with-source | |
407 | "The function to call for online help if the normal help fails. | |
408 | Online help works only for system routines which are described in the | |
409 | IDL manuals. A function may be specified to access help from other sources. | |
410 | ||
411 | The function must accept four arguments: NAME, TYPE, CLASS, KEYWORD. | |
412 | The Help buffer is current when this function is called, and the help | |
413 | text should be loaded into this buffer. If help is found, the function | |
414 | should return the buffer position which should be used as `window-start' | |
415 | in the help window. Also, the variable `idlwave-help-mode-line-indicator' | |
416 | should be set to a useful string, which will be displayed in the mode line | |
417 | of the help window. If should also set the variable `idlwave-min-frame-width' | |
418 | to a positive integer. IDLWAVE will ensure that the help frame is at | |
419 | least that many columns wide. | |
420 | Failure to find help should be indicated by throwing an error. | |
421 | ||
422 | When this variable is non-nil, IDLWAVE will allow the mouse-3 help click | |
423 | for every routine and keyword, even though the item may not be highlighted | |
424 | in blue (indicating the availability of system documentation). | |
425 | ||
426 | The default value for this function is `idlwave-help-with-source' which | |
427 | loads the routine source file into the help buffer. If you try to write | |
428 | a different function which accesses a special help file or so, it is | |
429 | probably a good idea to still call this function as a fallback." | |
430 | :group 'idlwave-online-help | |
431 | :type 'symbol) | |
432 | ||
433 | (defcustom idlwave-help-fontify-source-code nil | |
434 | "*Non-nil means, fontify source code displayed as help like normal code." | |
435 | :group 'idlwave-online-help | |
436 | :type 'boolean) | |
437 | ||
438 | (defcustom idlwave-help-source-try-header t | |
439 | "*Non-nil means, try to find help in routine header when displaying source. | |
440 | Routines which are not documented in the system manual use their source as | |
441 | help text. When this variable is non-nil, we try to find a description of | |
442 | the help item in the first routine doclib header above the routine definition. | |
443 | If the variable is nil, or if we cannot find/parse the header, the routine | |
444 | definition is displayed instead." | |
445 | :group 'idlwave-online-help | |
446 | :type 'boolean) | |
447 | ||
448 | (defface idlwave-help-link-face | |
449 | '((((class color)) (:foreground "Blue")) | |
450 | (t (:bold t))) | |
451 | "Face for highlighting links into IDLWAVE online help." | |
452 | :group 'idlwave-online-help) | |
453 | ||
454 | (defgroup idlwave-completion nil | |
455 | "Completion options for IDLWAVE mode." | |
456 | :prefix "idlwave" | |
457 | :group 'idlwave) | |
458 | ||
f32b3b91 CD |
459 | (eval-and-compile |
460 | (defconst idlwave-tmp | |
461 | '(choice :tag "by applying the function" | |
462 | (const upcase) | |
463 | (const downcase) | |
464 | (const capitalize) | |
465 | (const preserve) | |
466 | (symbol :tag "Other")))) | |
467 | ||
f32b3b91 CD |
468 | (defcustom idlwave-completion-case '((routine . upcase) |
469 | (keyword . upcase) | |
470 | (class . preserve) | |
471 | (method . preserve)) | |
472 | "Association list setting the case of completed words. | |
473 | ||
474 | This variable determines the case (UPPER/lower/Capitalized...) of | |
475 | words inserted into the buffer by completion. The preferred case can | |
476 | be specified separately for routine names, keywords, classes and | |
477 | methods. | |
478 | This alist should therefore have entries for `routine' (normal | |
479 | functions and procedures, i.e. non-methods), `keyword', `class', and | |
480 | `method'. Plausible values are | |
481 | ||
482 | upcase upcase whole word, like `BOX_CURSOR' | |
483 | downcase downcase whole word, like `read_ppm' | |
484 | capitalize capitalize each part, like `Widget_Control' | |
485 | preserve preserve case as is, like `IDLgrView' | |
486 | ||
487 | The value can also be any Emacs Lisp function which transforms the | |
488 | case of characters in a string. | |
489 | ||
490 | A value of `preserve' means that the case of the completed word is | |
491 | identical to the way it was written in the definition statement of the | |
492 | routine. This was implemented to allow for mixed-case completion, in | |
493 | particular of object classes and methods. | |
494 | If a completable word is defined in multiple locations, the meaning of | |
495 | `preserve' is not unique since the different definitions might be | |
496 | cased differently. Therefore IDLWAVE always takes the case of the | |
497 | *first* definition it encounters during routine info collection and | |
498 | uses the case derived from it consistently. | |
499 | ||
500 | Note that a lowercase-only string in the buffer will always be completed in | |
501 | lower case (but see the variable `idlwave-completion-force-default-case'). | |
502 | ||
503 | After changing this variable, you need to either restart Emacs or press | |
504 | `C-u C-c C-i' to update the internal lists." | |
15e42531 | 505 | :group 'idlwave-completion |
f32b3b91 CD |
506 | :type `(repeat |
507 | (cons (symbol :tag "Derive completion case for") | |
508 | ,idlwave-tmp))) | |
509 | ||
510 | (defcustom idlwave-completion-force-default-case nil | |
511 | "*Non-nil means, completion will always honor `idlwave-completion-case'. | |
512 | When nil, only the completion of a mixed case or upper case string | |
513 | will honor the default settings in `idlwave-completion-case', while | |
514 | the completion of lower case strings will be completed entirely in | |
515 | lower case." | |
15e42531 | 516 | :group 'idlwave-completion |
f32b3b91 CD |
517 | :type 'boolean) |
518 | ||
519 | (defcustom idlwave-complete-empty-string-as-lower-case nil | |
520 | "*Non-nil means, the empty string is considered downcase for completion. | |
521 | The case of what is already in the buffer determines the case of completions. | |
522 | When this variable is non-nil, the empty string is considered to be downcase. | |
523 | Completing on the empty string then offers downcase versions of the possible | |
524 | completions." | |
15e42531 | 525 | :group 'idlwave-completion |
f32b3b91 CD |
526 | :type 'boolean) |
527 | ||
528 | (defvar idlwave-default-completion-case-is-down nil | |
529 | "Obsolete variable. See `idlwave-complete-empty-string-as-lower-case' and | |
530 | `idlwave-completion-case'.") | |
531 | ||
532 | (defcustom idlwave-buffer-case-takes-precedence nil | |
533 | "*Non-nil means, the case of tokens in buffers dominates over system stuff. | |
534 | To make this possible, we need to re-case everything each time we update | |
535 | the routine info from the buffers. This is slow. | |
536 | The default is to consider the case given in the system and library files | |
537 | first which makes updating much faster." | |
15e42531 CD |
538 | :group 'idlwave-completion |
539 | :type 'boolean) | |
540 | ||
541 | (defcustom idlwave-highlight-help-links-in-completion t | |
542 | "*Non-nil means, highlight completions for which system help is available. | |
543 | Help can then be accessed with mouse-3. | |
544 | This option is only effective when the online help system is installed." | |
545 | :group 'idlwave-completion | |
f32b3b91 CD |
546 | :type 'boolean) |
547 | ||
548 | (defcustom idlwave-completion-show-classes 1 | |
549 | "*Number of classes to show when completing object methods and keywords. | |
550 | When completing methods or keywords for an object with unknown class, | |
551 | the *Completions* buffer will show the legal classes for each completion | |
552 | like this: | |
553 | ||
554 | MyMethod <Class1,Class2,Class3> | |
555 | ||
556 | The value of this variable may be nil to inhibit display, or an integer to | |
557 | indicate the maximum number of classes to display. | |
558 | ||
559 | On XEmacs, a full list of classes will also be placed into a `help-echo' | |
560 | property on the competion items, so that the list of classes for the current | |
561 | item is displayed in the echo area. If the value of this variable is a | |
562 | negative integer, the `help-echo' property will be suppressed." | |
15e42531 | 563 | :group 'idlwave-completion |
f32b3b91 CD |
564 | :type '(choice (const :tag "Don't show" nil) |
565 | (integer :tag "Number of classes shown" 1))) | |
566 | ||
567 | (defcustom idlwave-completion-fontify-classes t | |
568 | "*Non-nil means, fontify the classes in completions buffer. | |
569 | This makes it easier to distinguish the completion items from the extra | |
570 | class info listed. See `idlwave-completion-show-classes'." | |
15e42531 | 571 | :group 'idlwave-completion |
f32b3b91 CD |
572 | :type 'boolean) |
573 | ||
574 | (defcustom idlwave-query-class '((method-default . nil) | |
575 | (keyword-default . nil)) | |
576 | "Association list governing specification of object classes for completion. | |
577 | ||
578 | When IDLWAVE is trying to complete items which belong to the object | |
579 | oriented part of IDL, it usually cannot determine the class of a given | |
580 | object from context. In order to provide the user with a correct list | |
581 | of methods or keywords, it would have to determine the appropriate | |
582 | class. IDLWAVE has two ways to deal with this problem. | |
583 | ||
584 | 1. One possibility is to combine the items of all available | |
585 | classes for the purpose of completion. So when completing a | |
586 | method, all methods of all classes are available, and when | |
587 | completing a keyword, all keywords allowed for this method in any | |
588 | class will be possible completions. This behavior is very much | |
589 | like normal completion and is therefore the default. It works much | |
590 | better than one might think - only for the INIT, GETPROPERTY and | |
591 | SETPROPERTY the keyword lists become uncomfortably long. | |
592 | See also `idlwave-completion-show-classes'. | |
593 | ||
594 | 2. The second possibility is to ask the user on each occasion. To | |
595 | make this less interruptive, IDLWAVE can store the class as a text | |
596 | property on the object operator `->'. For a given object in the | |
597 | source code, class selection will then be needed only once | |
598 | - for example to complete the method. Keywords to the method can | |
599 | then be completed directly, because the class is already known. | |
600 | You will have to turn on the storage of the selected class | |
601 | explicitly with the variable `idlwave-store-inquired-class'. | |
602 | ||
603 | This variable allows to configure IDLWAVE's behavior during | |
604 | completion. Its value is an alist, which should contain at least two | |
605 | elements: (method-default . VALUE) and (keyword-default . VALUE), | |
606 | where VALUE is either t or nil. These specify if the class should be | |
607 | determined during method and keyword completion, respectively. | |
608 | ||
609 | The alist may have additional entries specifying exceptions from the | |
610 | keyword completion rule for specific methods, like INIT or | |
611 | GETPROPERTY. In order to turn on class specification for the INIT | |
612 | method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." | |
15e42531 | 613 | :group 'idlwave-completion |
f32b3b91 CD |
614 | :type '(list |
615 | (cons (const method-default) | |
616 | (boolean :tag "Determine class when completing METHODS ")) | |
617 | (cons (const keyword-default) | |
618 | (boolean :tag "Determine class when completing KEYWORDS ")) | |
619 | (repeat | |
620 | :tag "Exceptions to defaults" | |
621 | :inline t | |
622 | (cons (string :tag "MODULE" :value "") | |
623 | (boolean :tag "Determine class for this method"))))) | |
624 | ||
625 | (defcustom idlwave-store-inquired-class nil | |
626 | "*Non-nil means, store class of a method call as text property on `->'. | |
627 | IDLWAVE sometimes has to ask the user for the class associated with a | |
628 | particular object method call. This happens during the commands | |
629 | `idlwave-routine-info' and `idlwave-complete', depending upon the | |
630 | value of the variable `idlwave-query-class'. | |
631 | ||
632 | When you specify a class, this information can be stored as a text | |
633 | property on the `->' arrow in the source code, so that during the same | |
634 | editing session, IDLWAVE will not have to ask again. When this | |
635 | variable is non-nil, IDLWAVE will store and reuse the class information. | |
636 | The class stored can be checked and removed with `\\[idlwave-routine-info]' | |
637 | on the arrow. | |
638 | ||
639 | The default of this variable is nil, since the result of commands then | |
640 | is more predictable. However, if you know what you are doing, it can | |
641 | be nice to turn this on. | |
642 | ||
643 | An arrow which knows the class will be highlighted with | |
644 | `idlwave-class-arrow-face'. The command \\[idlwave-routine-info] | |
645 | displays (with prefix arg: deletes) the class stored on the arrow | |
646 | at point." | |
15e42531 | 647 | :group 'idlwave-completion |
f32b3b91 CD |
648 | :type 'boolean) |
649 | ||
650 | (defcustom idlwave-class-arrow-face 'bold | |
651 | "*Face to highlight object operator arrows `->' which carry a class property. | |
652 | When IDLWAVE stores a class name as text property on an object arrow | |
653 | (see variable `idlwave-store-inquired-class', it highlights the arrow | |
654 | with this font in order to remind the user that this arrow is special." | |
15e42531 | 655 | :group 'idlwave-completion |
f32b3b91 CD |
656 | :type 'symbol) |
657 | ||
658 | (defcustom idlwave-resize-routine-help-window t | |
659 | "*Non-nil means, resize the Routine-info *Help* window to fit the content." | |
15e42531 | 660 | :group 'idlwave-completion |
f32b3b91 CD |
661 | :type 'boolean) |
662 | ||
663 | (defcustom idlwave-keyword-completion-adds-equal t | |
664 | "*Non-nil means, completion automatically adds `=' after completed keywords." | |
15e42531 | 665 | :group 'idlwave-completion |
f32b3b91 CD |
666 | :type 'boolean) |
667 | ||
668 | (defcustom idlwave-function-completion-adds-paren t | |
669 | "*Non-nil means, completion automatically adds `(' after completed function. | |
670 | Nil means, don't add anything. | |
671 | A value of `2' means, also add the closing parenthesis and position cursor | |
672 | between the two." | |
15e42531 | 673 | :group 'idlwave-completion |
f32b3b91 CD |
674 | :type '(choice (const :tag "Nothing" nil) |
675 | (const :tag "(" t) | |
676 | (const :tag "()" 2))) | |
677 | ||
678 | (defcustom idlwave-completion-restore-window-configuration t | |
679 | "*Non-nil means, try to restore the window configuration after completion. | |
680 | When completion is not unique, Emacs displays a list of completions. | |
681 | This messes up your window configuration. With this variable set, IDLWAVE | |
682 | restores the old configuration after successful completion." | |
15e42531 | 683 | :group 'idlwave-completion |
f32b3b91 CD |
684 | :type 'boolean) |
685 | ||
686 | ;;; Variables for abbrev and action behavior ----------------------------- | |
687 | ||
688 | (defgroup idlwave-abbrev-and-indent-action nil | |
689 | "IDLWAVE performs actions when expanding abbreviations or indenting lines. | |
690 | The variables in this group govern this." | |
691 | :group 'idlwave) | |
692 | ||
693 | (defcustom idlwave-do-actions nil | |
694 | "*Non-nil means performs actions when indenting. | |
695 | The actions that can be performed are listed in `idlwave-indent-action-table'." | |
696 | :group 'idlwave-abbrev-and-indent-action | |
697 | :type 'boolean) | |
698 | ||
699 | (defcustom idlwave-abbrev-start-char "\\" | |
700 | "*A single character string used to start abbreviations in abbrev mode. | |
701 | Possible characters to chose from: ~`\% | |
702 | or even '?'. '.' is not a good choice because it can make structure | |
703 | field names act like abbrevs in certain circumstances. | |
704 | ||
705 | Changes to this in `idlwave-mode-hook' will have no effect. Instead a user | |
706 | must set it directly using `setq' in the .emacs file before idlwave.el | |
707 | is loaded." | |
708 | :group 'idlwave-abbrev-and-indent-action | |
709 | :type 'string) | |
710 | ||
711 | (defcustom idlwave-surround-by-blank nil | |
712 | "*Non-nil means, enable `idlwave-surround'. | |
595ab50b | 713 | If non-nil, `=',`<',`>',`&',`,', `->' are surrounded with spaces by |
f32b3b91 CD |
714 | `idlwave-surround'. |
715 | See help for `idlwave-indent-action-table' for symbols using `idlwave-surround'. | |
716 | ||
717 | Also see the default key bindings for keys using `idlwave-surround'. | |
718 | Keys are bound and made into actions calling `idlwave-surround' with | |
719 | `idlwave-action-and-binding'. | |
720 | See help for `idlwave-action-and-binding' for examples. | |
721 | ||
722 | Also see help for `idlwave-surround'." | |
723 | :group 'idlwave-abbrev-and-indent-action | |
724 | :type 'boolean) | |
725 | ||
726 | (defcustom idlwave-pad-keyword t | |
727 | "*Non-nil means pad '=' for keywords like assignments. | |
728 | Whenever `idlwave-surround' is non-nil then this affects how '=' is padded | |
15e42531 CD |
729 | for keywords. If t, it is padded the same as for assignments. |
730 | If nil then spaces are removed. With any other value, spaces are left | |
731 | unchanged." | |
f32b3b91 | 732 | :group 'idlwave-abbrev-and-indent-action |
15e42531 CD |
733 | :type '(choice |
734 | (const :tag "Pad like assignments" t) | |
735 | (const :tag "Remove space near `='" nil) | |
736 | (const :tag "Keep space near `='" 'keep))) | |
f32b3b91 CD |
737 | |
738 | (defcustom idlwave-show-block t | |
739 | "*Non-nil means point blinks to block beginning for `idlwave-show-begin'." | |
740 | :group 'idlwave-abbrev-and-indent-action | |
741 | :type 'boolean) | |
742 | ||
743 | (defcustom idlwave-expand-generic-end nil | |
744 | "*Non-nil means expand generic END to ENDIF/ENDELSE/ENDWHILE etc." | |
745 | :group 'idlwave-abbrev-and-indent-action | |
746 | :type 'boolean) | |
747 | ||
15e42531 CD |
748 | (defcustom idlwave-reindent-end t |
749 | "*Non-nil means re-indent line after END was typed." | |
750 | :group 'idlwave-abbrev-and-indent-action | |
751 | :type 'boolean) | |
752 | ||
f32b3b91 CD |
753 | (defcustom idlwave-abbrev-move t |
754 | "*Non-nil means the abbrev hook can move point. | |
755 | Set to nil by `idlwave-expand-region-abbrevs'. To see the abbrev | |
756 | definitions, use the command `list-abbrevs', for abbrevs that move | |
757 | point. Moving point is useful, for example, to place point between | |
758 | parentheses of expanded functions. | |
759 | ||
760 | See `idlwave-check-abbrev'." | |
761 | :group 'idlwave-abbrev-and-indent-action | |
762 | :type 'boolean) | |
763 | ||
764 | (defcustom idlwave-abbrev-change-case nil | |
765 | "*Non-nil means all abbrevs will be forced to either upper or lower case. | |
766 | If the value t, all expanded abbrevs will be upper case. | |
767 | If the value is 'down then abbrevs will be forced to lower case. | |
768 | If nil, the case will not change. | |
769 | If `idlwave-reserved-word-upcase' is non-nil, reserved words will always be | |
770 | upper case, regardless of this variable." | |
771 | :group 'idlwave-abbrev-and-indent-action | |
772 | :type 'boolean) | |
773 | ||
774 | (defcustom idlwave-reserved-word-upcase nil | |
775 | "*Non-nil means, reserved words will be made upper case via abbrev expansion. | |
776 | If nil case of reserved words is controlled by `idlwave-abbrev-change-case'. | |
777 | Has effect only if in abbrev-mode." | |
778 | :group 'idlwave-abbrev-and-indent-action | |
779 | :type 'boolean) | |
780 | ||
781 | ;;; Action/Expand Tables. | |
782 | ;; | |
783 | ;; The average user may have difficulty modifying this directly. It | |
784 | ;; can be modified/set in idlwave-mode-hook, but it is easier to use | |
785 | ;; idlwave-action-and-binding. See help for idlwave-action-and-binding for | |
786 | ;; examples of how to add an action. | |
787 | ;; | |
788 | ;; The action table is used by `idlwave-indent-line' whereas both the | |
789 | ;; action and expand tables are used by `idlwave-indent-and-action'. In | |
790 | ;; general, the expand table is only used when a line is explicitly | |
791 | ;; indented. Whereas, in addition to being used when the expand table | |
792 | ;; is used, the action table is used when a line is indirectly | |
793 | ;; indented via line splitting, auto-filling or a new line creation. | |
794 | ;; | |
795 | ;; Example actions: | |
796 | ;; | |
797 | ;; Capitalize system vars | |
798 | ;; (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t) | |
799 | ;; | |
800 | ;; Capitalize procedure name | |
801 | ;; (idlwave-action-and-binding "\\<\\(pro\\|function\\)\\>[ \t]*\\<" | |
802 | ;; '(capitalize-word 1) t) | |
803 | ;; | |
804 | ;; Capitalize common block name | |
805 | ;; (idlwave-action-and-binding "\\<common\\>[ \t]+\\<" | |
806 | ;; '(capitalize-word 1) t) | |
807 | ;; Capitalize label | |
808 | ;; (idlwave-action-and-binding (concat "^[ \t]*" idlwave-label) | |
809 | ;; '(capitalize-word -1) t) | |
810 | ||
811 | (defvar idlwave-indent-action-table nil | |
812 | "*Associated array containing action lists of search string (car), | |
813 | and function as a cdr. This table is used by `idlwave-indent-line'. | |
814 | See documentation for `idlwave-do-action' for a complete description of | |
815 | the action lists. | |
816 | ||
817 | Additions to the table are made with `idlwave-action-and-binding' when a | |
818 | binding is not requested. | |
819 | See help on `idlwave-action-and-binding' for examples.") | |
820 | ||
821 | (defvar idlwave-indent-expand-table nil | |
822 | "*Associated array containing action lists of search string (car), | |
823 | and function as a cdr. The table is used by the | |
824 | `idlwave-indent-and-action' function. See documentation for | |
825 | `idlwave-do-action' for a complete description of the action lists. | |
826 | ||
827 | Additions to the table are made with `idlwave-action-and-binding' when a | |
828 | binding is requested. | |
829 | See help on `idlwave-action-and-binding' for examples.") | |
830 | ||
831 | ;;; Documentation header and history keyword --------------------------------- | |
832 | ||
833 | (defgroup idlwave-documentation nil | |
834 | "Options for documenting IDLWAVE files." | |
835 | :group 'idlwave) | |
836 | ||
837 | ;; FIXME: make defcustom? | |
838 | (defvar idlwave-file-header | |
839 | (list nil | |
840 | ";+ | |
841 | ; NAME: | |
842 | ; | |
843 | ; | |
844 | ; | |
845 | ; PURPOSE: | |
846 | ; | |
847 | ; | |
848 | ; | |
849 | ; CATEGORY: | |
850 | ; | |
851 | ; | |
852 | ; | |
853 | ; CALLING SEQUENCE: | |
854 | ; | |
855 | ; | |
856 | ; | |
857 | ; INPUTS: | |
858 | ; | |
859 | ; | |
860 | ; | |
861 | ; OPTIONAL INPUTS: | |
862 | ; | |
863 | ; | |
864 | ; | |
865 | ; KEYWORD PARAMETERS: | |
866 | ; | |
867 | ; | |
868 | ; | |
869 | ; OUTPUTS: | |
870 | ; | |
871 | ; | |
872 | ; | |
873 | ; OPTIONAL OUTPUTS: | |
874 | ; | |
875 | ; | |
876 | ; | |
877 | ; COMMON BLOCKS: | |
878 | ; | |
879 | ; | |
880 | ; | |
881 | ; SIDE EFFECTS: | |
882 | ; | |
883 | ; | |
884 | ; | |
885 | ; RESTRICTIONS: | |
886 | ; | |
887 | ; | |
888 | ; | |
889 | ; PROCEDURE: | |
890 | ; | |
891 | ; | |
892 | ; | |
893 | ; EXAMPLE: | |
894 | ; | |
895 | ; | |
896 | ; | |
897 | ; MODIFICATION HISTORY: | |
898 | ; | |
899 | ;- | |
900 | ") | |
901 | "*A list (PATHNAME STRING) specifying the doc-header template to use for | |
902 | summarizing a file. If PATHNAME is non-nil then this file will be included. | |
903 | Otherwise STRING is used. If NIL, the file summary will be omitted. | |
904 | For example you might set PATHNAME to the path for the | |
905 | lib_template.pro file included in the IDL distribution.") | |
906 | ||
907 | (defcustom idlwave-timestamp-hook 'idlwave-default-insert-timestamp | |
908 | "*The hook function used to update the timestamp of a function." | |
909 | :group 'idlwave-documentation | |
910 | :type 'function) | |
911 | ||
912 | (defcustom idlwave-doc-modifications-keyword "HISTORY" | |
913 | "*The modifications keyword to use with the log documentation commands. | |
914 | A ':' is added to the keyword end. | |
915 | Inserted by doc-header and used to position logs by doc-modification. | |
916 | If nil it will not be inserted." | |
917 | :group 'idlwave-documentation | |
918 | :type 'string) | |
919 | ||
920 | (defcustom idlwave-doclib-start "^;+\\+" | |
921 | "*Regexp matching the start of a document library header." | |
922 | :group 'idlwave-documentation | |
923 | :type 'regexp) | |
924 | ||
925 | (defcustom idlwave-doclib-end "^;+-" | |
926 | "*Regexp matching the end of a document library header." | |
927 | :group 'idlwave-documentation | |
928 | :type 'regexp) | |
929 | ||
930 | ;;; External Programs ------------------------------------------------------- | |
931 | ||
932 | (defgroup idlwave-external-programs nil | |
933 | "Miscellaneous options for IDLWAVE mode." | |
934 | :group 'idlwave) | |
935 | ||
936 | ;; WARNING: The following variable has recently been moved from | |
595ab50b | 937 | ;; idlw-shell.el to this file. I hope this does not break |
f32b3b91 CD |
938 | ;; anything. |
939 | ||
940 | (defcustom idlwave-shell-explicit-file-name "idl" | |
941 | "*If non-nil, is the command to run IDL. | |
942 | Should be an absolute file path or path relative to the current environment | |
943 | execution search path." | |
944 | :group 'idlwave-external-programs | |
945 | :type 'string) | |
946 | ||
947 | ;; FIXME: Document a case when is this needed. | |
948 | (defcustom idlwave-shell-command-line-options nil | |
949 | "*A list of command line options for calling the IDL program." | |
950 | :type '(repeat (string :value "")) | |
951 | :group 'idlwave-external-programs) | |
952 | ||
953 | (defcustom idlwave-help-application "idlhelp" | |
954 | "*The external application providing reference help for programming." | |
955 | :group 'idlwave-external-programs | |
956 | :type 'string) | |
957 | ||
958 | ;;; Miscellaneous variables ------------------------------------------------- | |
959 | ||
960 | (defgroup idlwave-misc nil | |
961 | "Miscellaneous options for IDLWAVE mode." | |
962 | :group 'idlwave) | |
963 | ||
964 | (defcustom idlwave-startup-message t | |
965 | "*Non-nil displays a startup message when `idlwave-mode' is first called." | |
966 | :group 'idlwave-misc | |
967 | :type 'boolean) | |
968 | ||
969 | (defcustom idlwave-default-font-lock-items | |
970 | '(pros-and-functions batch-files idl-keywords label goto | |
971 | common-blocks class-arrows) | |
972 | "Items which should be fontified on the default fontification level 2. | |
973 | IDLWAVE defines 3 levels of fontification. Level 1 is very little, level 3 | |
974 | is everything and level 2 is specified by this list. | |
975 | This variable must be set before IDLWAVE gets loaded. It is | |
976 | a list of symbols, the following symbols are allowed. | |
977 | ||
978 | pros-and-functions Procedure and Function definitions | |
979 | batch-files Batch Files | |
980 | idl-keywords IDL Keywords | |
981 | label Statement Labels | |
982 | goto Goto Statements | |
983 | common-blocks Common Blocks | |
984 | keyword-parameters Keyword Parameters in routine definitions and calls | |
985 | system-variables System Variables | |
986 | fixme FIXME: Warning in comments (on XEmacs only v. 21.0 and up) | |
987 | class-arrows Object Arrows with class property" | |
988 | :group 'idlwave-misc | |
989 | :type '(set | |
990 | :inline t :greedy t | |
991 | (const :tag "Procedure and Function definitions" pros-and-functions) | |
992 | (const :tag "Batch Files" batch-files) | |
993 | (const :tag "IDL Keywords (reserved words)" idl-keywords) | |
994 | (const :tag "Statement Labels" label) | |
995 | (const :tag "Goto Statements" goto) | |
996 | (const :tag "Common Blocks" common-blocks) | |
997 | (const :tag "Keyword Parameters" keyword-parameters) | |
998 | (const :tag "System Variables" system-variables) | |
999 | (const :tag "FIXME: Warning" fixme) | |
1000 | (const :tag "Object Arrows with class property " class-arrows))) | |
1001 | ||
1002 | (defcustom idlwave-mode-hook nil | |
1003 | "Normal hook. Executed when a buffer is put into `idlwave-mode'." | |
1004 | :group 'idlwave-misc | |
1005 | :type 'hook) | |
1006 | ||
1007 | (defcustom idlwave-load-hook nil | |
1008 | "Normal hook. Executed when idlwave.el is loaded." | |
1009 | :group 'idlwave-misc | |
1010 | :type 'hook) | |
1011 | ||
15e42531 CD |
1012 | (defvar idlwave-experimental nil |
1013 | "Non-nil means turn on a few experimental features. | |
1014 | This variable is only for the maintainer, to test difficult stuff, | |
1015 | while still distributing stable releases. | |
1016 | As a user, you should not set this to t.") | |
1017 | ||
f32b3b91 CD |
1018 | ;;; |
1019 | ;;; End customization variables section | |
1020 | ;;; | |
1021 | ||
1022 | ;;; Non customization variables | |
1023 | ||
1024 | ;;; font-lock mode - Additions by Phil Williams, Ulrik Dickow and | |
1025 | ;;; Simon Marshall <simon@gnu.ai.mit.edu> | |
1026 | ;;; and Carsten Dominik... | |
1027 | ||
1028 | (defconst idlwave-font-lock-keywords-1 nil | |
1029 | "Subdued level highlighting for IDLWAVE mode.") | |
1030 | ||
1031 | (defconst idlwave-font-lock-keywords-2 nil | |
1032 | "Medium level highlighting for IDLWAVE mode.") | |
1033 | ||
1034 | (defconst idlwave-font-lock-keywords-3 nil | |
1035 | "Gaudy level highlighting for IDLWAVE mode.") | |
1036 | ||
1037 | (let* ((oldp (or (string-match "Lucid" emacs-version) | |
1038 | (not (boundp 'emacs-minor-version)) | |
1039 | (and (<= emacs-major-version 19) | |
1040 | (<= emacs-minor-version 29)))) | |
1041 | ||
1042 | ;; The following are the reserved words in IDL. Maybe we should | |
1043 | ;; highlight some more stuff as well? | |
1044 | (idl-keywords | |
595ab50b CD |
1045 | ;; To update this regexp, update the list of keywords and |
1046 | ;; evaluate the form. | |
1047 | ; (insert | |
1048 | ; (concat | |
1049 | ; "\"\\\\<" | |
1050 | ; (regexp-opt | |
1051 | ; '("and" "or" "xor" "not" | |
1052 | ; "eq" "ge" "gt" "le" "lt" "ne" | |
1053 | ; "for" "do" "endfor" | |
1054 | ; "if" "then" "endif" "else" "endelse" | |
1055 | ; "case" "of" "endcase" | |
1056 | ; "begin" "end" | |
1057 | ; "repeat" "until" "endrep" | |
1058 | ; "while" "endwhile" | |
1059 | ; "goto" "return" | |
1060 | ; "inherits" "mod" | |
1061 | ; "on_error" "on_ioerror")) ; on_error is not officially reserved | |
1062 | ; "\\\\>\"")) | |
f32b3b91 CD |
1063 | (concat "\\<\\(" |
1064 | "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\(case\\|else\\|" | |
1065 | "for\\|if\\|rep\\|while\\)?\\|q\\)\\|for\\|g\\(oto\\|[et]\\)" | |
1066 | "\\|i\\(f\\|nherits\\)\\|l[et]\\|mod\\|n\\(e\\|ot\\)\\|" | |
1067 | "o\\(n_ioerror\\|[fr]\\)\\|re\\(peat\\|turn\\)\\|then\\|" | |
1068 | "until\\|while\\|xor" | |
1069 | "\\)\\>")) | |
1070 | ||
1071 | ;; Procedure declarations. Fontify keyword plus procedure name. | |
1072 | ;; Function declarations. Fontify keyword plus function name. | |
1073 | (pros-and-functions | |
1074 | '("\\<\\(function\\|pro\\)\\>[ \t]+\\(\\sw+\\(::\\sw+\\)?\\)" | |
1075 | (1 font-lock-keyword-face) | |
1076 | (2 font-lock-function-name-face nil t))) | |
1077 | ||
1078 | ;; Common blocks | |
1079 | (common-blocks | |
1080 | '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" | |
1081 | (1 font-lock-keyword-face) ; "common" | |
1082 | (2 font-lock-reference-face nil t) ; block name | |
1083 | (font-lock-match-c++-style-declaration-item-and-skip-to-next | |
1084 | ;; Start with point after block name and comma | |
1085 | (goto-char (match-end 0)) ; needed for XEmacs, could be nil | |
1086 | nil | |
1087 | (1 font-lock-variable-name-face) ; variable names | |
1088 | ))) | |
1089 | ||
1090 | ;; Batch files | |
1091 | (batch-files | |
1092 | '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face))) | |
1093 | ||
1094 | ;; FIXME warning. | |
1095 | (fixme | |
1096 | '("\\<FIXME:" (0 font-lock-warning-face t))) | |
1097 | ||
1098 | ;; Labels | |
1099 | (label | |
1100 | '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-reference-face))) | |
1101 | ||
1102 | ;; The goto statement and its label | |
1103 | (goto | |
1104 | '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)" | |
1105 | (1 font-lock-keyword-face) | |
1106 | (2 font-lock-reference-face))) | |
1107 | ||
1108 | ;; Named parameters, like /xlog or ,xrange=[] | |
1109 | ;; This is anchored to the comma preceeding the keyword. | |
595ab50b CD |
1110 | ;; Treats continuation lines, works only during whole buffer |
1111 | ;; fontification. Slow, use it only in fancy fontification. | |
f32b3b91 | 1112 | (keyword-parameters |
15e42531 CD |
1113 | '("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\\(\n[ \t]*;.*\\)*\n[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)" |
1114 | (5 font-lock-reference-face))) | |
f32b3b91 | 1115 | |
595ab50b | 1116 | ;; System variables start with a bang. |
f32b3b91 | 1117 | (system-variables |
15e42531 | 1118 | '("\\(![a-zA-Z_0-9]+\\(\\.\\sw+\\)?\\)" |
f32b3b91 CD |
1119 | (1 font-lock-variable-name-face))) |
1120 | ||
1121 | ;; Special and unusual operators (not used because too noisy) | |
1122 | (special-operators | |
1123 | '("[<>#]" (0 font-lock-keyword-face))) | |
1124 | ||
1125 | ;; All operators (not used because too noisy) | |
1126 | (all-operators | |
1127 | '("[-*^#+<>/]" (0 font-lock-keyword-face))) | |
1128 | ||
1129 | ;; Arrows with text property `idlwave-class' | |
1130 | (class-arrows | |
1131 | (list 'idlwave-match-class-arrows | |
1132 | (list 0 (if (featurep 'xemacs) | |
1133 | idlwave-class-arrow-face | |
1134 | 'idlwave-class-arrow-face)))) | |
1135 | ||
1136 | ) | |
1137 | ||
1138 | ;; The following lines are just a dummy to make the compiler shut up | |
1139 | ;; about variables bound but not used. | |
1140 | (setq oldp oldp | |
1141 | idl-keywords idl-keywords | |
1142 | pros-and-functions pros-and-functions | |
1143 | common-blocks common-blocks | |
1144 | batch-files batch-files | |
1145 | fixme fixme | |
1146 | label label | |
1147 | goto goto | |
1148 | keyword-parameters keyword-parameters | |
1149 | system-variables system-variables | |
1150 | special-operators special-operators | |
1151 | all-operators all-operators | |
1152 | class-arrows class-arrows) | |
1153 | ||
1154 | (setq idlwave-font-lock-keywords-1 | |
1155 | (list pros-and-functions | |
1156 | batch-files | |
1157 | )) | |
1158 | ||
1159 | (setq idlwave-font-lock-keywords-2 | |
1160 | (mapcar 'symbol-value idlwave-default-font-lock-items)) | |
1161 | ||
1162 | (setq idlwave-font-lock-keywords-3 | |
1163 | (list pros-and-functions | |
1164 | batch-files | |
1165 | idl-keywords | |
1166 | label goto | |
1167 | common-blocks | |
1168 | keyword-parameters | |
1169 | system-variables | |
1170 | class-arrows | |
1171 | )) | |
1172 | ) | |
1173 | ||
1174 | (defun idlwave-match-class-arrows (limit) | |
1175 | ;; Match an object arrow with class property | |
1176 | (and idlwave-store-inquired-class | |
1177 | (re-search-forward "->" limit 'limit) | |
1178 | (get-text-property (match-beginning 0) 'idlwave-class))) | |
1179 | ||
1180 | (defvar idlwave-font-lock-keywords idlwave-font-lock-keywords-2 | |
1181 | "Default expressions to highlight in IDLWAVE mode.") | |
1182 | ||
1183 | (defvar idlwave-font-lock-defaults | |
1184 | '((idlwave-font-lock-keywords | |
1185 | idlwave-font-lock-keywords-1 | |
1186 | idlwave-font-lock-keywords-2 | |
1187 | idlwave-font-lock-keywords-3) | |
1188 | nil t | |
1189 | ((?$ . "w") (?_ . "w") (?. . "w")) | |
1190 | beginning-of-line)) | |
1191 | ||
1192 | (put 'idlwave-mode 'font-lock-defaults | |
1193 | idlwave-font-lock-defaults) ; XEmacs | |
1194 | ||
1195 | (defconst idlwave-comment-line-start-skip "^[ \t]*;" | |
1196 | "Regexp to match the start of a full-line comment. | |
1197 | That is the _beginning_ of a line containing a comment delimiter `;' preceded | |
1198 | only by whitespace.") | |
1199 | ||
1200 | (defconst idlwave-begin-block-reg "\\<\\(pro\\|function\\|begin\\|case\\)\\>" | |
1201 | "Regular expression to find the beginning of a block. The case does | |
1202 | not matter. The search skips matches in comments.") | |
1203 | ||
1204 | (defconst idlwave-begin-unit-reg "\\<\\(pro\\|function\\)\\>\\|\\`" | |
1205 | "Regular expression to find the beginning of a unit. The case does | |
1206 | not matter.") | |
1207 | ||
1208 | (defconst idlwave-end-unit-reg "\\<\\(pro\\|function\\)\\>\\|\\'" | |
1209 | "Regular expression to find the line that indicates the end of unit. | |
1210 | This line is the end of buffer or the start of another unit. The case does | |
1211 | not matter. The search skips matches in comments.") | |
1212 | ||
1213 | (defconst idlwave-continue-line-reg "\\<\\$" | |
1214 | "Regular expression to match a continued line.") | |
1215 | ||
1216 | (defconst idlwave-end-block-reg | |
1217 | "\\<end\\(\\|case\\|else\\|for\\|if\\|rep\\|while\\)\\>" | |
1218 | "Regular expression to find the end of a block. The case does | |
1219 | not matter. The search skips matches found in comments.") | |
1220 | ||
1221 | (defconst idlwave-block-matches | |
1222 | '(("pro" . "end") | |
1223 | ("function" . "end") | |
1224 | ("case" . "endcase") | |
1225 | ("else" . "endelse") | |
1226 | ("for" . "endfor") | |
1227 | ("then" . "endif") | |
1228 | ("repeat" . "endrep") | |
1229 | ("while" . "endwhile")) | |
1230 | "Matches between statements and the corresponding END variant. | |
1231 | The cars are the reserved words starting a block. If the block really | |
1232 | begins with BEGIN, the cars are the reserved words before the begin | |
1233 | which can be used to identify the block type. | |
1234 | This is used to check for the correct END type, to close blocks and | |
1235 | to expand generic end statements to their detailed form.") | |
1236 | ||
1237 | (defconst idlwave-block-match-regexp | |
1238 | "\\<\\(else\\|for\\|then\\|repeat\\|while\\)\\>" | |
1239 | "Regular expression matching reserved words which can stand before | |
1240 | blocks starting with a BEGIN statement. The matches must have associations | |
1241 | `idlwave-block-matches'") | |
1242 | ||
1243 | (defconst idlwave-identifier "[a-zA-Z][a-zA-Z0-9$_]*" | |
1244 | "Regular expression matching an IDL identifier.") | |
1245 | ||
1246 | (defconst idlwave-sysvar (concat "!" idlwave-identifier) | |
1247 | "Regular expression matching IDL system variables.") | |
1248 | ||
1249 | (defconst idlwave-variable (concat idlwave-identifier "\\|" idlwave-sysvar) | |
1250 | "Regular expression matching IDL variable names.") | |
1251 | ||
1252 | (defconst idlwave-label (concat idlwave-identifier ":") | |
1253 | "Regular expression matching IDL labels.") | |
1254 | ||
1255 | (defconst idlwave-statement-match | |
1256 | (list | |
1257 | ;; "endif else" is the the only possible "end" that can be | |
1258 | ;; followed by a statement on the same line. | |
1259 | '(endelse . ("end\\(\\|if\\)\\s +else" "end\\(\\|if\\)\\s +else")) | |
1260 | ;; all other "end"s can not be followed by a statement. | |
1261 | (cons 'end (list idlwave-end-block-reg nil)) | |
1262 | '(if . ("if\\>" "then")) | |
1263 | '(for . ("for\\>" "do")) | |
1264 | '(begin . ("begin\\>" nil)) | |
1265 | '(pdef . ("pro\\>\\|function\\>" nil)) | |
1266 | '(while . ("while\\>" "do")) | |
1267 | '(repeat . ("repeat\\>" "repeat")) | |
1268 | '(goto . ("goto\\>" nil)) | |
1269 | '(case . ("case\\>" nil)) | |
1270 | (cons 'call (list (concat idlwave-identifier "\\(\\s *$\\|\\s *,\\)") nil)) | |
595ab50b | 1271 | '(assign . ("[^=>\n]*=" nil))) |
f32b3b91 CD |
1272 | |
1273 | "Associated list of statement matching regular expressions. | |
1274 | Each regular expression matches the start of an IDL statement. The | |
1275 | first element of each association is a symbol giving the statement | |
1276 | type. The associated value is a list. The first element of this list | |
1277 | is a regular expression matching the start of an IDL statement for | |
1278 | identifying the statement type. The second element of this list is a | |
1279 | regular expression for finding a substatement for the type. The | |
1280 | substatement starts after the end of the found match modulo | |
1281 | whitespace. If it is nil then the statement has no substatement. The | |
1282 | list order matters since matching an assignment statement exactly is | |
1283 | not possible without parsing. Thus assignment statement become just | |
15e42531 | 1284 | the leftover unidentified statements containing an equal sign." ) |
f32b3b91 CD |
1285 | |
1286 | (defvar idlwave-fill-function 'auto-fill-function | |
1287 | "IDL mode auto fill function.") | |
1288 | ||
1289 | (defvar idlwave-comment-indent-function 'comment-indent-function | |
1290 | "IDL mode comment indent function.") | |
1291 | ||
1292 | ;; Note that this is documented in the v18 manuals as being a string | |
1293 | ;; of length one rather than a single character. | |
1294 | ;; The code in this file accepts either format for compatibility. | |
1295 | (defvar idlwave-comment-indent-char ?\ | |
1296 | "Character to be inserted for IDL comment indentation. | |
1297 | Normally a space.") | |
1298 | ||
1299 | (defconst idlwave-continuation-char ?$ | |
1300 | "Character which is inserted as a last character on previous line by | |
1301 | \\[idlwave-split-line] to begin a continuation line. Normally $.") | |
1302 | ||
15e42531 | 1303 | (defconst idlwave-mode-version " 4.2") |
f32b3b91 CD |
1304 | |
1305 | (defmacro idlwave-keyword-abbrev (&rest args) | |
1306 | "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." | |
1307 | (` (quote (lambda () | |
1308 | (, (append '(idlwave-check-abbrev) args)))))) | |
1309 | ||
1310 | ;; If I take the time I can replace idlwave-keyword-abbrev with | |
1311 | ;; idlwave-code-abbrev and remove the quoted abbrev check from | |
1312 | ;; idlwave-check-abbrev. Then, e.g, (idlwave-keyword-abbrev 0 t) becomes | |
1313 | ;; (idlwave-code-abbrev idlwave-check-abbrev 0 t). In fact I should change | |
1314 | ;; the name of idlwave-check-abbrev to something like idlwave-modify-abbrev. | |
1315 | ||
1316 | (defmacro idlwave-code-abbrev (&rest args) | |
1317 | "Creates a function for abbrev hooks that ensures abbrevs are not quoted. | |
1318 | Specifically, if the abbrev is in a comment or string it is unexpanded. | |
1319 | Otherwise ARGS forms a list that is evaluated." | |
1320 | (` (quote (lambda () | |
1321 | (, (prin1-to-string args)) ;; Puts the code in the doc string | |
15e42531 CD |
1322 | (if (idlwave-quoted) |
1323 | (progn (unexpand-abbrev) nil) | |
f32b3b91 CD |
1324 | (, (append args))))))) |
1325 | ||
1326 | (defvar idlwave-mode-map (make-sparse-keymap) | |
1327 | "Keymap used in IDL mode.") | |
1328 | ||
1329 | (defvar idlwave-mode-syntax-table (make-syntax-table) | |
1330 | "Syntax table in use in `idlwave-mode' buffers.") | |
1331 | ||
1332 | (modify-syntax-entry ?+ "." idlwave-mode-syntax-table) | |
1333 | (modify-syntax-entry ?- "." idlwave-mode-syntax-table) | |
1334 | (modify-syntax-entry ?* "." idlwave-mode-syntax-table) | |
1335 | (modify-syntax-entry ?/ "." idlwave-mode-syntax-table) | |
1336 | (modify-syntax-entry ?^ "." idlwave-mode-syntax-table) | |
1337 | (modify-syntax-entry ?# "." idlwave-mode-syntax-table) | |
1338 | (modify-syntax-entry ?= "." idlwave-mode-syntax-table) | |
1339 | (modify-syntax-entry ?% "." idlwave-mode-syntax-table) | |
1340 | (modify-syntax-entry ?< "." idlwave-mode-syntax-table) | |
1341 | (modify-syntax-entry ?> "." idlwave-mode-syntax-table) | |
1342 | (modify-syntax-entry ?\' "\"" idlwave-mode-syntax-table) | |
1343 | (modify-syntax-entry ?\" "\"" idlwave-mode-syntax-table) | |
1344 | (modify-syntax-entry ?\\ "." idlwave-mode-syntax-table) | |
1345 | (modify-syntax-entry ?_ "_" idlwave-mode-syntax-table) | |
1346 | (modify-syntax-entry ?{ "(}" idlwave-mode-syntax-table) | |
1347 | (modify-syntax-entry ?} "){" idlwave-mode-syntax-table) | |
1348 | (modify-syntax-entry ?$ "_" idlwave-mode-syntax-table) | |
1349 | (modify-syntax-entry ?. "." idlwave-mode-syntax-table) | |
1350 | (modify-syntax-entry ?\; "<" idlwave-mode-syntax-table) | |
1351 | (modify-syntax-entry ?\n ">" idlwave-mode-syntax-table) | |
1352 | (modify-syntax-entry ?\f ">" idlwave-mode-syntax-table) | |
1353 | ||
1354 | (defvar idlwave-find-symbol-syntax-table | |
1355 | (copy-syntax-table idlwave-mode-syntax-table) | |
1356 | "Syntax table that treats symbol characters as word characters.") | |
1357 | ||
1358 | (modify-syntax-entry ?$ "w" idlwave-find-symbol-syntax-table) | |
1359 | (modify-syntax-entry ?_ "w" idlwave-find-symbol-syntax-table) | |
1360 | ||
15e42531 CD |
1361 | (defmacro idlwave-with-special-syntax (&rest body) |
1362 | "Execute BODY with a different systax table." | |
1363 | `(let ((saved-syntax (syntax-table))) | |
1364 | (unwind-protect | |
1365 | (progn | |
1366 | (set-syntax-table idlwave-find-symbol-syntax-table) | |
1367 | ,@body) | |
1368 | (set-syntax-table saved-syntax)))) | |
1369 | ||
f32b3b91 CD |
1370 | (defun idlwave-action-and-binding (key cmd &optional select) |
1371 | "KEY and CMD are made into a key binding and an indent action. | |
1372 | KEY is a string - same as for the `define-key' function. CMD is a | |
1373 | function of no arguments or a list to be evaluated. CMD is bound to | |
1374 | KEY in `idlwave-mode-map' by defining an anonymous function calling | |
1375 | `self-insert-command' followed by CMD. If KEY contains more than one | |
1376 | character a binding will only be set if SELECT is 'both. | |
1377 | ||
1378 | (KEY . CMD\ is also placed in the `idlwave-indent-expand-table', | |
1379 | replacing any previous value for KEY. If a binding is not set then it | |
1380 | will instead be placed in `idlwave-indent-action-table'. | |
1381 | ||
1382 | If the optional argument SELECT is nil then an action and binding are | |
1383 | created. If SELECT is 'noaction, then a binding is always set and no | |
1384 | action is created. If SELECT is 'both then an action and binding | |
1385 | will both be created even if KEY contains more than one character. | |
1386 | Otherwise, if SELECT is non-nil then only an action is created. | |
1387 | ||
1388 | Some examples: | |
1389 | No spaces before and 1 after a comma | |
1390 | (idlwave-action-and-binding \",\" '(idlwave-surround 0 1)) | |
1391 | A minimum of 1 space before and after `=' (see `idlwave-expand-equal'). | |
1392 | (idlwave-action-and-binding \"=\" '(idlwave-expand-equal -1 -1)) | |
1393 | Capitalize system variables - action only | |
1394 | (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t)" | |
1395 | (if (not (equal select 'noaction)) | |
1396 | ;; Add action | |
1397 | (let* ((table (if select 'idlwave-indent-action-table | |
1398 | 'idlwave-indent-expand-table)) | |
1399 | (cell (assoc key (eval table)))) | |
1400 | (if cell | |
1401 | ;; Replace action command | |
1402 | (setcdr cell cmd) | |
1403 | ;; New action | |
1404 | (set table (append (eval table) (list (cons key cmd))))))) | |
1405 | ;; Make key binding for action | |
1406 | (if (or (and (null select) (= (length key) 1)) | |
1407 | (equal select 'noaction) | |
1408 | (equal select 'both)) | |
1409 | (define-key idlwave-mode-map key | |
1410 | (append '(lambda () | |
1411 | (interactive) | |
1412 | (self-insert-command 1)) | |
1413 | (list (if (listp cmd) | |
1414 | cmd | |
1415 | (list cmd))))))) | |
1416 | ||
1417 | (fset 'idlwave-debug-map (make-sparse-keymap)) | |
1418 | ||
595ab50b | 1419 | (define-key idlwave-mode-map "\C-c " 'idlwave-hard-tab) |
15e42531 | 1420 | (define-key idlwave-mode-map [(control tab)] 'idlwave-hard-tab) |
595ab50b | 1421 | ;(define-key idlwave-mode-map "\C-c\C- " 'idlwave-hard-tab) |
f32b3b91 CD |
1422 | (define-key idlwave-mode-map "'" 'idlwave-show-matching-quote) |
1423 | (define-key idlwave-mode-map "\"" 'idlwave-show-matching-quote) | |
1424 | (define-key idlwave-mode-map "\C-c;" 'idlwave-toggle-comment-region) | |
1425 | (define-key idlwave-mode-map "\C-\M-a" 'idlwave-beginning-of-subprogram) | |
1426 | (define-key idlwave-mode-map "\C-\M-e" 'idlwave-end-of-subprogram) | |
1427 | (define-key idlwave-mode-map "\C-c{" 'idlwave-beginning-of-block) | |
1428 | (define-key idlwave-mode-map "\C-c}" 'idlwave-end-of-block) | |
1429 | (define-key idlwave-mode-map "\C-c]" 'idlwave-close-block) | |
1430 | (define-key idlwave-mode-map "\M-\C-h" 'idlwave-mark-subprogram) | |
1431 | (define-key idlwave-mode-map "\M-\C-n" 'idlwave-forward-block) | |
1432 | (define-key idlwave-mode-map "\M-\C-p" 'idlwave-backward-block) | |
1433 | (define-key idlwave-mode-map "\M-\C-d" 'idlwave-down-block) | |
1434 | (define-key idlwave-mode-map "\M-\C-u" 'idlwave-backward-up-block) | |
1435 | (define-key idlwave-mode-map "\M-\r" 'idlwave-split-line) | |
1436 | (define-key idlwave-mode-map "\M-\C-q" 'idlwave-indent-subprogram) | |
1437 | (define-key idlwave-mode-map "\C-c\C-p" 'idlwave-previous-statement) | |
1438 | (define-key idlwave-mode-map "\C-c\C-n" 'idlwave-next-statement) | |
1439 | ;; (define-key idlwave-mode-map "\r" 'idlwave-newline) | |
1440 | ;; (define-key idlwave-mode-map "\t" 'idlwave-indent-line) | |
1441 | (define-key idlwave-mode-map "\C-c\C-a" 'idlwave-auto-fill-mode) | |
1442 | (define-key idlwave-mode-map "\M-q" 'idlwave-fill-paragraph) | |
1443 | (define-key idlwave-mode-map "\M-s" 'idlwave-edit-in-idlde) | |
1444 | (define-key idlwave-mode-map "\C-c\C-h" 'idlwave-doc-header) | |
1445 | (define-key idlwave-mode-map "\C-c\C-m" 'idlwave-doc-modification) | |
1446 | (define-key idlwave-mode-map "\C-c\C-c" 'idlwave-case) | |
1447 | (define-key idlwave-mode-map "\C-c\C-d" 'idlwave-debug-map) | |
1448 | (define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) | |
15e42531 | 1449 | (define-key idlwave-mode-map "\C-c\C-d\C-b" 'idlwave-shell-break-here) |
f32b3b91 CD |
1450 | (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-for) |
1451 | ;; (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-function) | |
1452 | ;; (define-key idlwave-mode-map "\C-c\C-p" 'idlwave-procedure) | |
1453 | (define-key idlwave-mode-map "\C-c\C-r" 'idlwave-repeat) | |
1454 | (define-key idlwave-mode-map "\C-c\C-w" 'idlwave-while) | |
15e42531 | 1455 | (define-key idlwave-mode-map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers) |
f32b3b91 CD |
1456 | (define-key idlwave-mode-map "\C-c\C-s" 'idlwave-shell) |
1457 | (define-key idlwave-mode-map "\C-c\C-l" 'idlwave-shell-recenter-shell-window) | |
15e42531 | 1458 | (define-key idlwave-mode-map "\C-c\C-b" 'idlwave-list-buffer-load-path-shadows) |
22d5821d CD |
1459 | (autoload 'idlwave-shell "idlw-shell" |
1460 | "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'." t) | |
8c7b4ec8 EZ |
1461 | (autoload 'idlwave-shell-send-command "idlw-shell") |
1462 | (autoload 'idlwave-shell-recenter-shell-window "idlw-shell" | |
f32b3b91 | 1463 | "Run `idlwave-shell' and switch back to current window" t) |
8c7b4ec8 | 1464 | (autoload 'idlwave-shell-save-and-run "idlw-shell" |
f32b3b91 | 1465 | "Save and run buffer under the shell." t) |
15e42531 CD |
1466 | (autoload 'idlwave-shell-break-here "idlw-shell" |
1467 | "Set breakpoint in current line." t) | |
f32b3b91 CD |
1468 | (define-key idlwave-mode-map "\C-c\C-v" 'idlwave-find-module) |
1469 | (define-key idlwave-mode-map "\C-c?" 'idlwave-routine-info) | |
15e42531 | 1470 | (define-key idlwave-mode-map "\M-?" 'idlwave-context-help) |
f32b3b91 CD |
1471 | (define-key idlwave-mode-map [(meta tab)] 'idlwave-complete) |
1472 | (define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info) | |
1473 | (define-key idlwave-mode-map "\C-c=" 'idlwave-resolve) | |
15e42531 CD |
1474 | (define-key idlwave-mode-map |
1475 | (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) | |
1476 | 'idlwave-mouse-context-help) | |
f32b3b91 CD |
1477 | |
1478 | ;; Set action and key bindings. | |
1479 | ;; See description of the function `idlwave-action-and-binding'. | |
1480 | ;; Automatically add spaces for the following characters | |
1481 | (idlwave-action-and-binding "&" '(idlwave-surround -1 -1)) | |
1482 | (idlwave-action-and-binding "<" '(idlwave-surround -1 -1)) | |
1483 | (idlwave-action-and-binding ">" '(idlwave-surround -1 -1 '(?-))) | |
595ab50b | 1484 | (idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2)) |
f32b3b91 CD |
1485 | (idlwave-action-and-binding "," '(idlwave-surround 0 -1)) |
1486 | ;; Automatically add spaces to equal sign if not keyword | |
1487 | (idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1)) | |
1488 | ||
1489 | ;;; | |
1490 | ;;; Abbrev Section | |
1491 | ;;; | |
1492 | ;;; When expanding abbrevs and the abbrev hook moves backward, an extra | |
1493 | ;;; space is inserted (this is the space typed by the user to expanded | |
1494 | ;;; the abbrev). | |
1495 | ;;; | |
1496 | ||
1497 | (condition-case nil | |
1498 | (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) | |
1499 | "w" idlwave-mode-syntax-table) | |
1500 | (error nil)) | |
1501 | ||
1502 | (defvar idlwave-mode-abbrev-table nil | |
1503 | "Abbreviation table used for IDLWAVE mode") | |
1504 | (define-abbrev-table 'idlwave-mode-abbrev-table ()) | |
1505 | (let ((abbrevs-changed nil) ;; mask the current value to avoid save | |
1506 | (tb idlwave-mode-abbrev-table) | |
1507 | (c idlwave-abbrev-start-char)) | |
1508 | ;; | |
1509 | ;; Templates | |
1510 | ;; | |
1511 | (define-abbrev tb (concat c "c") "" (idlwave-code-abbrev idlwave-case)) | |
1512 | (define-abbrev tb (concat c "f") "" (idlwave-code-abbrev idlwave-for)) | |
1513 | (define-abbrev tb (concat c "fu") "" (idlwave-code-abbrev idlwave-function)) | |
1514 | (define-abbrev tb (concat c "pr") "" (idlwave-code-abbrev idlwave-procedure)) | |
1515 | (define-abbrev tb (concat c "r") "" (idlwave-code-abbrev idlwave-repeat)) | |
1516 | (define-abbrev tb (concat c "w") "" (idlwave-code-abbrev idlwave-while)) | |
1517 | (define-abbrev tb (concat c "i") "" (idlwave-code-abbrev idlwave-if)) | |
1518 | (define-abbrev tb (concat c "elif") "" (idlwave-code-abbrev idlwave-elif)) | |
1519 | ;; | |
1520 | ;; Keywords, system functions, conversion routines | |
1521 | ;; | |
1522 | (define-abbrev tb (concat c "b") "begin" (idlwave-keyword-abbrev 0 t)) | |
1523 | (define-abbrev tb (concat c "co") "common" (idlwave-keyword-abbrev 0 t)) | |
1524 | (define-abbrev tb (concat c "cb") "byte()" (idlwave-keyword-abbrev 1)) | |
1525 | (define-abbrev tb (concat c "cx") "fix()" (idlwave-keyword-abbrev 1)) | |
1526 | (define-abbrev tb (concat c "cl") "long()" (idlwave-keyword-abbrev 1)) | |
1527 | (define-abbrev tb (concat c "cf") "float()" (idlwave-keyword-abbrev 1)) | |
1528 | (define-abbrev tb (concat c "cs") "string()" (idlwave-keyword-abbrev 1)) | |
1529 | (define-abbrev tb (concat c "cc") "complex()" (idlwave-keyword-abbrev 1)) | |
1530 | (define-abbrev tb (concat c "cd") "double()" (idlwave-keyword-abbrev 1)) | |
1531 | (define-abbrev tb (concat c "e") "else" (idlwave-keyword-abbrev 0 t)) | |
1532 | (define-abbrev tb (concat c "ec") "endcase" 'idlwave-show-begin) | |
1533 | (define-abbrev tb (concat c "ee") "endelse" 'idlwave-show-begin) | |
1534 | (define-abbrev tb (concat c "ef") "endfor" 'idlwave-show-begin) | |
1535 | (define-abbrev tb (concat c "ei") "endif else if" 'idlwave-show-begin) | |
1536 | (define-abbrev tb (concat c "el") "endif else" 'idlwave-show-begin) | |
1537 | (define-abbrev tb (concat c "en") "endif" 'idlwave-show-begin) | |
1538 | (define-abbrev tb (concat c "er") "endrep" 'idlwave-show-begin) | |
1539 | (define-abbrev tb (concat c "ew") "endwhile" 'idlwave-show-begin) | |
1540 | (define-abbrev tb (concat c "g") "goto," (idlwave-keyword-abbrev 0 t)) | |
1541 | (define-abbrev tb (concat c "h") "help," (idlwave-keyword-abbrev 0)) | |
1542 | (define-abbrev tb (concat c "k") "keyword_set()" (idlwave-keyword-abbrev 1)) | |
1543 | (define-abbrev tb (concat c "n") "n_elements()" (idlwave-keyword-abbrev 1)) | |
1544 | (define-abbrev tb (concat c "on") "on_error," (idlwave-keyword-abbrev 0)) | |
1545 | (define-abbrev tb (concat c "oi") "on_ioerror," (idlwave-keyword-abbrev 0 1)) | |
1546 | (define-abbrev tb (concat c "ow") "openw," (idlwave-keyword-abbrev 0)) | |
1547 | (define-abbrev tb (concat c "or") "openr," (idlwave-keyword-abbrev 0)) | |
1548 | (define-abbrev tb (concat c "ou") "openu," (idlwave-keyword-abbrev 0)) | |
1549 | (define-abbrev tb (concat c "p") "print," (idlwave-keyword-abbrev 0)) | |
1550 | (define-abbrev tb (concat c "pt") "plot," (idlwave-keyword-abbrev 0)) | |
1551 | (define-abbrev tb (concat c "re") "read," (idlwave-keyword-abbrev 0)) | |
1552 | (define-abbrev tb (concat c "rf") "readf," (idlwave-keyword-abbrev 0)) | |
1553 | (define-abbrev tb (concat c "ru") "readu," (idlwave-keyword-abbrev 0)) | |
1554 | (define-abbrev tb (concat c "rt") "return" (idlwave-keyword-abbrev 0)) | |
1555 | (define-abbrev tb (concat c "sc") "strcompress()" (idlwave-keyword-abbrev 1)) | |
1556 | (define-abbrev tb (concat c "sn") "strlen()" (idlwave-keyword-abbrev 1)) | |
1557 | (define-abbrev tb (concat c "sl") "strlowcase()" (idlwave-keyword-abbrev 1)) | |
1558 | (define-abbrev tb (concat c "su") "strupcase()" (idlwave-keyword-abbrev 1)) | |
1559 | (define-abbrev tb (concat c "sm") "strmid()" (idlwave-keyword-abbrev 1)) | |
1560 | (define-abbrev tb (concat c "sp") "strpos()" (idlwave-keyword-abbrev 1)) | |
1561 | (define-abbrev tb (concat c "st") "strput()" (idlwave-keyword-abbrev 1)) | |
1562 | (define-abbrev tb (concat c "sr") "strtrim()" (idlwave-keyword-abbrev 1)) | |
1563 | (define-abbrev tb (concat c "t") "then" (idlwave-keyword-abbrev 0 t)) | |
1564 | (define-abbrev tb (concat c "u") "until" (idlwave-keyword-abbrev 0 t)) | |
1565 | (define-abbrev tb (concat c "wu") "writeu," (idlwave-keyword-abbrev 0)) | |
1566 | (define-abbrev tb (concat c "ine") "if n_elements() eq 0 then" | |
1567 | (idlwave-keyword-abbrev 11)) | |
1568 | (define-abbrev tb (concat c "inn") "if n_elements() ne 0 then" | |
1569 | (idlwave-keyword-abbrev 11)) | |
1570 | (define-abbrev tb (concat c "np") "n_params()" (idlwave-keyword-abbrev 0)) | |
1571 | (define-abbrev tb (concat c "s") "size()" (idlwave-keyword-abbrev 1)) | |
1572 | (define-abbrev tb (concat c "wi") "widget_info()" (idlwave-keyword-abbrev 1)) | |
1573 | (define-abbrev tb (concat c "wc") "widget_control," (idlwave-keyword-abbrev 0)) | |
1574 | ||
1575 | ;; This section is reserved words only. (From IDL user manual) | |
1576 | ;; | |
1577 | (define-abbrev tb "and" "and" (idlwave-keyword-abbrev 0 t)) | |
1578 | (define-abbrev tb "begin" "begin" (idlwave-keyword-abbrev 0 t)) | |
1579 | (define-abbrev tb "case" "case" (idlwave-keyword-abbrev 0 t)) | |
1580 | (define-abbrev tb "common" "common" (idlwave-keyword-abbrev 0 t)) | |
1581 | (define-abbrev tb "do" "do" (idlwave-keyword-abbrev 0 t)) | |
1582 | (define-abbrev tb "else" "else" (idlwave-keyword-abbrev 0 t)) | |
1583 | (define-abbrev tb "end" "end" 'idlwave-show-begin-check) | |
1584 | (define-abbrev tb "endcase" "endcase" 'idlwave-show-begin-check) | |
1585 | (define-abbrev tb "endelse" "endelse" 'idlwave-show-begin-check) | |
1586 | (define-abbrev tb "endfor" "endfor" 'idlwave-show-begin-check) | |
1587 | (define-abbrev tb "endif" "endif" 'idlwave-show-begin-check) | |
1588 | (define-abbrev tb "endrep" "endrep" 'idlwave-show-begin-check) | |
1589 | (define-abbrev tb "endwhi" "endwhi" 'idlwave-show-begin-check) | |
1590 | (define-abbrev tb "endwhile" "endwhile" 'idlwave-show-begin-check) | |
1591 | (define-abbrev tb "eq" "eq" (idlwave-keyword-abbrev 0 t)) | |
1592 | (define-abbrev tb "for" "for" (idlwave-keyword-abbrev 0 t)) | |
1593 | (define-abbrev tb "function" "function" (idlwave-keyword-abbrev 0 t)) | |
1594 | (define-abbrev tb "ge" "ge" (idlwave-keyword-abbrev 0 t)) | |
1595 | (define-abbrev tb "goto" "goto" (idlwave-keyword-abbrev 0 t)) | |
1596 | (define-abbrev tb "gt" "gt" (idlwave-keyword-abbrev 0 t)) | |
1597 | (define-abbrev tb "if" "if" (idlwave-keyword-abbrev 0 t)) | |
1598 | (define-abbrev tb "le" "le" (idlwave-keyword-abbrev 0 t)) | |
1599 | (define-abbrev tb "lt" "lt" (idlwave-keyword-abbrev 0 t)) | |
1600 | (define-abbrev tb "mod" "mod" (idlwave-keyword-abbrev 0 t)) | |
1601 | (define-abbrev tb "ne" "ne" (idlwave-keyword-abbrev 0 t)) | |
1602 | (define-abbrev tb "not" "not" (idlwave-keyword-abbrev 0 t)) | |
1603 | (define-abbrev tb "of" "of" (idlwave-keyword-abbrev 0 t)) | |
1604 | (define-abbrev tb "on_ioerror" "on_ioerror" (idlwave-keyword-abbrev 0 t)) | |
1605 | (define-abbrev tb "or" "or" (idlwave-keyword-abbrev 0 t)) | |
1606 | (define-abbrev tb "pro" "pro" (idlwave-keyword-abbrev 0 t)) | |
1607 | (define-abbrev tb "repeat" "repeat" (idlwave-keyword-abbrev 0 t)) | |
1608 | (define-abbrev tb "then" "then" (idlwave-keyword-abbrev 0 t)) | |
1609 | (define-abbrev tb "until" "until" (idlwave-keyword-abbrev 0 t)) | |
1610 | (define-abbrev tb "while" "while" (idlwave-keyword-abbrev 0 t)) | |
1611 | (define-abbrev tb "xor" "xor" (idlwave-keyword-abbrev 0 t))) | |
1612 | ||
1613 | (defvar imenu-create-index-function) | |
1614 | (defvar extract-index-name-function) | |
1615 | (defvar prev-index-position-function) | |
1616 | (defvar imenu-extract-index-name-function) | |
1617 | (defvar imenu-prev-index-position-function) | |
1618 | ;; defined later - so just make the compiler shut up | |
1619 | (defvar idlwave-mode-menu) | |
1620 | (defvar idlwave-mode-debug-menu) | |
1621 | ||
1622 | ;;;###autoload | |
1623 | (defun idlwave-mode () | |
1624 | "Major mode for editing IDL and WAVE CL .pro files. | |
1625 | ||
1626 | The main features of this mode are | |
1627 | ||
1628 | 1. Indentation and Formatting | |
1629 | -------------------------- | |
1630 | Like other Emacs programming modes, C-j inserts a newline and indents. | |
1631 | TAB is used for explicit indentation of the current line. | |
1632 | ||
1633 | To start a continuation line, use \\[idlwave-split-line]. This function can also | |
1634 | be used in the middle of a line to split the line at that point. | |
1635 | When used inside a long constant string, the string is split at | |
1636 | that point with the `+' concatenation operator. | |
1637 | ||
1638 | Comments are indented as follows: | |
1639 | ||
1640 | `;;;' Indentation remains unchanged. | |
1641 | `;;' Indent like the surrounding code | |
1642 | `;' Indent to a minimum column. | |
1643 | ||
1644 | The indentation of comments starting in column 0 is never changed. | |
1645 | ||
1646 | Use \\[idlwave-fill-paragraph] to refill a paragraph inside a comment. The indentation | |
1647 | of the second line of the paragraph relative to the first will be | |
1648 | retained. Use \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these comments. | |
1649 | When the variable `idlwave-fill-comment-line-only' is nil, code | |
1650 | can also be auto-filled and auto-indented (not recommended). | |
1651 | ||
1652 | To convert pre-existing IDL code to your formatting style, mark the | |
1653 | entire buffer with \\[mark-whole-buffer] and execute \\[idlwave-expand-region-abbrevs]. | |
1654 | Then mark the entire buffer again followed by \\[indent-region] (`indent-region'). | |
1655 | ||
1656 | 2. Routine Info | |
1657 | ------------ | |
1658 | IDLWAVE displays information about the calling sequence and the accepted | |
1659 | keyword parameters of a procedure or function with \\[idlwave-routine-info]. | |
1660 | \\[idlwave-find-module] jumps to the source file of a module. | |
1661 | These commands know about system routines, all routines in idlwave-mode | |
1662 | buffers and (when the idlwave-shell is active) about all modules | |
1663 | currently compiled under this shell. Use \\[idlwave-update-routine-info] to update this | |
15e42531 CD |
1664 | information, which is also used for completion (see item 4). |
1665 | ||
1666 | 3. Online IDL Help | |
1667 | --------------- | |
1668 | \\[idlwave-context-help] displays the IDL documentation relevant | |
1669 | for the system variable, keyword, or routine at point. A single key | |
1670 | stroke gets you directly to the right place in the docs. Two additional | |
1671 | files (an ASCII version of the IDL documentation and a topics file) must | |
1672 | be installed for this - check the IDLWAVE webpage for these files. | |
f32b3b91 | 1673 | |
15e42531 | 1674 | 4. Completion |
f32b3b91 | 1675 | ---------- |
15e42531 CD |
1676 | \\[idlwave-complete] completes the names of procedures, functions |
1677 | class names and keyword parameters. It is context sensitive and | |
1678 | figures out what is expected at point (procedure/function/keyword). | |
1679 | Lower case strings are completed in lower case, other strings in | |
1680 | mixed or upper case. | |
f32b3b91 | 1681 | |
15e42531 | 1682 | 5. Code Templates and Abbreviations |
f32b3b91 CD |
1683 | -------------------------------- |
1684 | Many Abbreviations are predefined to expand to code fragments and templates. | |
1685 | The abbreviations start generally with a `\\`. Some examples | |
1686 | ||
1687 | \\pr PROCEDURE template | |
1688 | \\fu FUNCTION template | |
1689 | \\c CASE statement template | |
1690 | \\f FOR loop template | |
1691 | \\r REPEAT Loop template | |
1692 | \\w WHILE loop template | |
1693 | \\i IF statement template | |
1694 | \\elif IF-ELSE statement template | |
1695 | \\b BEGIN | |
1696 | ||
1697 | For a full list, use \\[idlwave-list-abbrevs]. Some templates also have | |
1698 | direct keybindings - see the list of keybindings below. | |
1699 | ||
1700 | \\[idlwave-doc-header] inserts a documentation header at the beginning of the | |
1701 | current program unit (pro, function or main). Change log entries | |
1702 | can be added to the current program unit with \\[idlwave-doc-modification]. | |
1703 | ||
15e42531 | 1704 | 6. Automatic Case Conversion |
f32b3b91 CD |
1705 | ------------------------- |
1706 | The case of reserved words and some abbrevs is controlled by | |
1707 | `idlwave-reserved-word-upcase' and `idlwave-abbrev-change-case'. | |
1708 | ||
15e42531 | 1709 | 7. Automatic END completion |
f32b3b91 CD |
1710 | ------------------------ |
1711 | If the variable `idlwave-expand-generic-end' is non-nil, each END typed | |
1712 | will be converted to the specific version, like ENDIF, ENDFOR, etc. | |
1713 | ||
15e42531 | 1714 | 8. Hooks |
f32b3b91 CD |
1715 | ----- |
1716 | Loading idlwave.el runs `idlwave-load-hook'. | |
1717 | Turning on `idlwave-mode' runs `idlwave-mode-hook'. | |
1718 | ||
15e42531 | 1719 | 9. Documentation and Customization |
f32b3b91 CD |
1720 | ------------------------------- |
1721 | Info documentation for this package is available. Use \\[idlwave-info] | |
1722 | to display (complain to your sysadmin if that does not work). | |
1723 | For Postscript and HTML versions of the documentation, check IDLWAVE's | |
1724 | homepage at `http://www.strw.leidenuniv.nl/~dominik/Tools/idlwave'. | |
1725 | IDLWAVE has customize support - see the group `idlwave'. | |
1726 | ||
15e42531 | 1727 | 10.Keybindings |
f32b3b91 CD |
1728 | ----------- |
1729 | Here is a list of all keybindings of this mode. | |
1730 | If some of the key bindings below show with ??, use \\[describe-key] | |
1731 | followed by the key sequence to see what the key sequence does. | |
1732 | ||
1733 | \\{idlwave-mode-map}" | |
1734 | ||
1735 | (interactive) | |
1736 | (kill-all-local-variables) | |
1737 | ||
1738 | (if idlwave-startup-message | |
1739 | (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) | |
1740 | (setq idlwave-startup-message nil) | |
1741 | ||
1742 | (setq local-abbrev-table idlwave-mode-abbrev-table) | |
1743 | (set-syntax-table idlwave-mode-syntax-table) | |
1744 | ||
1745 | (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) | |
1746 | ||
1747 | (make-local-variable idlwave-comment-indent-function) | |
1748 | (set idlwave-comment-indent-function 'idlwave-comment-hook) | |
1749 | ||
1750 | (set (make-local-variable 'comment-start-skip) ";+[ \t]*") | |
1751 | (set (make-local-variable 'comment-start) ";") | |
1752 | (set (make-local-variable 'require-final-newline) t) | |
1753 | (set (make-local-variable 'abbrev-all-caps) t) | |
1754 | (set (make-local-variable 'indent-tabs-mode) nil) | |
1755 | (set (make-local-variable 'completion-ignore-case) t) | |
1756 | ||
1757 | (use-local-map idlwave-mode-map) | |
1758 | ||
1759 | (when (featurep 'easymenu) | |
1760 | (easy-menu-add idlwave-mode-menu idlwave-mode-map) | |
1761 | (easy-menu-add idlwave-mode-debug-menu idlwave-mode-map)) | |
1762 | ||
1763 | (setq mode-name "IDLWAVE") | |
1764 | (setq major-mode 'idlwave-mode) | |
1765 | (setq abbrev-mode t) | |
1766 | ||
1767 | (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) | |
1768 | (setq comment-end "") | |
1769 | (set (make-local-variable 'comment-multi-line) nil) | |
1770 | (set (make-local-variable 'paragraph-separate) "[ \t\f]*$\\|[ \t]*;+[ \t]*$") | |
1771 | (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") | |
1772 | (set (make-local-variable 'paragraph-ignore-fill-prefix) nil) | |
1773 | (set (make-local-variable 'parse-sexp-ignore-comments) nil) | |
1774 | ||
1775 | ;; Set tag table list to use IDLTAGS as file name. | |
1776 | (if (boundp 'tag-table-alist) | |
1777 | (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) | |
1778 | ||
1779 | ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow | |
1780 | ;; Following line is for Emacs - XEmacs uses the corresponding porperty | |
1781 | ;; on the `idlwave-mode' symbol. | |
1782 | (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) | |
1783 | ||
1784 | ;; Imenu setup | |
1785 | (set (make-local-variable 'imenu-create-index-function) | |
1786 | 'imenu-default-create-index-function) | |
1787 | (set (make-local-variable 'imenu-extract-index-name-function) | |
1788 | 'idlwave-unit-name) | |
1789 | (set (make-local-variable 'imenu-prev-index-position-function) | |
1790 | 'idlwave-prev-index-position) | |
1791 | ||
1792 | ;; Make a local post-command-hook and add our hook to it | |
1793 | (make-local-hook 'post-command-hook) | |
15e42531 CD |
1794 | (add-hook 'post-command-hook 'idlwave-command-hook nil 'local) |
1795 | ||
1796 | ;; Make local hooks for buffer updates | |
1797 | (make-local-hook 'kill-buffer-hook) | |
1798 | (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local) | |
1799 | (make-local-hook 'after-save-hook) | |
1800 | (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) | |
1801 | (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) | |
1802 | ||
1803 | ;; Update the routine info with info about current buffer? | |
1804 | (idlwave-new-buffer-update) | |
f32b3b91 CD |
1805 | |
1806 | ;; Run the mode hook | |
1807 | (run-hooks 'idlwave-mode-hook)) | |
1808 | ||
1809 | ;; | |
1810 | ;; Done with start up and initialization code. | |
1811 | ;; The remaining routines are the code formatting functions. | |
1812 | ;; | |
1813 | ||
1814 | (defun idlwave-push-mark (&rest rest) | |
1815 | "Push mark for compatibility with Emacs 18/19." | |
1816 | (if (fboundp 'iconify-frame) | |
1817 | (apply 'push-mark rest) | |
1818 | (push-mark))) | |
1819 | ||
1820 | (defun idlwave-hard-tab () | |
1821 | "Inserts TAB in buffer in current position." | |
1822 | (interactive) | |
1823 | (insert "\t")) | |
1824 | ||
1825 | ;;; This stuff is experimental | |
1826 | ||
1827 | (defvar idlwave-command-hook nil | |
1828 | "If non-nil, a list that can be evaluated using `eval'. | |
1829 | It is evaluated in the lisp function `idlwave-command-hook' which is | |
1830 | placed in `post-command-hook'.") | |
1831 | ||
1832 | (defun idlwave-command-hook () | |
1833 | "Command run after every command. | |
1834 | Evaluates a non-nil value of the *variable* `idlwave-command-hook' and | |
1835 | sets the variable to zero afterwards." | |
1836 | (and idlwave-command-hook | |
1837 | (listp idlwave-command-hook) | |
1838 | (condition-case nil | |
1839 | (eval idlwave-command-hook) | |
1840 | (error nil))) | |
1841 | (setq idlwave-command-hook nil)) | |
1842 | ||
1843 | ;;; End experiment | |
1844 | ||
1845 | ;; It would be better to use expand.el for better abbrev handling and | |
1846 | ;; versatility. | |
1847 | ||
1848 | (defun idlwave-check-abbrev (arg &optional reserved) | |
1849 | "Reverses abbrev expansion if in comment or string. | |
1850 | Argument ARG is the number of characters to move point | |
1851 | backward if `idlwave-abbrev-move' is non-nil. | |
1852 | If optional argument RESERVED is non-nil then the expansion | |
1853 | consists of reserved words, which will be capitalized if | |
1854 | `idlwave-reserved-word-upcase' is non-nil. | |
1855 | Otherwise, the abbrev will be capitalized if `idlwave-abbrev-change-case' | |
1856 | is non-nil, unless its value is \`down in which case the abbrev will be | |
1857 | made into all lowercase. | |
1858 | Returns non-nil if abbrev is left expanded." | |
1859 | (if (idlwave-quoted) | |
1860 | (progn (unexpand-abbrev) | |
1861 | nil) | |
1862 | (if (and reserved idlwave-reserved-word-upcase) | |
1863 | (upcase-region last-abbrev-location (point)) | |
1864 | (cond | |
1865 | ((equal idlwave-abbrev-change-case 'down) | |
1866 | (downcase-region last-abbrev-location (point))) | |
1867 | (idlwave-abbrev-change-case | |
1868 | (upcase-region last-abbrev-location (point))))) | |
1869 | (if (and idlwave-abbrev-move (> arg 0)) | |
1870 | (if (boundp 'post-command-hook) | |
1871 | (setq idlwave-command-hook (list 'backward-char (1+ arg))) | |
1872 | (backward-char arg))) | |
1873 | t)) | |
1874 | ||
1875 | (defun idlwave-in-comment () | |
1876 | "Returns t if point is inside a comment, nil otherwise." | |
1877 | (save-excursion | |
1878 | (let ((here (point))) | |
1879 | (and (idlwave-goto-comment) (> here (point)))))) | |
1880 | ||
1881 | (defun idlwave-goto-comment () | |
1882 | "Move to start of comment delimiter on current line. | |
1883 | Moves to end of line if there is no comment delimiter. | |
1884 | Ignores comment delimiters in strings. | |
1885 | Returns point if comment found and nil otherwise." | |
1886 | (let ((eos (progn (end-of-line) (point))) | |
1887 | (data (match-data)) | |
1888 | found) | |
1889 | ;; Look for first comment delimiter not in a string | |
1890 | (beginning-of-line) | |
1891 | (setq found (search-forward comment-start eos 'lim)) | |
1892 | (while (and found (idlwave-in-quote)) | |
1893 | (setq found (search-forward comment-start eos 'lim))) | |
1894 | (store-match-data data) | |
1895 | (and found (not (idlwave-in-quote)) | |
1896 | (progn | |
1897 | (backward-char 1) | |
1898 | (point))))) | |
1899 | ||
1900 | (defun idlwave-show-matching-quote () | |
1901 | "Insert quote and show matching quote if this is end of a string." | |
1902 | (interactive) | |
1903 | (let ((bq (idlwave-in-quote)) | |
1904 | (inq last-command-char)) | |
1905 | (if (and bq (not (idlwave-in-comment))) | |
1906 | (let ((delim (char-after bq))) | |
1907 | (insert inq) | |
1908 | (if (eq inq delim) | |
1909 | (save-excursion | |
1910 | (goto-char bq) | |
1911 | (sit-for 1)))) | |
1912 | ;; Not the end of a string | |
1913 | (insert inq)))) | |
1914 | ||
1915 | (defun idlwave-show-begin-check () | |
1916 | "Ensure that the previous word was a token before `idlwave-show-begin'. | |
1917 | An END token must be preceded by whitespace." | |
1918 | (if | |
1919 | (save-excursion | |
1920 | (backward-word 1) | |
1921 | (backward-char 1) | |
1922 | (looking-at "[ \t\n\f]")) | |
1923 | (idlwave-show-begin))) | |
1924 | ||
1925 | (defun idlwave-show-begin () | |
1926 | "Finds the start of current block and blinks to it for a second. | |
1927 | Also checks if the correct end statement has been used." | |
15e42531 CD |
1928 | ;; Re-indent end line |
1929 | (if idlwave-reindent-end | |
1930 | (idlwave-indent-line)) | |
f32b3b91 CD |
1931 | ;; All end statements are reserved words |
1932 | (let* ((pos (point)) | |
1933 | end end1) | |
1934 | (when (and (idlwave-check-abbrev 0 t) | |
1935 | idlwave-show-block) | |
1936 | (save-excursion | |
1937 | ;; Move inside current block | |
1938 | (setq end (buffer-substring | |
1939 | (save-excursion (skip-chars-backward "a-zA-Z") | |
1940 | (point)) | |
1941 | (point))) | |
1942 | (idlwave-beginning-of-statement) | |
1943 | (idlwave-block-jump-out -1 'nomark) | |
1944 | (when (setq end1 (cdr (idlwave-block-master))) | |
1945 | (cond | |
1946 | ((null end1)) ; no-opeartion | |
1947 | ((string= (downcase end) (downcase end1)) | |
1948 | (sit-for 1)) | |
1949 | ((string= (downcase end) "end") | |
1950 | ;; A generic end | |
1951 | (if idlwave-expand-generic-end | |
1952 | (save-excursion | |
1953 | (goto-char pos) | |
1954 | (backward-char 3) | |
1955 | (insert (if (string= end "END") (upcase end1) end1)) | |
1956 | (delete-char 3))) | |
1957 | (sit-for 1)) | |
1958 | (t | |
1959 | (beep) | |
1960 | (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" | |
1961 | end1 end) | |
1962 | (sit-for 1)))))))) | |
1963 | ||
1964 | (defun idlwave-block-master () | |
1965 | (let ((case-fold-search t)) | |
1966 | (save-excursion | |
1967 | (cond | |
1968 | ((looking-at "pro\\|case\\|function\\>") | |
1969 | (assoc (downcase (match-string 0)) idlwave-block-matches)) | |
1970 | ((looking-at "begin\\>") | |
1971 | (let ((limit (save-excursion | |
1972 | (idlwave-beginning-of-statement) | |
1973 | (point)))) | |
1974 | (cond | |
1975 | ((re-search-backward idlwave-block-match-regexp limit t) | |
1976 | (assoc (downcase (match-string 1)) | |
1977 | idlwave-block-matches)) | |
1978 | ;;((re-search-backward ":[ \t]*\\=" limit t) | |
1979 | ;; ;; seems to be a case thing | |
1980 | ;; '("begin" . "end")) | |
1981 | (t | |
1982 | ;; Just a nromal block | |
1983 | '("begin" . "end"))))) | |
1984 | (t nil))))) | |
1985 | ||
1986 | (defun idlwave-close-block () | |
1987 | "Terminate the current block with the correct END statement." | |
1988 | (interactive) | |
1989 | ||
1990 | ;; Start new line if we are not in a new line | |
1991 | (unless (save-excursion | |
1992 | (skip-chars-backward " \t") | |
1993 | (bolp)) | |
1994 | (let ((idlwave-show-block nil)) | |
1995 | (newline-and-indent))) | |
1996 | ||
1997 | ;; Check which end is needed and insert it. | |
1998 | (let ((case-fold-search t) end) | |
1999 | (save-excursion | |
2000 | (idlwave-beginning-of-statement) | |
2001 | (idlwave-block-jump-out -1 'nomark) | |
2002 | (if (setq end (idlwave-block-master)) | |
2003 | (setq end (cdr end)) | |
2004 | (error "Cannot close block"))) | |
2005 | (insert end) | |
2006 | (idlwave-newline))) | |
2007 | ||
595ab50b CD |
2008 | (defun idlwave-surround (&optional before after escape-chars length) |
2009 | "Surround the LENGTH characters before point with blanks. | |
2010 | LENGTH defaults to 1. | |
f32b3b91 | 2011 | Optional arguments BEFORE and AFTER affect the behavior before and |
595ab50b CD |
2012 | after the characters (see also description of `idlwave-make-space'): |
2013 | ||
2014 | nil do nothing | |
2015 | 0 force no spaces | |
2016 | integer > 0 force exactly n spaces | |
2017 | integer < 0 at least |n| spaces | |
f32b3b91 CD |
2018 | |
2019 | The function does nothing if any of the following conditions is true: | |
2020 | - `idlwave-surround-by-blank' is nil | |
2021 | - the character before point is inside a string or comment | |
595ab50b CD |
2022 | - the char preceeding the string to be surrounded is a member of ESCAPE-CHARS. |
2023 | This hack is used to avoid padding of `>' when it is part of | |
2024 | the '->' operator. In this case, ESCAPE-CHARS would be '(?-)." | |
2025 | ||
2026 | (setq length (or length 1)) ; establish a default for LENGTH | |
2027 | ||
2028 | (when (and idlwave-surround-by-blank | |
2029 | (not (idlwave-quoted)) | |
2030 | (not (memq (char-after (- (point) (1+ length))) escape-chars))) | |
2031 | (backward-char length) | |
2032 | (save-restriction | |
2033 | (let ((here (point))) | |
2034 | (skip-chars-backward " \t") | |
2035 | (if (bolp) | |
2036 | ;; avoid clobbering indent | |
2037 | (progn | |
2038 | (move-to-column (idlwave-calculate-indent)) | |
2039 | (if (<= (point) here) | |
2040 | (narrow-to-region (point) here)) | |
2041 | (goto-char here))) | |
2042 | (idlwave-make-space before)) | |
2043 | (skip-chars-forward " \t")) | |
2044 | (forward-char length) | |
2045 | (idlwave-make-space after) | |
2046 | ;; Check to see if the line should auto wrap | |
15e42531 | 2047 | (if (and (equal (char-after (1- (point))) ?\ ) |
595ab50b CD |
2048 | (> (current-column) fill-column)) |
2049 | (funcall auto-fill-function)))) | |
f32b3b91 CD |
2050 | |
2051 | (defun idlwave-make-space (n) | |
2052 | "Make space at point. | |
2053 | The space affected is all the spaces and tabs around point. | |
2054 | If n is non-nil then point is left abs(n) spaces from the beginning of | |
2055 | the contiguous space. | |
2056 | The amount of space at point is determined by N. | |
2057 | If the value of N is: | |
2058 | nil - do nothing. | |
595ab50b CD |
2059 | > 0 - exactly N spaces. |
2060 | < 0 - a minimum of -N spaces, i.e., do not change if there are | |
2061 | already -N spaces. | |
2062 | 0 - no spaces (i.e. remove any existing space)." | |
f32b3b91 CD |
2063 | (if (integerp n) |
2064 | (let | |
2065 | ((start-col (progn (skip-chars-backward " \t") (current-column))) | |
2066 | (left (point)) | |
2067 | (end-col (progn (skip-chars-forward " \t") (current-column)))) | |
2068 | (delete-horizontal-space) | |
2069 | (cond | |
2070 | ((> n 0) | |
2071 | (idlwave-indent-to (+ start-col n)) | |
2072 | (goto-char (+ left n))) | |
2073 | ((< n 0) | |
2074 | (idlwave-indent-to end-col (- n)) | |
2075 | (goto-char (- left n))) | |
2076 | ;; n = 0, done | |
2077 | )))) | |
2078 | ||
2079 | (defun idlwave-newline () | |
2080 | "Inserts a newline and indents the current and previous line." | |
2081 | (interactive) | |
2082 | ;; | |
2083 | ;; Handle unterminated single and double quotes | |
2084 | ;; If not in a comment and in a string then insertion of a newline | |
2085 | ;; will mean unbalanced quotes. | |
2086 | ;; | |
2087 | (if (and (not (idlwave-in-comment)) (idlwave-in-quote)) | |
2088 | (progn (beep) | |
2089 | (message "Warning: unbalanced quotes?"))) | |
2090 | (newline) | |
2091 | ;; | |
2092 | ;; The current line is being split, the cursor should be at the | |
2093 | ;; beginning of the new line skipping the leading indentation. | |
2094 | ;; | |
2095 | ;; The reason we insert the new line before indenting is that the | |
2096 | ;; indenting could be confused by keywords (e.g. END) on the line | |
2097 | ;; after the split point. This prevents us from just using | |
2098 | ;; `indent-for-tab-command' followed by `newline-and-indent'. | |
2099 | ;; | |
2100 | (beginning-of-line 0) | |
2101 | (idlwave-indent-line) | |
2102 | (forward-line) | |
2103 | (idlwave-indent-line)) | |
2104 | ||
2105 | ;; | |
2106 | ;; Use global variable 'comment-column' to set parallel comment | |
2107 | ;; | |
2108 | ;; Modeled on lisp.el | |
2109 | ;; Emacs Lisp and IDL (Wave CL) have identical comment syntax | |
2110 | (defun idlwave-comment-hook () | |
2111 | "Compute indent for the beginning of the IDL comment delimiter." | |
2112 | (if (or (looking-at idlwave-no-change-comment) | |
2113 | (if idlwave-begin-line-comment | |
2114 | (looking-at idlwave-begin-line-comment) | |
2115 | (looking-at "^;"))) | |
2116 | (current-column) | |
2117 | (if (looking-at idlwave-code-comment) | |
2118 | (if (save-excursion (skip-chars-backward " \t") (bolp)) | |
2119 | ;; On line by itself, indent as code | |
2120 | (let ((tem (idlwave-calculate-indent))) | |
2121 | (if (listp tem) (car tem) tem)) | |
2122 | ;; after code - do not change | |
2123 | (current-column)) | |
2124 | (skip-chars-backward " \t") | |
2125 | (max (if (bolp) 0 (1+ (current-column))) | |
2126 | comment-column)))) | |
2127 | ||
2128 | (defun idlwave-split-line () | |
2129 | "Continue line by breaking line at point and indent the lines. | |
2130 | For a code line insert continuation marker. If the line is a line comment | |
2131 | then the new line will contain a comment with the same indentation. | |
2132 | Splits strings with the IDL operator `+' if `idlwave-split-line-string' is | |
2133 | non-nil." | |
2134 | (interactive) | |
15e42531 CD |
2135 | ;; Expand abbreviation, just like normal RET would. |
2136 | (and abbrev-mode (expand-abbrev)) | |
f32b3b91 CD |
2137 | (let (beg) |
2138 | (if (not (idlwave-in-comment)) | |
2139 | ;; For code line add continuation. | |
2140 | ;; Check if splitting a string. | |
2141 | (progn | |
2142 | (if (setq beg (idlwave-in-quote)) | |
2143 | (if idlwave-split-line-string | |
2144 | ;; Split the string. | |
2145 | (progn (insert (setq beg (char-after beg)) " + " | |
2146 | idlwave-continuation-char beg) | |
2147 | (backward-char 1)) | |
2148 | ;; Do not split the string. | |
2149 | (beep) | |
2150 | (message "Warning: continuation inside string!!") | |
2151 | (insert " " idlwave-continuation-char)) | |
2152 | ;; Not splitting a string. | |
15e42531 CD |
2153 | (if (not (member (char-before) '(?\ ?\t))) |
2154 | (insert " ")) | |
2155 | (insert idlwave-continuation-char)) | |
f32b3b91 CD |
2156 | (newline-and-indent)) |
2157 | (indent-new-comment-line)) | |
2158 | ;; Indent previous line | |
2159 | (setq beg (- (point-max) (point))) | |
2160 | (forward-line -1) | |
2161 | (idlwave-indent-line) | |
2162 | (goto-char (- (point-max) beg)) | |
2163 | ;; Reindent new line | |
2164 | (idlwave-indent-line))) | |
2165 | ||
2166 | (defun idlwave-beginning-of-subprogram () | |
2167 | "Moves point to the beginning of the current program unit." | |
2168 | (interactive) | |
2169 | (idlwave-find-key idlwave-begin-unit-reg -1)) | |
2170 | ||
2171 | (defun idlwave-end-of-subprogram () | |
2172 | "Moves point to the start of the next program unit." | |
2173 | (interactive) | |
2174 | (idlwave-end-of-statement) | |
2175 | (idlwave-find-key idlwave-end-unit-reg 1)) | |
2176 | ||
2177 | (defun idlwave-mark-statement () | |
2178 | "Mark current IDL statement." | |
2179 | (interactive) | |
2180 | (idlwave-end-of-statement) | |
2181 | (let ((end (point))) | |
2182 | (idlwave-beginning-of-statement) | |
2183 | (idlwave-push-mark end nil t))) | |
2184 | ||
2185 | (defun idlwave-mark-block () | |
2186 | "Mark containing block." | |
2187 | (interactive) | |
2188 | (idlwave-end-of-statement) | |
2189 | (idlwave-backward-up-block -1) | |
2190 | (idlwave-end-of-statement) | |
2191 | (let ((end (point))) | |
2192 | (idlwave-backward-block) | |
2193 | (idlwave-beginning-of-statement) | |
2194 | (idlwave-push-mark end nil t))) | |
2195 | ||
2196 | ||
2197 | (defun idlwave-mark-subprogram () | |
2198 | "Put mark at beginning of program, point at end. | |
2199 | The marks are pushed." | |
2200 | (interactive) | |
2201 | (idlwave-end-of-statement) | |
2202 | (idlwave-beginning-of-subprogram) | |
2203 | (let ((beg (point))) | |
2204 | (idlwave-forward-block) | |
2205 | (idlwave-push-mark beg nil t)) | |
2206 | (exchange-point-and-mark)) | |
2207 | ||
2208 | (defun idlwave-backward-up-block (&optional arg) | |
2209 | "Move to beginning of enclosing block if prefix ARG >= 0. | |
2210 | If prefix ARG < 0 then move forward to enclosing block end." | |
2211 | (interactive "p") | |
2212 | (idlwave-block-jump-out (- arg) 'nomark)) | |
2213 | ||
2214 | (defun idlwave-beginning-of-block () | |
2215 | "Go to the beginning of the current block." | |
2216 | (interactive) | |
2217 | (idlwave-block-jump-out -1 'nomark) | |
2218 | (forward-word 1)) | |
2219 | ||
2220 | (defun idlwave-end-of-block () | |
2221 | "Go to the beginning of the current block." | |
2222 | (interactive) | |
2223 | (idlwave-block-jump-out 1 'nomark) | |
2224 | (backward-word 1)) | |
2225 | ||
2226 | (defun idlwave-forward-block () | |
2227 | "Move across next nested block." | |
2228 | (interactive) | |
2229 | (if (idlwave-down-block 1) | |
2230 | (idlwave-block-jump-out 1 'nomark))) | |
2231 | ||
2232 | (defun idlwave-backward-block () | |
2233 | "Move backward across previous nested block." | |
2234 | (interactive) | |
2235 | (if (idlwave-down-block -1) | |
2236 | (idlwave-block-jump-out -1 'nomark))) | |
2237 | ||
2238 | (defun idlwave-down-block (&optional arg) | |
2239 | "Go down a block. | |
2240 | With ARG: ARG >= 0 go forwards, ARG < 0 go backwards. | |
2241 | Returns non-nil if successfull." | |
2242 | (interactive "p") | |
2243 | (let (status) | |
2244 | (if (< arg 0) | |
2245 | ;; Backward | |
2246 | (let ((eos (save-excursion | |
2247 | (idlwave-block-jump-out -1 'nomark) | |
2248 | (point)))) | |
2249 | (if (setq status (idlwave-find-key | |
2250 | idlwave-end-block-reg -1 'nomark eos)) | |
2251 | (idlwave-beginning-of-statement) | |
2252 | (message "No nested block before beginning of containing block."))) | |
2253 | ;; Forward | |
2254 | (let ((eos (save-excursion | |
2255 | (idlwave-block-jump-out 1 'nomark) | |
2256 | (point)))) | |
2257 | (if (setq status (idlwave-find-key | |
2258 | idlwave-begin-block-reg 1 'nomark eos)) | |
2259 | (idlwave-end-of-statement) | |
2260 | (message "No nested block before end of containing block.")))) | |
2261 | status)) | |
2262 | ||
2263 | (defun idlwave-mark-doclib () | |
2264 | "Put point at beginning of doc library header, mark at end. | |
2265 | The marks are pushed." | |
2266 | (interactive) | |
2267 | (let (beg | |
2268 | (here (point))) | |
2269 | (goto-char (point-max)) | |
2270 | (if (re-search-backward idlwave-doclib-start nil t) | |
2271 | (progn | |
2272 | (setq beg (progn (beginning-of-line) (point))) | |
2273 | (if (re-search-forward idlwave-doclib-end nil t) | |
2274 | (progn | |
2275 | (forward-line 1) | |
2276 | (idlwave-push-mark beg nil t) | |
2277 | (message "Could not find end of doc library header."))) | |
2278 | (message "Could not find doc library header start.") | |
2279 | (goto-char here))))) | |
2280 | ||
15e42531 CD |
2281 | |
2282 | (defun idlwave-current-routine () | |
2283 | "Return (NAME TYPE CLASS) of current routine." | |
2284 | (idlwave-routines) | |
2285 | (save-excursion | |
2286 | (idlwave-beginning-of-subprogram) | |
2287 | (if (looking-at "[ \t]*\\<\\(pro\\|function\\)\\>\\s-+\\(\\([a-zA-Z0-9$_]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)") | |
2288 | (let* ((type (if (string= (downcase (match-string 1)) "pro") | |
2289 | 'pro 'function)) | |
2290 | (class (idlwave-sintern-class (match-string 3))) | |
2291 | (name (idlwave-sintern-routine-or-method (match-string 4) class))) | |
2292 | (list name type class))))) | |
2293 | ||
f32b3b91 CD |
2294 | (defvar idlwave-shell-prompt-pattern) |
2295 | (defun idlwave-beginning-of-statement () | |
2296 | "Move to beginning of the current statement. | |
2297 | Skips back past statement continuations. | |
2298 | Point is placed at the beginning of the line whether or not this is an | |
2299 | actual statement." | |
2300 | (interactive) | |
2301 | (cond | |
2302 | ((eq major-mode 'idlwave-shell-mode) | |
2303 | (if (re-search-backward idlwave-shell-prompt-pattern nil t) | |
2304 | (goto-char (match-end 0)))) | |
2305 | (t | |
2306 | (if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) | |
2307 | (idlwave-previous-statement) | |
2308 | (beginning-of-line))))) | |
2309 | ||
2310 | (defun idlwave-previous-statement () | |
2311 | "Moves point to beginning of the previous statement. | |
2312 | Returns t if the current line before moving is the beginning of | |
2313 | the first non-comment statement in the file, and nil otherwise." | |
2314 | (interactive) | |
2315 | (let (first-statement) | |
2316 | (if (not (= (forward-line -1) 0)) | |
2317 | ;; first line in file | |
2318 | t | |
2319 | ;; skip blank lines, label lines, include lines and line comments | |
2320 | (while (and | |
2321 | ;; The current statement is the first statement until we | |
2322 | ;; reach another statement. | |
2323 | (setq first-statement | |
2324 | (or | |
2325 | (looking-at idlwave-comment-line-start-skip) | |
2326 | (looking-at "[ \t]*$") | |
2327 | (looking-at (concat "[ \t]*" idlwave-label "[ \t]*$")) | |
2328 | (looking-at "^@"))) | |
2329 | (= (forward-line -1) 0))) | |
2330 | ;; skip continuation lines | |
2331 | (while (and | |
2332 | (save-excursion | |
2333 | (forward-line -1) | |
2334 | (idlwave-is-continuation-line)) | |
2335 | (= (forward-line -1) 0))) | |
2336 | first-statement))) | |
2337 | ||
2338 | ;; FIXME: end-of-statement does not work correctly when comment lines | |
2339 | ;; are inside the statement. It does work correctly for line-end | |
2340 | ;; comments, though. | |
2341 | (defun idlwave-end-of-statement () | |
2342 | "Moves point to the end of the current IDL statement. | |
2343 | If not in a statement just moves to end of line. Returns position." | |
2344 | (interactive) | |
2345 | (while (and (idlwave-is-continuation-line) | |
2346 | (= (forward-line 1) 0))) | |
2347 | (end-of-line) | |
2348 | (point)) | |
2349 | ||
2350 | (defun idlwave-next-statement () | |
2351 | "Moves point to beginning of the next IDL statement. | |
2352 | Returns t if that statement is the last | |
2353 | non-comment IDL statement in the file, and nil otherwise." | |
2354 | (interactive) | |
2355 | (let (last-statement) | |
2356 | (idlwave-end-of-statement) | |
2357 | ;; skip blank lines, label lines, include lines and line comments | |
2358 | (while (and (= (forward-line 1) 0) | |
2359 | ;; The current statement is the last statement until | |
2360 | ;; we reach a new statement. | |
2361 | (setq last-statement | |
2362 | (or | |
2363 | (looking-at idlwave-comment-line-start-skip) | |
2364 | (looking-at "[ \t]*$") | |
2365 | (looking-at (concat "[ \t]*" idlwave-label "[ \t]*$")) | |
2366 | (looking-at "^@"))))) | |
2367 | last-statement)) | |
2368 | ||
15e42531 | 2369 | (defun idlwave-skip-label-or-case () |
f32b3b91 CD |
2370 | "Skip label or case statement element. |
2371 | Returns position after label. | |
2372 | If there is no label point is not moved and nil is returned." | |
15e42531 CD |
2373 | ;; Case expressions and labels are terminated by a colon. |
2374 | ;; So we find the first colon in the line and make sure | |
2375 | ;; - no `?' is before it (might be a ? b : c) | |
2376 | ;; - it is not in a comment | |
2377 | ;; - not in a string constant | |
2378 | ;; - not in parenthesis (like a[0:3]) | |
2379 | ;; As many in this mode, this function is heuristic and not an exact | |
2380 | ;; parser. | |
f32b3b91 CD |
2381 | (let ((start (point)) |
2382 | (end (idlwave-find-key ":" 1 'nomark | |
2383 | (save-excursion | |
2384 | (idlwave-end-of-statement) (point))))) | |
2385 | (if (and end | |
15e42531 CD |
2386 | (= (nth 0 (parse-partial-sexp start end)) 0) |
2387 | (not (string-match "\\?" (buffer-substring start end)))) | |
f32b3b91 CD |
2388 | (progn |
2389 | (forward-char) | |
2390 | (point)) | |
2391 | (goto-char start) | |
2392 | nil))) | |
2393 | ||
2394 | (defun idlwave-start-of-substatement (&optional pre) | |
2395 | "Move to start of next IDL substatement after point. | |
2396 | Uses the type of the current IDL statement to determine if the next | |
2397 | statement is on a new line or is a subpart of the current statement. | |
2398 | Returns point at start of substatement modulo whitespace. | |
2399 | If optional argument is non-nil move to beginning of current | |
15e42531 | 2400 | substatement." |
f32b3b91 CD |
2401 | (let ((orig (point)) |
2402 | (eos (idlwave-end-of-statement)) | |
2403 | (ifnest 0) | |
2404 | st nst last) | |
2405 | (idlwave-beginning-of-statement) | |
15e42531 | 2406 | (idlwave-skip-label-or-case) |
f32b3b91 CD |
2407 | (setq last (point)) |
2408 | ;; Continue looking for substatements until we are past orig | |
2409 | (while (and (<= (point) orig) (not (eobp))) | |
2410 | (setq last (point)) | |
2411 | (setq nst (nth 1 (cdr (setq st (car (idlwave-statement-type)))))) | |
2412 | (if (equal (car st) 'if) (setq ifnest (1+ ifnest))) | |
2413 | (cond ((and nst | |
2414 | (idlwave-find-key nst 1 'nomark eos)) | |
2415 | (goto-char (match-end 0))) | |
2416 | ((and (> ifnest 0) (idlwave-find-key "\\<else\\>" 1 'nomark eos)) | |
2417 | (setq ifnest (1- ifnest)) | |
2418 | (goto-char (match-end 0))) | |
2419 | (t (setq ifnest 0) | |
2420 | (idlwave-next-statement)))) | |
2421 | (if pre (goto-char last)) | |
15e42531 CD |
2422 | ;; If a continuation line starts here, move to next line |
2423 | (if (looking-at "[ \t]*\\$\\([ \t]*\\(;\\|$\\)\\)") | |
2424 | (beginning-of-line 2)) | |
f32b3b91 CD |
2425 | (point))) |
2426 | ||
2427 | (defun idlwave-statement-type () | |
2428 | "Return the type of the current IDL statement. | |
2429 | Uses `idlwave-statement-match' to return a cons of (type . point) with | |
2430 | point the ending position where the type was determined. Type is the | |
2431 | association from `idlwave-statement-match', i.e. the cons cell from the | |
2432 | list not just the type symbol. Returns nil if not an identifiable | |
2433 | statement." | |
2434 | (save-excursion | |
2435 | ;; Skip whitespace within a statement which is spaces, tabs, continuations | |
2436 | (while (looking-at "[ \t]*\\<\\$") | |
2437 | (forward-line 1)) | |
2438 | (skip-chars-forward " \t") | |
2439 | (let ((st idlwave-statement-match) | |
2440 | (case-fold-search t)) | |
2441 | (while (and (not (looking-at (nth 0 (cdr (car st))))) | |
2442 | (setq st (cdr st)))) | |
2443 | (if st | |
2444 | (append st (match-end 0)))))) | |
2445 | ||
2446 | (defun idlwave-expand-equal (&optional before after) | |
2447 | "Pad '=' with spaces. | |
2448 | Two cases: Assignment statement, and keyword assignment. | |
2449 | The case is determined using `idlwave-start-of-substatement' and | |
2450 | `idlwave-statement-type'. | |
2451 | The equal sign will be surrounded by BEFORE and AFTER blanks. | |
15e42531 CD |
2452 | If `idlwave-pad-keyword' is t then keyword assignment is treated just |
2453 | like assignment statements. When nil, spaces are removed for keyword | |
2454 | assignment. Any other value keeps the current space around the `='. | |
f32b3b91 CD |
2455 | Limits in for loops are treated as keyword assignment. |
2456 | See `idlwave-surround'. " | |
2457 | ;; Even though idlwave-surround checks `idlwave-surround-by-blank' this | |
2458 | ;; check saves the time of finding the statement type. | |
2459 | (if idlwave-surround-by-blank | |
2460 | (let ((st (save-excursion | |
2461 | (idlwave-start-of-substatement t) | |
2462 | (idlwave-statement-type)))) | |
15e42531 CD |
2463 | |
2464 | (cond ((or (and (equal (car (car st)) 'assign) | |
2465 | (equal (cdr st) (point))) | |
2466 | (eq t idlwave-pad-keyword)) | |
2467 | ;; An assignment statement or keywor and we need padding | |
2468 | (idlwave-surround before after)) | |
2469 | ((null idlwave-pad-keyword) | |
2470 | ;; Spaces should be removed at a keyword | |
2471 | (idlwave-surround 0 0)) | |
2472 | (t))))) | |
f32b3b91 CD |
2473 | |
2474 | (defun idlwave-indent-and-action () | |
2475 | "Call `idlwave-indent-line' and do expand actions." | |
2476 | (interactive) | |
2477 | (idlwave-indent-line t) | |
2478 | ) | |
2479 | ||
2480 | (defun idlwave-indent-line (&optional expand) | |
2481 | "Indents current IDL line as code or as a comment. | |
2482 | The actions in `idlwave-indent-action-table' are performed. | |
2483 | If the optional argument EXPAND is non-nil then the actions in | |
2484 | `idlwave-indent-expand-table' are performed." | |
2485 | (interactive) | |
2486 | ;; Move point out of left margin. | |
2487 | (if (save-excursion | |
2488 | (skip-chars-backward " \t") | |
2489 | (bolp)) | |
2490 | (skip-chars-forward " \t")) | |
2491 | (let ((mloc (point-marker))) | |
2492 | (save-excursion | |
2493 | (beginning-of-line) | |
2494 | (if (looking-at idlwave-comment-line-start-skip) | |
2495 | ;; Indentation for a line comment | |
2496 | (progn | |
2497 | (skip-chars-forward " \t") | |
2498 | (idlwave-indent-left-margin (idlwave-comment-hook))) | |
2499 | ;; | |
2500 | ;; Code Line | |
2501 | ;; | |
2502 | ;; Before indenting, run action routines. | |
2503 | ;; | |
2504 | (if (and expand idlwave-do-actions) | |
2505 | (mapcar 'idlwave-do-action idlwave-indent-expand-table)) | |
2506 | ;; | |
2507 | (if idlwave-do-actions | |
2508 | (mapcar 'idlwave-do-action idlwave-indent-action-table)) | |
2509 | ;; | |
2510 | ;; No longer expand abbrevs on the line. The user can do this | |
2511 | ;; manually using expand-region-abbrevs. | |
2512 | ;; | |
2513 | ;; Indent for code line | |
2514 | ;; | |
2515 | (beginning-of-line) | |
2516 | (if (or | |
2517 | ;; a label line | |
2518 | (looking-at (concat "^" idlwave-label "[ \t]*$")) | |
2519 | ;; a batch command | |
2520 | (looking-at "^[ \t]*@")) | |
2521 | ;; leave flush left | |
2522 | nil | |
2523 | ;; indent the line | |
2524 | (idlwave-indent-left-margin (idlwave-calculate-indent))) | |
2525 | ;; Adjust parallel comment | |
2526 | (end-of-line) | |
2527 | (if (idlwave-in-comment) | |
2528 | (indent-for-comment)))) | |
2529 | (goto-char mloc) | |
2530 | ;; Get rid of marker | |
2531 | (set-marker mloc nil) | |
2532 | )) | |
2533 | ||
2534 | (defun idlwave-do-action (action) | |
2535 | "Perform an action repeatedly on a line. | |
2536 | ACTION is a list (REG . FUNC). REG is a regular expression. FUNC is | |
2537 | either a function name to be called with `funcall' or a list to be | |
2538 | evaluated with `eval'. The action performed by FUNC should leave point | |
2539 | after the match for REG - otherwise an infinite loop may be entered." | |
2540 | (let ((action-key (car action)) | |
2541 | (action-routine (cdr action))) | |
2542 | (beginning-of-line) | |
2543 | (while (idlwave-look-at action-key) | |
2544 | (if (listp action-routine) | |
2545 | (eval action-routine) | |
2546 | (funcall action-routine))))) | |
2547 | ||
2548 | (defun idlwave-indent-to (col &optional min) | |
2549 | "Indent from point with spaces until column COL. | |
2550 | Inserts space before markers at point." | |
2551 | (if (not min) (setq min 0)) | |
2552 | (insert-before-markers | |
15e42531 | 2553 | (make-string (max min (- col (current-column))) ?\ ))) |
f32b3b91 CD |
2554 | |
2555 | (defun idlwave-indent-left-margin (col) | |
2556 | "Indent the current line to column COL. | |
2557 | Indents such that first non-whitespace character is at column COL | |
2558 | Inserts spaces before markers at point." | |
2559 | (save-excursion | |
2560 | (beginning-of-line) | |
2561 | (delete-horizontal-space) | |
2562 | (idlwave-indent-to col))) | |
2563 | ||
2564 | (defun idlwave-indent-subprogram () | |
2565 | "Indents program unit which contains point." | |
2566 | (interactive) | |
2567 | (save-excursion | |
2568 | (idlwave-end-of-statement) | |
2569 | (idlwave-beginning-of-subprogram) | |
2570 | (let ((beg (point))) | |
2571 | (idlwave-forward-block) | |
2572 | (message "Indenting subprogram...") | |
2573 | (indent-region beg (point) nil)) | |
2574 | (message "Indenting subprogram...done."))) | |
2575 | ||
2576 | (defun idlwave-calculate-indent () | |
2577 | "Return appropriate indentation for current line as IDL code." | |
2578 | (save-excursion | |
2579 | (beginning-of-line) | |
2580 | (cond | |
2581 | ;; Check for beginning of unit - main (beginning of buffer), pro, or | |
2582 | ;; function | |
2583 | ((idlwave-look-at idlwave-begin-unit-reg) | |
2584 | 0) | |
2585 | ;; Check for continuation line | |
2586 | ((save-excursion | |
2587 | (and (= (forward-line -1) 0) | |
2588 | (idlwave-is-continuation-line))) | |
2589 | (idlwave-calculate-cont-indent)) | |
2590 | ;; calculate indent based on previous and current statements | |
2591 | (t (let ((the-indent | |
2592 | ;; calculate indent based on previous statement | |
2593 | (save-excursion | |
2594 | (cond | |
2595 | ((idlwave-previous-statement) | |
2596 | 0) | |
2597 | ;; Main block | |
2598 | ((idlwave-look-at idlwave-begin-unit-reg t) | |
2599 | (+ (idlwave-current-statement-indent) | |
2600 | idlwave-main-block-indent)) | |
2601 | ;; Begin block | |
2602 | ((idlwave-look-at idlwave-begin-block-reg t) | |
2603 | (+ (idlwave-current-statement-indent) | |
2604 | idlwave-block-indent)) | |
2605 | ((idlwave-look-at idlwave-end-block-reg t) | |
2606 | (- (idlwave-current-statement-indent) | |
2607 | idlwave-end-offset | |
2608 | idlwave-block-indent)) | |
2609 | ((idlwave-current-statement-indent)))))) | |
2610 | ;; adjust the indentation based on the current statement | |
2611 | (cond | |
2612 | ;; End block | |
2613 | ((idlwave-look-at idlwave-end-block-reg t) | |
2614 | (+ the-indent idlwave-end-offset)) | |
2615 | (the-indent))))))) | |
2616 | ||
2617 | ;; | |
2618 | ;; Parenthesses balacing/indent | |
2619 | ;; | |
2620 | ||
2621 | (defun idlwave-calculate-cont-indent () | |
2622 | "Calculates the IDL continuation indent column from the previous statement. | |
2623 | Note that here previous statement means the beginning of the current | |
2624 | statement if this statement is a continuation of the previous line. | |
2625 | Intervening comments or comments within the previous statement can | |
2626 | screw things up if the comments contain parentheses characters." | |
2627 | (save-excursion | |
2628 | (let* (open | |
2629 | (case-fold-search t) | |
2630 | (end-reg (progn (beginning-of-line) (point))) | |
2631 | (close-exp (progn (skip-chars-forward " \t") (looking-at "\\s)"))) | |
2632 | (beg-reg (progn (idlwave-previous-statement) (point)))) | |
2633 | ;; | |
2634 | ;; If PRO or FUNCTION declaration indent after name, and first comma. | |
2635 | ;; | |
2636 | (if (idlwave-look-at "\\<\\(pro\\|function\\)\\>") | |
2637 | (progn | |
2638 | (forward-sexp 1) | |
2639 | (if (looking-at "[ \t]*,[ \t]*") | |
2640 | (goto-char (match-end 0))) | |
2641 | (current-column)) | |
2642 | ;; | |
2643 | ;; Not a PRO or FUNCTION | |
2644 | ;; | |
2645 | ;; Look for innermost unmatched open paren | |
2646 | ;; | |
2647 | (if (setq open (car (cdr (parse-partial-sexp beg-reg end-reg)))) | |
2648 | ;; Found innermost open paren. | |
2649 | (progn | |
2650 | (goto-char open) | |
2651 | ;; Line up with next word unless this is a closing paren. | |
2652 | (cond | |
2653 | ;; This is a closed paren - line up under open paren. | |
2654 | (close-exp | |
2655 | (current-column)) | |
2656 | ;; Empty - just add regular indent. Take into account | |
2657 | ;; the forward-char | |
2658 | ((progn | |
2659 | ;; Skip paren | |
2660 | (forward-char 1) | |
2661 | (looking-at "[ \t$]*$")) | |
2662 | (+ (current-column) idlwave-continuation-indent -1)) | |
2663 | ;; Line up with first word | |
2664 | ((progn | |
2665 | (skip-chars-forward " \t") | |
2666 | (current-column))))) | |
2667 | ;; No unmatched open paren. Just a simple continuation. | |
2668 | (goto-char beg-reg) | |
2669 | (+ (idlwave-current-indent) | |
2670 | ;; Make adjustments based on current line | |
2671 | (cond | |
2672 | ;; Else statement | |
2673 | ((progn | |
2674 | (goto-char end-reg) | |
2675 | (skip-chars-forward " \t") | |
2676 | (looking-at "else")) | |
2677 | 0) | |
2678 | ;; Ordinary continuation | |
2679 | (idlwave-continuation-indent)))))))) | |
2680 | ||
15e42531 | 2681 | (defun idlwave-find-key-old (key-reg &optional dir nomark limit) |
f32b3b91 CD |
2682 | "Move in direction of the optional second argument DIR to the |
2683 | next keyword not contained in a comment or string and occurring before | |
2684 | optional fourth argument LIMIT. DIR defaults to forward direction. If | |
2685 | DIR is negative the search is backwards, otherwise, it is | |
2686 | forward. LIMIT defaults to the beginning or end of the buffer | |
2687 | according to the direction of the search. The keyword is given by the | |
2688 | regular expression argument KEY-REG. The search is case insensitive. | |
2689 | Returns position if successful and nil otherwise. If found | |
2690 | `push-mark' is executed unless the optional third argument NOMARK is | |
2691 | non-nil. If found, the point is left at the keyword beginning." | |
2692 | (or dir (setq dir 0)) | |
2693 | (or limit (setq limit (cond ((>= dir 0) (point-max)) ((point-min))))) | |
2694 | (let (found | |
f32b3b91 | 2695 | (case-fold-search t)) |
15e42531 CD |
2696 | (idlwave-with-special-syntax |
2697 | (save-excursion | |
2698 | (if (>= dir 0) | |
2699 | (while (and (setq found (and | |
2700 | (re-search-forward key-reg limit t) | |
2701 | (match-beginning 0))) | |
2702 | (idlwave-quoted) | |
2703 | (not (eobp)))) | |
2704 | (while (and (setq found (and | |
2705 | (re-search-backward key-reg limit t) | |
2706 | (match-beginning 0))) | |
2707 | (idlwave-quoted) | |
2708 | (not (bobp))))))) | |
f32b3b91 CD |
2709 | (if found (progn |
2710 | (if (not nomark) (push-mark)) | |
2711 | (goto-char found))))) | |
2712 | ||
15e42531 CD |
2713 | ;; FIXME: The following is an experimental re-write of the previous |
2714 | ;; function. Still needs to be tested. | |
2715 | (defun idlwave-find-key (key-re &optional dir nomark limit) | |
2716 | "Move to next match of the regular expression KEY-RE. | |
2717 | Matches inside comments or string constants will be ignored. | |
2718 | If DIR is negative, the search will be backwards. | |
2719 | At a successful match, the mark is pushed unless NOMARK is non-nil. | |
2720 | Searches are limited to LIMIT. | |
2721 | Searches are case-insensitive and use a special syntax table which | |
2722 | treats `$' and `_' as word characters. | |
2723 | Return value is the beginning of the match or (in case of failure) nil." | |
2724 | (setq dir (or dir 0)) | |
2725 | (let ((case-fold-search t) | |
2726 | (search-func (if (> dir 0) 're-search-forward 're-search-backward)) | |
2727 | found) | |
2728 | (idlwave-with-special-syntax | |
2729 | (save-excursion | |
2730 | (catch 'exit | |
2731 | (while (funcall search-func key-re limit t) | |
2732 | (if (not (idlwave-quoted)) | |
2733 | (throw 'exit (setq found (match-beginning 0)))))))) | |
2734 | (if found | |
2735 | (progn | |
2736 | (if (not nomark) (push-mark)) | |
2737 | (goto-char found) | |
2738 | found) | |
2739 | nil))) | |
2740 | ||
f32b3b91 CD |
2741 | (defun idlwave-block-jump-out (&optional dir nomark) |
2742 | "When optional argument DIR is non-negative, move forward to end of | |
2743 | current block using the `idlwave-begin-block-reg' and `idlwave-end-block-reg' | |
2744 | regular expressions. When DIR is negative, move backwards to block beginning. | |
2745 | Recursively calls itself to skip over nested blocks. DIR defaults to | |
2746 | forward. Calls `push-mark' unless the optional argument NOMARK is | |
2747 | non-nil. Movement is limited by the start of program units because of | |
2748 | possibility of unbalanced blocks." | |
2749 | (interactive "P") | |
2750 | (or dir (setq dir 0)) | |
2751 | (let* ((here (point)) | |
2752 | (case-fold-search t) | |
2753 | (limit (if (>= dir 0) (point-max) (point-min))) | |
2754 | (block-limit (if (>= dir 0) | |
2755 | idlwave-begin-block-reg | |
2756 | idlwave-end-block-reg)) | |
2757 | found | |
2758 | (block-reg (concat idlwave-begin-block-reg "\\|" | |
2759 | idlwave-end-block-reg)) | |
2760 | (unit-limit (or (save-excursion | |
2761 | (if (< dir 0) | |
2762 | (idlwave-find-key | |
2763 | idlwave-begin-unit-reg dir t limit) | |
2764 | (end-of-line) | |
2765 | (idlwave-find-key | |
2766 | idlwave-end-unit-reg dir t limit))) | |
2767 | limit))) | |
2768 | (if (>= dir 0) (end-of-line)) ;Make sure we are in current block | |
2769 | (if (setq found (idlwave-find-key block-reg dir t unit-limit)) | |
2770 | (while (and found (looking-at block-limit)) | |
2771 | (if (>= dir 0) (forward-word 1)) | |
2772 | (idlwave-block-jump-out dir t) | |
2773 | (setq found (idlwave-find-key block-reg dir t unit-limit)))) | |
2774 | (if (not nomark) (push-mark here)) | |
2775 | (if (not found) (goto-char unit-limit) | |
2776 | (if (>= dir 0) (forward-word 1))))) | |
2777 | ||
2778 | (defun idlwave-current-statement-indent () | |
2779 | "Return indentation of the current statement. | |
2780 | If in a statement, moves to beginning of statement before finding indent." | |
2781 | (idlwave-beginning-of-statement) | |
2782 | (idlwave-current-indent)) | |
2783 | ||
2784 | (defun idlwave-current-indent () | |
2785 | "Return the column of the indentation of the current line. | |
2786 | Skips any whitespace. Returns 0 if the end-of-line follows the whitespace." | |
2787 | (save-excursion | |
2788 | (beginning-of-line) | |
2789 | (skip-chars-forward " \t") | |
2790 | ;; if we are at the end of blank line return 0 | |
2791 | (cond ((eolp) 0) | |
2792 | ((current-column))))) | |
2793 | ||
2794 | (defun idlwave-is-continuation-line () | |
2795 | "Tests if current line is continuation line." | |
2796 | (save-excursion | |
2797 | (idlwave-look-at "\\<\\$"))) | |
2798 | ||
2799 | (defun idlwave-is-comment-line () | |
2800 | (save-excursion | |
2801 | (beginning-of-line 1) | |
2802 | (looking-at "[ \t]*;"))) | |
2803 | ||
2804 | (defun idlwave-look-at (regexp &optional cont beg) | |
15e42531 CD |
2805 | "Searches current line from current point for REGEXP. |
2806 | If optional argument CONT is non-nil, searches to the end of | |
2807 | the current statement. | |
2808 | If optional arg BEG is non-nil, search starts from the beginning of the | |
2809 | current statement. | |
2810 | Ignores matches that end in a comment or inside a string expression. | |
2811 | Returns point if successful, nil otherwise. | |
2812 | This function produces unexpected results if REGEXP contains quotes or | |
2813 | a comment delimiter. The search is case insensitive. | |
2814 | If successful leaves point after the match, otherwise, does not move point." | |
f32b3b91 | 2815 | (let ((here (point)) |
f32b3b91 | 2816 | (case-fold-search t) |
15e42531 CD |
2817 | (eos (save-excursion |
2818 | (if cont (idlwave-end-of-statement) (end-of-line)) | |
2819 | (point))) | |
f32b3b91 | 2820 | found) |
15e42531 CD |
2821 | (idlwave-with-special-syntax |
2822 | (if beg (idlwave-beginning-of-statement)) | |
2823 | (while (and (setq found (re-search-forward regexp eos t)) | |
2824 | (idlwave-quoted)))) | |
f32b3b91 CD |
2825 | (if (not found) (goto-char here)) |
2826 | found)) | |
2827 | ||
2828 | (defun idlwave-fill-paragraph (&optional nohang) | |
2829 | "Fills paragraphs in comments. | |
2830 | A paragraph is made up of all contiguous lines having the same comment | |
2831 | leader (the leading whitespace before the comment delimiter and the | |
2832 | comment delimiter). In addition, paragraphs are separated by blank | |
2833 | line comments. The indentation is given by the hanging indent of the | |
2834 | first line, otherwise by the minimum indentation of the lines after | |
2835 | the first line. The indentation of the first line does not change. | |
2836 | Does not effect code lines. Does not fill comments on the same line | |
2837 | with code. The hanging indent is given by the end of the first match | |
2838 | matching `idlwave-hang-indent-regexp' on the paragraph's first line . If the | |
2839 | optional argument NOHANG is non-nil then the hanging indent is | |
2840 | ignored." | |
2841 | (interactive "P") | |
2842 | ;; check if this is a line comment | |
2843 | (if (save-excursion | |
2844 | (beginning-of-line) | |
2845 | (skip-chars-forward " \t") | |
2846 | (looking-at comment-start)) | |
2847 | (let | |
2848 | ((indent 999) | |
2849 | pre here diff fill-prefix-reg bcl first-indent | |
2850 | hang start end) | |
2851 | ;; Change tabs to spaces in the surrounding paragraph. | |
2852 | ;; The surrounding paragraph will be the largest containing block of | |
2853 | ;; contiguous line comments. Thus, we may be changing tabs in | |
2854 | ;; a much larger area than is needed, but this is the easiest | |
2855 | ;; brute force way to do it. | |
2856 | ;; | |
2857 | ;; This has the undesirable side effect of replacing the tabs | |
2858 | ;; permanently without the user's request or knowledge. | |
2859 | (save-excursion | |
2860 | (backward-paragraph) | |
2861 | (setq start (point))) | |
2862 | (save-excursion | |
2863 | (forward-paragraph) | |
2864 | (setq end (point))) | |
2865 | (untabify start end) | |
2866 | ;; | |
2867 | (setq here (point)) | |
2868 | (beginning-of-line) | |
2869 | (setq bcl (point)) | |
2870 | (re-search-forward | |
2871 | (concat "^[ \t]*" comment-start "+") | |
2872 | (save-excursion (end-of-line) (point)) | |
2873 | t) | |
2874 | ;; Get the comment leader on the line and its length | |
2875 | (setq pre (current-column)) | |
2876 | ;; the comment leader is the indentation plus exactly the | |
2877 | ;; number of consecutive ";". | |
2878 | (setq fill-prefix-reg | |
2879 | (concat | |
2880 | (setq fill-prefix | |
2881 | (regexp-quote | |
2882 | (buffer-substring (save-excursion | |
2883 | (beginning-of-line) (point)) | |
2884 | (point)))) | |
2885 | "[^;]")) | |
2886 | ||
2887 | ;; Mark the beginning and end of the paragraph | |
2888 | (goto-char bcl) | |
2889 | (while (and (looking-at fill-prefix-reg) | |
2890 | (not (looking-at paragraph-separate)) | |
2891 | (not (bobp))) | |
2892 | (forward-line -1)) | |
2893 | ;; Move to first line of paragraph | |
2894 | (if (/= (point) bcl) | |
2895 | (forward-line 1)) | |
2896 | (setq start (point)) | |
2897 | (goto-char bcl) | |
2898 | (while (and (looking-at fill-prefix-reg) | |
2899 | (not (looking-at paragraph-separate)) | |
2900 | (not (eobp))) | |
2901 | (forward-line 1)) | |
2902 | (beginning-of-line) | |
2903 | (if (or (not (looking-at fill-prefix-reg)) | |
2904 | (looking-at paragraph-separate)) | |
2905 | (forward-line -1)) | |
2906 | (end-of-line) | |
2907 | ;; if at end of buffer add a newline (need this because | |
2908 | ;; fill-region needs END to be at the beginning of line after | |
2909 | ;; the paragraph or it will add a line). | |
2910 | (if (eobp) | |
2911 | (progn (insert ?\n) (backward-char 1))) | |
2912 | ;; Set END to the beginning of line after the paragraph | |
2913 | ;; END is calculated as distance from end of buffer | |
2914 | (setq end (- (point-max) (point) 1)) | |
2915 | ;; | |
2916 | ;; Calculate the indentation for the paragraph. | |
2917 | ;; | |
2918 | ;; In the following while statements, after one iteration | |
2919 | ;; point will be at the beginning of a line in which case | |
2920 | ;; the while will not be executed for the | |
2921 | ;; the first paragraph line and thus will not affect the | |
2922 | ;; indentation. | |
2923 | ;; | |
2924 | ;; First check to see if indentation is based on hanging indent. | |
2925 | (if (and (not nohang) idlwave-hanging-indent | |
2926 | (setq hang | |
2927 | (save-excursion | |
2928 | (goto-char start) | |
2929 | (idlwave-calc-hanging-indent)))) | |
2930 | ;; Adjust lines of paragraph by inserting spaces so that | |
2931 | ;; each line's indent is at least as great as the hanging | |
2932 | ;; indent. This is needed for fill-paragraph to work with | |
2933 | ;; a fill-prefix. | |
2934 | (progn | |
2935 | (setq indent hang) | |
2936 | (beginning-of-line) | |
2937 | (while (> (point) start) | |
2938 | (re-search-forward comment-start-skip | |
2939 | (save-excursion (end-of-line) (point)) | |
2940 | t) | |
2941 | (if (> (setq diff (- indent (current-column))) 0) | |
2942 | (progn | |
2943 | (if (>= here (point)) | |
2944 | ;; adjust the original location for the | |
2945 | ;; inserted text. | |
2946 | (setq here (+ here diff))) | |
15e42531 | 2947 | (insert (make-string diff ?\ )))) |
f32b3b91 CD |
2948 | (forward-line -1)) |
2949 | ) | |
2950 | ||
2951 | ;; No hang. Instead find minimum indentation of paragraph | |
2952 | ;; after first line. | |
2953 | ;; For the following while statement, since START is at the | |
2954 | ;; beginning of line and END is at the the end of line | |
2955 | ;; point is greater than START at least once (which would | |
2956 | ;; be the case for a single line paragraph). | |
2957 | (while (> (point) start) | |
2958 | (beginning-of-line) | |
2959 | (setq indent | |
2960 | (min indent | |
2961 | (progn | |
2962 | (re-search-forward | |
2963 | comment-start-skip | |
2964 | (save-excursion (end-of-line) (point)) | |
2965 | t) | |
2966 | (current-column)))) | |
2967 | (forward-line -1)) | |
2968 | ) | |
2969 | (setq fill-prefix (concat fill-prefix | |
2970 | (make-string (- indent pre) | |
15e42531 | 2971 | ?\ ))) |
f32b3b91 CD |
2972 | ;; first-line indent |
2973 | (setq first-indent | |
2974 | (max | |
2975 | (progn | |
2976 | (re-search-forward | |
2977 | comment-start-skip | |
2978 | (save-excursion (end-of-line) (point)) | |
2979 | t) | |
2980 | (current-column)) | |
2981 | indent)) | |
2982 | ||
2983 | ;; try to keep point at its original place | |
2984 | (goto-char here) | |
2985 | ||
2986 | ;; In place of the more modern fill-region-as-paragraph, a hack | |
2987 | ;; to keep whitespace untouched on the first line within the | |
2988 | ;; indent length and to preserve any indent on the first line | |
2989 | ;; (first indent). | |
2990 | (save-excursion | |
2991 | (setq diff | |
2992 | (buffer-substring start (+ start first-indent -1))) | |
15e42531 | 2993 | (subst-char-in-region start (+ start first-indent -1) ?\ ?~ nil) |
f32b3b91 CD |
2994 | (fill-region-as-paragraph |
2995 | start | |
2996 | (- (point-max) end) | |
2997 | (current-justification) | |
2998 | nil) | |
2999 | (delete-region start (+ start first-indent -1)) | |
3000 | (goto-char start) | |
3001 | (insert diff)) | |
3002 | ;; When we want the point at the beginning of the comment | |
3003 | ;; body fill-region will put it at the beginning of the line. | |
3004 | (if (bolp) (skip-chars-forward (concat " \t" comment-start))) | |
3005 | (setq fill-prefix nil)))) | |
3006 | ||
3007 | (defun idlwave-calc-hanging-indent () | |
3008 | "Calculate the position of the hanging indent for the comment | |
3009 | paragraph. The hanging indent position is given by the first match | |
3010 | with the `idlwave-hang-indent-regexp'. If `idlwave-use-last-hang-indent' is | |
3011 | non-nil then use last occurrence matching `idlwave-hang-indent-regexp' on | |
3012 | the line. | |
3013 | If not found returns nil." | |
3014 | (if idlwave-use-last-hang-indent | |
3015 | (save-excursion | |
3016 | (end-of-line) | |
3017 | (if (re-search-backward | |
3018 | idlwave-hang-indent-regexp | |
3019 | (save-excursion (beginning-of-line) (point)) | |
3020 | t) | |
3021 | (+ (current-column) (length idlwave-hang-indent-regexp)))) | |
3022 | (save-excursion | |
3023 | (beginning-of-line) | |
3024 | (if (re-search-forward | |
3025 | idlwave-hang-indent-regexp | |
3026 | (save-excursion (end-of-line) (point)) | |
3027 | t) | |
3028 | (current-column))))) | |
3029 | ||
3030 | (defun idlwave-auto-fill () | |
3031 | "Called to break lines in auto fill mode. | |
3032 | Only fills comment lines if `idlwave-fill-comment-line-only' is non-nil. | |
3033 | Places a continuation character at the end of the line | |
3034 | if not in a comment. Splits strings with IDL concatenation operator | |
3035 | `+' if `idlwave-auto-fill-split-string is non-nil." | |
3036 | (if (<= (current-column) fill-column) | |
3037 | nil ; do not to fill | |
3038 | (if (or (not idlwave-fill-comment-line-only) | |
3039 | (save-excursion | |
3040 | ;; Check for comment line | |
3041 | (beginning-of-line) | |
3042 | (looking-at idlwave-comment-line-start-skip))) | |
3043 | (let (beg) | |
3044 | (idlwave-indent-line) | |
3045 | ;; Prevent actions do-auto-fill which calls indent-line-function. | |
3046 | (let (idlwave-do-actions | |
3047 | (paragraph-start ".") | |
3048 | (paragraph-separate ".")) | |
3049 | (do-auto-fill)) | |
3050 | (save-excursion | |
3051 | (end-of-line 0) | |
3052 | ;; Indent the split line | |
3053 | (idlwave-indent-line) | |
3054 | ) | |
3055 | (if (save-excursion | |
3056 | (beginning-of-line) | |
3057 | (looking-at idlwave-comment-line-start-skip)) | |
3058 | ;; A continued line comment | |
3059 | ;; We treat continued line comments as part of a comment | |
3060 | ;; paragraph. So we check for a hanging indent. | |
3061 | (if idlwave-hanging-indent | |
3062 | (let ((here (- (point-max) (point))) | |
3063 | (indent | |
3064 | (save-excursion | |
3065 | (forward-line -1) | |
3066 | (idlwave-calc-hanging-indent)))) | |
3067 | (if indent | |
3068 | (progn | |
3069 | ;; Remove whitespace between comment delimiter and | |
3070 | ;; text, insert spaces for appropriate indentation. | |
3071 | (beginning-of-line) | |
3072 | (re-search-forward | |
3073 | comment-start-skip | |
3074 | (save-excursion (end-of-line) (point)) t) | |
3075 | (delete-horizontal-space) | |
3076 | (idlwave-indent-to indent) | |
3077 | (goto-char (- (point-max) here))) | |
3078 | ))) | |
3079 | ;; Split code or comment? | |
3080 | (if (save-excursion | |
3081 | (end-of-line 0) | |
3082 | (idlwave-in-comment)) | |
3083 | ;; Splitting a non-line comment. | |
3084 | ;; Insert the comment delimiter from split line | |
3085 | (progn | |
3086 | (save-excursion | |
3087 | (beginning-of-line) | |
3088 | (skip-chars-forward " \t") | |
3089 | ;; Insert blank to keep off beginning of line | |
3090 | (insert " " | |
3091 | (save-excursion | |
3092 | (forward-line -1) | |
3093 | (buffer-substring (idlwave-goto-comment) | |
3094 | (progn | |
3095 | (skip-chars-forward "; ") | |
3096 | (point)))))) | |
3097 | (idlwave-indent-line)) | |
3098 | ;; Split code line - add continuation character | |
3099 | (save-excursion | |
3100 | (end-of-line 0) | |
3101 | ;; Check to see if we split a string | |
3102 | (if (and (setq beg (idlwave-in-quote)) | |
3103 | idlwave-auto-fill-split-string) | |
3104 | ;; Split the string and concatenate. | |
3105 | ;; The first extra space is for the space | |
3106 | ;; the line was split. That space was removed. | |
3107 | (insert " " (char-after beg) " +")) | |
3108 | (insert " $")) | |
3109 | (if beg | |
3110 | (if idlwave-auto-fill-split-string | |
3111 | ;; Make the second part of continued string | |
3112 | (save-excursion | |
3113 | (beginning-of-line) | |
3114 | (skip-chars-forward " \t") | |
3115 | (insert (char-after beg))) | |
3116 | ;; Warning | |
3117 | (beep) | |
3118 | (message "Warning: continuation inside a string."))) | |
3119 | ;; Although do-auto-fill (via indent-new-comment-line) calls | |
3120 | ;; idlwave-indent-line for the new line, re-indent again | |
3121 | ;; because of the addition of the continuation character. | |
3122 | (idlwave-indent-line)) | |
3123 | ))))) | |
3124 | ||
3125 | (defun idlwave-auto-fill-mode (arg) | |
3126 | "Toggle auto-fill mode for IDL mode. | |
3127 | With arg, turn auto-fill mode on if arg is positive. | |
3128 | In auto-fill mode, inserting a space at a column beyond `fill-column' | |
3129 | automatically breaks the line at a previous space." | |
3130 | (interactive "P") | |
3131 | (prog1 (set idlwave-fill-function | |
3132 | (if (if (null arg) | |
3133 | (not (symbol-value idlwave-fill-function)) | |
3134 | (> (prefix-numeric-value arg) 0)) | |
3135 | 'idlwave-auto-fill | |
3136 | nil)) | |
3137 | ;; update mode-line | |
3138 | (set-buffer-modified-p (buffer-modified-p)))) | |
3139 | ||
3140 | (defun idlwave-doc-header (&optional nomark ) | |
3141 | "Insert a documentation header at the beginning of the unit. | |
3142 | Inserts the value of the variable idlwave-file-header. Sets mark before | |
3143 | moving to do insertion unless the optional prefix argument NOMARK | |
3144 | is non-nil." | |
3145 | (interactive "P") | |
3146 | (or nomark (push-mark)) | |
3147 | ;; make sure we catch the current line if it begins the unit | |
3148 | (end-of-line) | |
3149 | (idlwave-beginning-of-subprogram) | |
3150 | (beginning-of-line) | |
3151 | ;; skip function or procedure line | |
3152 | (if (idlwave-look-at "\\<\\(pro\\|function\\)\\>") | |
3153 | (progn | |
3154 | (idlwave-end-of-statement) | |
3155 | (if (> (forward-line 1) 0) (insert "\n")))) | |
3156 | (if idlwave-file-header | |
3157 | (cond ((car idlwave-file-header) | |
3158 | (insert-file (car idlwave-file-header))) | |
3159 | ((stringp (car (cdr idlwave-file-header))) | |
3160 | (insert (car (cdr idlwave-file-header))))))) | |
3161 | ||
3162 | ||
3163 | (defun idlwave-default-insert-timestamp () | |
3164 | "Default timestamp insertion function" | |
3165 | (insert (current-time-string)) | |
3166 | (insert ", " (user-full-name)) | |
3167 | (insert " <" (user-login-name) "@" (system-name) ">") | |
3168 | ;; Remove extra spaces from line | |
3169 | (idlwave-fill-paragraph) | |
3170 | ;; Insert a blank line comment to separate from the date entry - | |
3171 | ;; will keep the entry from flowing onto date line if re-filled. | |
3172 | (insert "\n;\n;\t\t")) | |
3173 | ||
3174 | (defun idlwave-doc-modification () | |
3175 | "Insert a brief modification log at the beginning of the current program. | |
3176 | Looks for an occurrence of the value of user variable | |
3177 | `idlwave-doc-modifications-keyword' if non-nil. Inserts time and user name | |
3178 | and places the point for the user to add a log. Before moving, saves | |
3179 | location on mark ring so that the user can return to previous point." | |
3180 | (interactive) | |
3181 | (push-mark) | |
3182 | ;; make sure we catch the current line if it begins the unit | |
3183 | (end-of-line) | |
3184 | (idlwave-beginning-of-subprogram) | |
3185 | (let ((pro (idlwave-look-at "\\<\\(function\\|pro\\)\\>")) | |
3186 | (case-fold-search nil)) | |
3187 | (if (re-search-forward | |
3188 | (concat idlwave-doc-modifications-keyword ":") | |
3189 | ;; set search limit at next unit beginning | |
3190 | (save-excursion (idlwave-end-of-subprogram) (point)) | |
3191 | t) | |
3192 | (end-of-line) | |
3193 | ;; keyword not present, insert keyword | |
3194 | (if pro (idlwave-next-statement)) ; skip past pro or function statement | |
3195 | (beginning-of-line) | |
3196 | (insert "\n" comment-start "\n") | |
3197 | (forward-line -2) | |
3198 | (insert comment-start " " idlwave-doc-modifications-keyword ":"))) | |
3199 | (idlwave-newline) | |
3200 | (beginning-of-line) | |
3201 | (insert ";\n;\t") | |
3202 | (run-hooks 'idlwave-timestamp-hook)) | |
3203 | ||
3204 | ;;; CJC 3/16/93 | |
3205 | ;;; Interface to expand-region-abbrevs which did not work when the | |
3206 | ;;; abbrev hook associated with an abbrev moves point backwards | |
3207 | ;;; after abbrev expansion, e.g., as with the abbrev '.n'. | |
3208 | ;;; The original would enter an infinite loop in attempting to expand | |
3209 | ;;; .n (it would continually expand and unexpand the abbrev without expanding | |
3210 | ;;; because the point would keep going back to the beginning of the | |
3211 | ;;; abbrev instead of to the end of the abbrev). We now keep the | |
3212 | ;;; abbrev hook from moving backwards. | |
3213 | ;;; | |
3214 | (defun idlwave-expand-region-abbrevs (start end) | |
3215 | "Expand each abbrev occurrence in the region. | |
3216 | Calling from a program, arguments are START END." | |
3217 | (interactive "r") | |
3218 | (save-excursion | |
3219 | (goto-char (min start end)) | |
3220 | (let ((idlwave-show-block nil) ;Do not blink | |
3221 | (idlwave-abbrev-move nil)) ;Do not move | |
3222 | (expand-region-abbrevs start end 'noquery)))) | |
3223 | ||
3224 | (defun idlwave-quoted () | |
3225 | "Returns t if point is in a comment or quoted string. | |
3226 | nil otherwise." | |
3227 | (or (idlwave-in-comment) (idlwave-in-quote))) | |
3228 | ||
3229 | (defun idlwave-in-quote () | |
3230 | "Returns location of the opening quote | |
3231 | if point is in a IDL string constant, nil otherwise. | |
3232 | Ignores comment delimiters on the current line. | |
3233 | Properly handles nested quotation marks and octal | |
3234 | constants - a double quote followed by an octal digit." | |
3235 | ;;; Treat an octal inside an apostrophe to be a normal string. Treat a | |
3236 | ;;; double quote followed by an octal digit to be an octal constant | |
3237 | ;;; rather than a string. Therefore, there is no terminating double | |
3238 | ;;; quote. | |
3239 | (save-excursion | |
3240 | ;; Because single and double quotes can quote each other we must | |
3241 | ;; search for the string start from the beginning of line. | |
3242 | (let* ((start (point)) | |
3243 | (eol (progn (end-of-line) (point))) | |
3244 | (bq (progn (beginning-of-line) (point))) | |
3245 | (endq (point)) | |
3246 | (data (match-data)) | |
3247 | delim | |
3248 | found) | |
3249 | (while (< endq start) | |
3250 | ;; Find string start | |
3251 | ;; Don't find an octal constant beginning with a double quote | |
3252 | (if (re-search-forward "\"[^0-7]\\|'\\|\"$" eol 'lim) | |
3253 | ;; Find the string end. | |
3254 | ;; In IDL, two consecutive delimiters after the start of a | |
3255 | ;; string act as an | |
3256 | ;; escape for the delimiter in the string. | |
3257 | ;; Two consecutive delimiters alone (i.e., not after the | |
3258 | ;; start of a string) is the the null string. | |
3259 | (progn | |
3260 | ;; Move to position after quote | |
3261 | (goto-char (1+ (match-beginning 0))) | |
3262 | (setq bq (1- (point))) | |
3263 | ;; Get the string delimiter | |
3264 | (setq delim (char-to-string (preceding-char))) | |
3265 | ;; Check for null string | |
3266 | (if (looking-at delim) | |
3267 | (progn (setq endq (point)) (forward-char 1)) | |
3268 | ;; Look for next unpaired delimiter | |
3269 | (setq found (search-forward delim eol 'lim)) | |
3270 | (while (looking-at delim) | |
3271 | (forward-char 1) | |
3272 | (setq found (search-forward delim eol 'lim))) | |
3273 | (if found | |
3274 | (setq endq (- (point) 1)) | |
3275 | (setq endq (point))) | |
3276 | )) | |
3277 | (progn (setq bq (point)) (setq endq (point))))) | |
3278 | (store-match-data data) | |
3279 | ;; return string beginning position or nil | |
3280 | (if (> start bq) bq)))) | |
3281 | ||
3282 | ;; Statement templates | |
3283 | ||
3284 | ;; Replace these with a general template function, something like | |
3285 | ;; expand.el (I think there was also something with a name similar to | |
3286 | ;; dmacro.el) | |
3287 | ||
3288 | (defun idlwave-template (s1 s2 &optional prompt noindent) | |
3289 | "Build a template with optional prompt expression. | |
3290 | ||
3291 | Opens a line if point is not followed by a newline modulo intervening | |
3292 | whitespace. S1 and S2 are strings. S1 is inserted at point followed | |
595ab50b CD |
3293 | by S2. Point is inserted between S1 and S2. The case of S1 and S2 is |
3294 | adjusted according to `idlwave-abbrev-change-case'. If optional argument | |
f32b3b91 CD |
3295 | PROMPT is a string then it is displayed as a message in the |
3296 | minibuffer. The PROMPT serves as a reminder to the user of an | |
3297 | expression to enter. | |
3298 | ||
3299 | The lines containing S1 and S2 are reindented using `indent-region' | |
3300 | unless the optional second argument NOINDENT is non-nil." | |
15e42531 CD |
3301 | (if (eq major-mode 'idlwave-shell-mode) |
3302 | ;; This is a gross hack to avoit template abbrev expasion | |
3303 | ;; in the shell. FIXME: This is a dirty hack. | |
3304 | (if (and (eq this-command 'self-insert-command) | |
3305 | (equal last-abbrev-location (point))) | |
3306 | (insert last-abbrev-text) | |
3307 | (error "No templates in idlwave-shell")) | |
3308 | (cond ((eq idlwave-abbrev-change-case 'down) | |
3309 | (setq s1 (downcase s1) s2 (downcase s2))) | |
3310 | (idlwave-abbrev-change-case | |
3311 | (setq s1 (upcase s1) s2 (upcase s2)))) | |
3312 | (let ((beg (save-excursion (beginning-of-line) (point))) | |
3313 | end) | |
3314 | (if (not (looking-at "\\s-*\n")) | |
3315 | (open-line 1)) | |
3316 | (insert s1) | |
3317 | (save-excursion | |
3318 | (insert s2) | |
3319 | (setq end (point))) | |
3320 | (if (not noindent) | |
3321 | (indent-region beg end nil)) | |
3322 | (if (stringp prompt) | |
3323 | (message prompt))))) | |
3324 | ||
595ab50b CD |
3325 | (defun idlwave-rw-case (string) |
3326 | "Make STRING have the case required by `idlwave-reserved-word-upcase'." | |
3327 | (if idlwave-reserved-word-upcase | |
3328 | (upcase string) | |
3329 | string)) | |
3330 | ||
f32b3b91 CD |
3331 | (defun idlwave-elif () |
3332 | "Build skeleton IDL if-else block." | |
3333 | (interactive) | |
595ab50b CD |
3334 | (idlwave-template |
3335 | (idlwave-rw-case "if") | |
3336 | (idlwave-rw-case " then begin\n\nendif else begin\n\nendelse") | |
3337 | "Condition expression")) | |
f32b3b91 CD |
3338 | |
3339 | (defun idlwave-case () | |
3340 | "Build skeleton IDL case statement." | |
3341 | (interactive) | |
595ab50b CD |
3342 | (idlwave-template |
3343 | (idlwave-rw-case "case") | |
3344 | (idlwave-rw-case " of\n\nendcase") | |
3345 | "Selector expression")) | |
f32b3b91 CD |
3346 | |
3347 | (defun idlwave-for () | |
3348 | "Build skeleton for loop statment." | |
3349 | (interactive) | |
595ab50b CD |
3350 | (idlwave-template |
3351 | (idlwave-rw-case "for") | |
3352 | (idlwave-rw-case " do begin\n\nendfor") | |
3353 | "Loop expression")) | |
f32b3b91 CD |
3354 | |
3355 | (defun idlwave-if () | |
3356 | "Build skeleton for loop statment." | |
3357 | (interactive) | |
595ab50b CD |
3358 | (idlwave-template |
3359 | (idlwave-rw-case "if") | |
3360 | (idlwave-rw-case " then begin\n\nendif") | |
3361 | "Scalar logical expression")) | |
f32b3b91 CD |
3362 | |
3363 | (defun idlwave-procedure () | |
3364 | (interactive) | |
595ab50b CD |
3365 | (idlwave-template |
3366 | (idlwave-rw-case "pro") | |
3367 | (idlwave-rw-case "\n\nreturn\nend") | |
3368 | "Procedure name")) | |
f32b3b91 CD |
3369 | |
3370 | (defun idlwave-function () | |
3371 | (interactive) | |
595ab50b CD |
3372 | (idlwave-template |
3373 | (idlwave-rw-case "function") | |
3374 | (idlwave-rw-case "\n\nreturn\nend") | |
3375 | "Function name")) | |
f32b3b91 CD |
3376 | |
3377 | (defun idlwave-repeat () | |
3378 | (interactive) | |
595ab50b CD |
3379 | (idlwave-template |
3380 | (idlwave-rw-case "repeat begin\n\nendrep until") | |
3381 | (idlwave-rw-case "") | |
3382 | "Exit condition")) | |
f32b3b91 CD |
3383 | |
3384 | (defun idlwave-while () | |
3385 | (interactive) | |
595ab50b CD |
3386 | (idlwave-template |
3387 | (idlwave-rw-case "while") | |
3388 | (idlwave-rw-case " do begin\n\nendwhile") | |
3389 | "Entry condition")) | |
f32b3b91 CD |
3390 | |
3391 | (defun idlwave-split-string (string &optional pattern) | |
3392 | "Return a list of substrings of STRING which are separated by PATTERN. | |
3393 | If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." | |
3394 | (or pattern | |
3395 | (setq pattern "[ \f\t\n\r\v]+")) | |
3396 | (let (parts (start 0)) | |
3397 | (while (string-match pattern string start) | |
3398 | (setq parts (cons (substring string start (match-beginning 0)) parts) | |
3399 | start (match-end 0))) | |
3400 | (nreverse (cons (substring string start) parts)))) | |
3401 | ||
3402 | (defun idlwave-replace-string (string replace_string replace_with) | |
3403 | (let* ((start 0) | |
3404 | (last (length string)) | |
3405 | (ret_string "") | |
3406 | end) | |
3407 | (while (setq end (string-match replace_string string start)) | |
3408 | (setq ret_string | |
3409 | (concat ret_string (substring string start end) replace_with)) | |
3410 | (setq start (match-end 0))) | |
3411 | (setq ret_string (concat ret_string (substring string start last))))) | |
3412 | ||
3413 | (defun idlwave-get-buffer-visiting (file) | |
3414 | ;; Return the buffer currently visiting FILE | |
3415 | (cond | |
3416 | ((boundp 'find-file-compare-truenames) ; XEmacs | |
3417 | (let ((find-file-compare-truenames t)) | |
3418 | (get-file-buffer file))) | |
3419 | ((fboundp 'find-buffer-visiting) ; Emacs | |
3420 | (find-buffer-visiting file)) | |
3421 | (t (error "This should not happen (idlwave-get-buffer-visiting)")))) | |
3422 | ||
15e42531 CD |
3423 | (defvar idlwave-outlawed-buffers nil |
3424 | "List of buffer pulled up by idlwave for special reasons. | |
3425 | Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.") | |
3426 | ||
3427 | (defun idlwave-find-file-noselect (file &optional why) | |
f32b3b91 CD |
3428 | ;; Return a buffer visiting file. |
3429 | (or (idlwave-get-buffer-visiting file) | |
15e42531 CD |
3430 | (let ((buf (find-file-noselect file))) |
3431 | (if why (add-to-list 'idlwave-outlawed-buffers (cons buf why))) | |
3432 | buf))) | |
3433 | ||
3434 | (defun idlwave-kill-autoloaded-buffers () | |
3435 | "Cleanup by killing buffers created automatically by IDLWAVE. | |
3436 | Function prompts for a letter to identify the buffers to kill. | |
3437 | Possible letters are: | |
3438 | ||
3439 | f Buffers created by the command \\[idlwave-find-module] or mouse | |
3440 | clicks in the routine info window. | |
3441 | s Buffers created by the IDLWAVE Shell to display where execution | |
3442 | stopped or an error was found. | |
3443 | a Both of the above. | |
3444 | ||
3445 | Buffer containing unsaved changes require confirmation before they are killed." | |
3446 | (interactive) | |
3447 | (if (null idlwave-outlawed-buffers) | |
3448 | (error "No IDLWAVE-created buffers available") | |
3449 | (princ (format "Kill IDLWAVE-created buffers: [f]ind source(%d), [s]hell display(%d), [a]ll ? " | |
3450 | (idlwave-count-outlawed-buffers 'find) | |
3451 | (idlwave-count-outlawed-buffers 'shell))) | |
3452 | (let ((c (read-char))) | |
3453 | (cond | |
3454 | ((member c '(?f ?\C-f)) | |
3455 | (idlwave-do-kill-autoloaded-buffers 'find)) | |
3456 | ((member c '(?s ?\C-s)) | |
3457 | (idlwave-do-kill-autoloaded-buffers 'shell)) | |
3458 | ((member c '(?a ?\C-a)) | |
3459 | (idlwave-do-kill-autoloaded-buffers t)) | |
3460 | (t (error "Abort")))))) | |
3461 | ||
3462 | (defun idlwave-count-outlawed-buffers (tag) | |
3463 | "How many outlawed buffers have tag TAG?" | |
3464 | (length (delq nil | |
3465 | (mapcar | |
3466 | (lambda (x) (eq (cdr x) tag)) | |
3467 | idlwave-outlawed-buffers)))) | |
3468 | ||
3469 | (defun idlwave-do-kill-autoloaded-buffers (&rest reasons) | |
3470 | "Kill all buffers pulled up by IDLWAVE matching REASONS." | |
3471 | (let* ((list (copy-sequence idlwave-outlawed-buffers)) | |
3472 | (cnt 0) | |
3473 | entry) | |
3474 | (while (setq entry (pop list)) | |
3475 | (if (buffer-live-p (car entry)) | |
3476 | (and (or (memq t reasons) | |
3477 | (memq (cdr entry) reasons)) | |
3478 | (kill-buffer (car entry)) | |
3479 | (incf cnt) | |
3480 | (setq idlwave-outlawed-buffers | |
3481 | (delq entry idlwave-outlawed-buffers))) | |
3482 | (setq idlwave-outlawed-buffers | |
3483 | (delq entry idlwave-outlawed-buffers)))) | |
3484 | (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) | |
3485 | ||
3486 | (defun idlwave-revoke-license-to-kill () | |
3487 | "Remove BUFFER from the buffers which may be killed. | |
3488 | Killing would be done by `idlwave-do-kill-autoloaded-buffers'. | |
3489 | Intended for `after-save-hook'." | |
3490 | (let* ((buf (current-buffer)) | |
3491 | (entry (assq buf idlwave-outlawed-buffers))) | |
3492 | ;; Revoke license | |
3493 | (if entry | |
3494 | (setq idlwave-outlawed-buffers | |
3495 | (delq entry idlwave-outlawed-buffers))) | |
3496 | ;; Remove this function from the hook. | |
3497 | (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) | |
3498 | ||
3499 | (defvar idlwave-path-alist) | |
3500 | (defun idlwave-locate-lib-file (file) | |
f32b3b91 | 3501 | ;; Find FILE on the scanned lib path and return a buffer visiting it |
15e42531 | 3502 | (let* ((dirs idlwave-path-alist) |
f32b3b91 CD |
3503 | dir efile) |
3504 | (catch 'exit | |
15e42531 | 3505 | (while (setq dir (car (pop dirs))) |
f32b3b91 CD |
3506 | (if (file-regular-p |
3507 | (setq efile (expand-file-name file dir))) | |
15e42531 CD |
3508 | (throw 'exit efile)))))) |
3509 | (defun idlwave-expand-lib-file-name (file) | |
3510 | ;; Find FILE on the scanned lib path and return a buffer visiting it | |
3511 | (cond | |
3512 | ((null file) nil) | |
3513 | ((string-match "\\`\\({\\([0-9]+\\)}/\\)\\(.*\\)" file) | |
3514 | (expand-file-name (match-string 3 file) | |
3515 | (car (nth (1- (string-to-int (match-string 2 file))) | |
3516 | idlwave-path-alist)))) | |
3517 | ((file-name-absolute-p file) file) | |
3518 | (t (idlwave-locate-lib-file file)))) | |
f32b3b91 CD |
3519 | |
3520 | (defun idlwave-make-tags () | |
3521 | "Creates the IDL tags file IDLTAGS in the current directory from | |
3522 | the list of directories specified in the minibuffer. Directories may be | |
3523 | for example: . /usr/local/rsi/idl/lib. All the subdirectories of the | |
3524 | specified top directories are searched if the directory name is prefixed | |
3525 | by @. Specify @ directories with care, it may take a long, long time if | |
3526 | you specify /." | |
3527 | (interactive) | |
3528 | (let (directory directories cmd append status numdirs dir getsubdirs | |
3529 | buffer save_buffer files numfiles item errbuf) | |
3530 | ||
3531 | ;; | |
3532 | ;; Read list of directories | |
3533 | (setq directory (read-string "Tag Directories: " ".")) | |
3534 | (setq directories (idlwave-split-string directory "[ \t]+")) | |
3535 | ;; | |
3536 | ;; Set etags command, vars | |
3537 | (setq cmd "etags --output=IDLTAGS --language=none --regex='/[ | |
3538 | \\t]*[pP][Rr][Oo][ \\t]+\\([^ \\t,]+\\)/' --regex='/[ | |
3539 | \\t]*[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn][ \\t]+\\([^ \\t,]+\\)/' ") | |
3540 | (setq append " ") | |
3541 | (setq status 0) | |
3542 | ;; | |
3543 | ;; For each directory | |
3544 | (setq numdirs 0) | |
3545 | (setq dir (nth numdirs directories)) | |
3546 | (while (and dir) | |
3547 | ;; | |
3548 | ;; Find the subdirectories | |
3549 | (if (string-match "^[@]\\(.+\\)$" dir) | |
3550 | (setq getsubdirs t) (setq getsubdirs nil)) | |
3551 | (if (and getsubdirs) (setq dir (substring dir 1 (length dir)))) | |
3552 | (setq dir (expand-file-name dir)) | |
3553 | (if (file-directory-p dir) | |
3554 | (progn | |
3555 | (if (and getsubdirs) | |
3556 | (progn | |
3557 | (setq buffer (get-buffer-create "*idltags*")) | |
3558 | (call-process "sh" nil buffer nil "-c" | |
3559 | (concat "find " dir " -type d -print")) | |
3560 | (setq save_buffer (current-buffer)) | |
3561 | (set-buffer buffer) | |
3562 | (setq files (idlwave-split-string | |
3563 | (idlwave-replace-string | |
3564 | (buffer-substring 1 (point-max)) | |
3565 | "\n" "/*.pro ") | |
3566 | "[ \t]+")) | |
3567 | (set-buffer save_buffer) | |
3568 | (kill-buffer buffer)) | |
3569 | (setq files (list (concat dir "/*.pro")))) | |
3570 | ;; | |
3571 | ;; For each subdirectory | |
3572 | (setq numfiles 0) | |
3573 | (setq item (nth numfiles files)) | |
3574 | (while (and item) | |
3575 | ;; | |
3576 | ;; Call etags | |
3577 | (if (not (string-match "^[ \\t]*$" item)) | |
3578 | (progn | |
3579 | (message (concat "Tagging " item "...")) | |
3580 | (setq errbuf (get-buffer-create "*idltags-error*")) | |
3581 | (setq status (+ status | |
3582 | (call-process "sh" nil errbuf nil "-c" | |
3583 | (concat cmd append item)))) | |
3584 | ;; | |
3585 | ;; Append additional tags | |
3586 | (setq append " --append ") | |
3587 | (setq numfiles (1+ numfiles)) | |
3588 | (setq item (nth numfiles files))) | |
3589 | (progn | |
3590 | (setq numfiles (1+ numfiles)) | |
3591 | (setq item (nth numfiles files)) | |
3592 | ))) | |
3593 | ||
3594 | (setq numdirs (1+ numdirs)) | |
3595 | (setq dir (nth numdirs directories))) | |
3596 | (progn | |
3597 | (setq numdirs (1+ numdirs)) | |
3598 | (setq dir (nth numdirs directories))))) | |
3599 | ||
3600 | (setq errbuf (get-buffer-create "*idltags-error*")) | |
3601 | (if (= status 0) | |
3602 | (kill-buffer errbuf)) | |
3603 | (message "") | |
3604 | )) | |
3605 | ||
3606 | (defun idlwave-toggle-comment-region (beg end &optional n) | |
3607 | "Comment the lines in the region if the first non-blank line is | |
3608 | commented, and conversely, uncomment region. If optional prefix arg | |
3609 | N is non-nil, then for N positive, add N comment delimiters or for N | |
3610 | negative, remove N comment delimiters. | |
3611 | Uses `comment-region' which does not place comment delimiters on | |
3612 | blank lines." | |
3613 | (interactive "r\nP") | |
3614 | (if n | |
3615 | (comment-region beg end (prefix-numeric-value n)) | |
3616 | (save-excursion | |
3617 | (goto-char beg) | |
3618 | (beginning-of-line) | |
3619 | ;; skip blank lines | |
3620 | (skip-chars-forward " \t\n") | |
3621 | (if (looking-at (concat "[ \t]*\\(" comment-start "+\\)")) | |
3622 | (comment-region beg end | |
3623 | (- (length (buffer-substring | |
3624 | (match-beginning 1) | |
3625 | (match-end 1))))) | |
3626 | (comment-region beg end))))) | |
3627 | ||
3628 | ||
3629 | ;; ---------------------------------------------------------------------------- | |
3630 | ;; ---------------------------------------------------------------------------- | |
3631 | ;; ---------------------------------------------------------------------------- | |
3632 | ;; ---------------------------------------------------------------------------- | |
3633 | ;; | |
3634 | ;; Completion and Routine Info | |
3635 | ;; | |
3636 | ||
3637 | ;; String "intern" functions | |
3638 | ||
3639 | ;; For the completion and routine info function, we want to normalize | |
3640 | ;; the case of procedure names etc. We do this by "interning" these | |
3641 | ;; string is a hand-crafted way. Hashes are used to map the downcase | |
3642 | ;; version of the strings to the cased versions. Since these cased | |
3643 | ;; versions are really lisp objects, we can use `eq' to search, which | |
3644 | ;; is a large performance boost. | |
3645 | ;; All new strings need to be "sinterned". We do this as early as | |
3646 | ;; possible after getting these strings from completion or buffer | |
3647 | ;; substrings. So most of the code can simply assume to deal with | |
3648 | ;; "sinterned" strings. The only exception is that the functions | |
3649 | ;; which scan whole buffers for routine information do not intern the | |
3650 | ;; grabbed strings. This is only done afterwards. Therefore in these | |
3651 | ;; functions it is *not* save to assume the strings can be compared | |
3652 | ;; with `eq' and be fed into the routine assq functions. | |
3653 | ||
3654 | ;; Here we define the hashing functions. | |
3655 | ||
3656 | ;; The variables which hold the hashes. | |
3657 | (defvar idlwave-sint-routines '(nil)) | |
3658 | (defvar idlwave-sint-keywords '(nil)) | |
3659 | (defvar idlwave-sint-methods '(nil)) | |
3660 | (defvar idlwave-sint-classes '(nil)) | |
3661 | (defvar idlwave-sint-files '(nil)) | |
3662 | ||
3663 | (defun idlwave-reset-sintern (&optional what) | |
3664 | "Reset all sintern hashes." | |
3665 | ;; Make sure the hash functions are accessible. | |
3666 | (if (or (not (fboundp 'gethash)) | |
3667 | (not (fboundp 'puthash))) | |
3668 | (progn | |
3669 | (require 'cl) | |
3670 | (or (fboundp 'puthash) | |
3671 | (defalias 'puthash 'cl-puthash)))) | |
3672 | (let ((entries '((idlwave-sint-routines 1000 10) | |
3673 | (idlwave-sint-keywords 1000 10) | |
3674 | (idlwave-sint-methods 100 10) | |
3675 | (idlwave-sint-classes 10 10)))) | |
3676 | ||
3677 | ;; Make sure these are lists | |
3678 | (loop for entry in entries | |
3679 | for var = (car entry) | |
3680 | do (if (not (consp (symbol-value var))) (set var (list nil)))) | |
3681 | ||
3682 | (when (or (eq what t) (eq what 'syslib) | |
3683 | (null (cdr idlwave-sint-routines))) | |
3684 | ;; Reset the system & library hash | |
3685 | (loop for entry in entries | |
3686 | for var = (car entry) for size = (nth 1 entry) | |
3687 | do (setcdr (symbol-value var) | |
3688 | (make-hash-table ':size size ':test 'equal))) | |
3689 | (setq idlwave-sint-files nil)) | |
3690 | ||
3691 | (when (or (eq what t) (eq what 'bufsh) | |
3692 | (null (car idlwave-sint-routines))) | |
3693 | ;; Reset the buffer & shell hash | |
3694 | (loop for entry in entries | |
3695 | for var = (car entry) for size = (nth 1 entry) | |
3696 | do (setcar (symbol-value var) | |
3697 | (make-hash-table ':size size ':test 'equal)))))) | |
3698 | ||
3699 | (defun idlwave-sintern-routine-or-method (name &optional class set) | |
3700 | (if class | |
3701 | (idlwave-sintern-method name set) | |
3702 | (idlwave-sintern-routine name set))) | |
3703 | ||
3704 | (defun idlwave-sintern (stype &rest args) | |
3705 | (apply (intern (concat "idlwave-sintern-" (symbol-name stype))) args)) | |
3706 | ||
3707 | ;;(defmacro idlwave-sintern (type var) | |
3708 | ;; `(cond ((not (stringp name)) name) | |
3709 | ;; ((gethash (downcase name) (cdr ,var))) | |
3710 | ;; ((gethash (downcase name) (car ,var))) | |
3711 | ;; (set (idlwave-sintern-set name ,type ,var set)) | |
3712 | ;; (name))) | |
3713 | ||
3714 | (defun idlwave-sintern-routine (name &optional set) | |
3715 | (cond ((not (stringp name)) name) | |
3716 | ((gethash (downcase name) (cdr idlwave-sint-routines))) | |
3717 | ((gethash (downcase name) (car idlwave-sint-routines))) | |
3718 | (set (idlwave-sintern-set name 'routine idlwave-sint-routines set)) | |
3719 | (name))) | |
3720 | (defun idlwave-sintern-keyword (name &optional set) | |
3721 | (cond ((not (stringp name)) name) | |
3722 | ((gethash (downcase name) (cdr idlwave-sint-keywords))) | |
3723 | ((gethash (downcase name) (car idlwave-sint-keywords))) | |
3724 | (set (idlwave-sintern-set name 'keyword idlwave-sint-keywords set)) | |
3725 | (name))) | |
3726 | (defun idlwave-sintern-method (name &optional set) | |
3727 | (cond ((not (stringp name)) name) | |
3728 | ((gethash (downcase name) (cdr idlwave-sint-methods))) | |
3729 | ((gethash (downcase name) (car idlwave-sint-methods))) | |
3730 | (set (idlwave-sintern-set name 'method idlwave-sint-methods set)) | |
3731 | (name))) | |
3732 | (defun idlwave-sintern-class (name &optional set) | |
3733 | (cond ((not (stringp name)) name) | |
3734 | ((gethash (downcase name) (cdr idlwave-sint-classes))) | |
3735 | ((gethash (downcase name) (car idlwave-sint-classes))) | |
3736 | (set (idlwave-sintern-set name 'class idlwave-sint-classes set)) | |
3737 | (name))) | |
3738 | ||
3739 | (defun idlwave-sintern-file (name &optional set) | |
3740 | (car (or (member name idlwave-sint-files) | |
3741 | (setq idlwave-sint-files (cons name idlwave-sint-files))))) | |
3742 | ||
3743 | (defun idlwave-sintern-set (name type tables set) | |
3744 | (let* ((func (or (cdr (assq type idlwave-completion-case)) | |
3745 | 'identity)) | |
3746 | (iname (funcall (if (eq func 'preserve) 'identity func) name)) | |
3747 | (table (if (eq set 'sys) (cdr tables) (car tables)))) | |
3748 | (puthash (downcase name) iname table) | |
3749 | iname)) | |
3750 | ||
3751 | (defun idlwave-sintern-rinfo-list (list &optional set) | |
3752 | "Sintern all strings in the rinfo LIST. With optional parameter SET: | |
3753 | also set new patterns. Probably this will always have to be t." | |
3754 | (let (entry name type class kwds res source call olh new) | |
3755 | (while list | |
3756 | (setq entry (car list) | |
3757 | list (cdr list) | |
3758 | name (car entry) | |
3759 | type (nth 1 entry) | |
3760 | class (nth 2 entry) | |
3761 | source (nth 3 entry) | |
3762 | call (nth 4 entry) | |
3763 | kwds (nth 5 entry) | |
3764 | olh (nth 6 entry)) | |
3765 | (setq kwds (mapcar (lambda (x) | |
3766 | (list (idlwave-sintern-keyword (car x) set))) | |
3767 | kwds)) | |
3768 | (if class | |
3769 | (progn | |
3770 | (if (symbolp class) (setq class (symbol-name class))) | |
3771 | (setq class (idlwave-sintern-class class set)) | |
3772 | (setq name (idlwave-sintern-method name set))) | |
3773 | (setq name (idlwave-sintern-routine name set))) | |
3774 | (if (stringp (cdr source)) | |
3775 | (setcdr source (idlwave-sintern-file (cdr source) t))) | |
3776 | (setq new (if olh | |
3777 | (list name type class source call kwds olh) | |
3778 | (list name type class source call kwds))) | |
3779 | (setq res (cons new res))) | |
3780 | (nreverse res))) | |
3781 | ||
3782 | ;;--------------------------------------------------------------------------- | |
3783 | ||
3784 | ||
3785 | ;; The variables which hold the information | |
15e42531 | 3786 | (defvar idlwave-system-routines nil |
f32b3b91 CD |
3787 | "Holds the routine-info obtained by scanning buffers.") |
3788 | (defvar idlwave-buffer-routines nil | |
3789 | "Holds the routine-info obtained by scanning buffers.") | |
3790 | (defvar idlwave-compiled-routines nil | |
15e42531 CD |
3791 | "Holds the routine-info obtained by asking the shell.") |
3792 | (defvar idlwave-unresolved-routines nil | |
3793 | "Holds the unresolved routine-info obtained by asking the shell.") | |
f32b3b91 CD |
3794 | (defvar idlwave-library-routines nil |
3795 | "Holds the procedure routine-info from the library scan.") | |
15e42531 CD |
3796 | (defvar idlwave-path-alist nil |
3797 | "Alist with !PATH directories and a flag if the dir has been scanned.") | |
3798 | (defvar idlwave-true-path-alist nil | |
3799 | "Like `idlwave-path-alist', but with true filenames.") | |
f32b3b91 CD |
3800 | (defvar idlwave-routines nil |
3801 | "Holds the combinded procedure routine-info.") | |
3802 | (defvar idlwave-class-alist nil | |
3803 | "Holds the class names known to IDLWAVE.") | |
3804 | (defvar idlwave-class-history nil | |
3805 | "The history of classes selected with the minibuffer.") | |
3806 | (defvar idlwave-force-class-query nil) | |
3807 | (defvar idlwave-before-completion-wconf nil | |
3808 | "The window configuration just before the completion buffer was displayed.") | |
15e42531 CD |
3809 | (defvar idlwave-last-system-routine-info-cons-cell nil |
3810 | "The last cons cell in the system routine info.") | |
f32b3b91 CD |
3811 | |
3812 | ;; | |
3813 | ;; The code to get routine info from different sources. | |
3814 | ||
15e42531 | 3815 | (defvar idlwave-system-routines) |
f32b3b91 CD |
3816 | (defun idlwave-routines () |
3817 | "Provide a list of IDL routines. | |
3818 | This routine loads the builtin routines on the first call. Later it | |
3819 | only returns the value of the variable." | |
3820 | (or idlwave-routines | |
3821 | (progn | |
3822 | (idlwave-update-routine-info) | |
3823 | ;; return the current value | |
3824 | idlwave-routines))) | |
3825 | ||
3826 | (defun idlwave-update-routine-info (&optional arg) | |
3827 | "Update the internal routine-info lists. | |
3828 | These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info]) | |
3829 | and by `idlwave-complete' (\\[idlwave-complete]) to provide information | |
3830 | about individual routines. | |
3831 | ||
3832 | The information can come from 4 sources: | |
3833 | 1. IDL programs in the current editing session | |
3834 | 2. Compiled modules in an IDL shell running as Emacs subprocess | |
3835 | 3. A list which covers the IDL system routines. | |
3836 | 4. A list which covers the prescanned library files. | |
3837 | ||
3838 | Scans all IDLWAVE-mode buffers of the current editing session (see | |
3839 | `idlwave-scan-all-buffers-for-routine-info'). | |
3840 | When an IDL shell is running, this command also queries the IDL program | |
3841 | for currently compiled routines. | |
3842 | ||
3843 | With prefix ARG, also reload the system and library lists. | |
3844 | With two prefix ARG's, also rescans the library tree." | |
3845 | (interactive "P") | |
3846 | (if (equal arg '(16)) | |
3847 | (idlwave-create-libinfo-file t) | |
3848 | (let* ((reload (or arg | |
3849 | idlwave-buffer-case-takes-precedence | |
15e42531 | 3850 | (null idlwave-system-routines)))) |
f32b3b91 CD |
3851 | |
3852 | (setq idlwave-buffer-routines nil | |
15e42531 CD |
3853 | idlwave-compiled-routines nil |
3854 | idlwave-unresolved-routines nil) | |
f32b3b91 CD |
3855 | ;; Reset the appropriate hashes |
3856 | (idlwave-reset-sintern (cond (reload t) | |
15e42531 | 3857 | ((null idlwave-system-routines) t) |
f32b3b91 CD |
3858 | (t 'bufsh))) |
3859 | ||
3860 | (if idlwave-buffer-case-takes-precedence | |
3861 | ;; We can safely scan the buffer stuff first | |
3862 | (progn | |
3863 | (idlwave-update-buffer-routine-info) | |
3864 | (and reload (idlwave-load-system-rinfo))) | |
3865 | ;; We first do the system info, and then the buffers | |
3866 | (and reload (idlwave-load-system-rinfo)) | |
3867 | (idlwave-update-buffer-routine-info)) | |
3868 | ||
3869 | ;; Let's see if there is a shell | |
3870 | (let* ((shell-is-running (and (fboundp 'idlwave-shell-is-running) | |
3871 | (idlwave-shell-is-running))) | |
3872 | (ask-shell (and shell-is-running | |
3873 | idlwave-query-shell-for-routine-info))) | |
3874 | ||
3875 | (if (or (not ask-shell) | |
3876 | (not (interactive-p))) | |
3877 | ;; 1. If we are not going to ask the shell, we need to do the | |
3878 | ;; concatenation now. | |
3879 | ;; 2. When this function is called non-interactively, it means | |
3880 | ;; that someone needs routine info *now*. The shell update | |
3881 | ;; causes the concatenation *delayed*, so not in time for | |
3882 | ;; the current command. Therefore, we do a concatenation | |
3883 | ;; now, even though the shell might do it again. | |
3884 | (idlwave-concatenate-rinfo-lists)) | |
3885 | ||
3886 | (when ask-shell | |
3887 | ;; Ask the shell about the routines it knows. | |
3888 | (message "Querying the shell") | |
3889 | (idlwave-shell-update-routine-info)))))) | |
3890 | ||
3891 | (defun idlwave-load-system-rinfo () | |
3892 | ;; Load and case-treat the system and lib info files. | |
22d5821d | 3893 | (load "idlw-rinfo" t) |
15e42531 CD |
3894 | (message "Normalizing idlwave-system-routines...") |
3895 | (setq idlwave-system-routines | |
3896 | (idlwave-sintern-rinfo-list idlwave-system-routines 'sys)) | |
3897 | (message "Normalizing idlwave-system-routines...done") | |
3898 | (setq idlwave-routines (copy-sequence idlwave-system-routines)) | |
3899 | (setq idlwave-last-system-routine-info-cons-cell | |
3900 | (nthcdr (1- (length idlwave-routines)) idlwave-routines)) | |
f32b3b91 CD |
3901 | (when (and (stringp idlwave-libinfo-file) |
3902 | (file-regular-p idlwave-libinfo-file)) | |
3903 | (condition-case nil | |
3904 | (progn | |
3905 | (load-file idlwave-libinfo-file) | |
15e42531 | 3906 | (setq idlwave-true-path-alist nil) |
f32b3b91 CD |
3907 | (message "Normalizing idlwave-library-routines...") |
3908 | (setq idlwave-library-routines (idlwave-sintern-rinfo-list | |
3909 | idlwave-library-routines 'sys)) | |
3910 | (message "Normalizing idlwave-library-routines...done")) | |
3911 | (error nil)))) | |
3912 | ||
3913 | (defun idlwave-update-buffer-routine-info () | |
3914 | (let (res) | |
15e42531 CD |
3915 | (cond |
3916 | ((eq idlwave-scan-all-buffers-for-routine-info t) | |
3917 | ;; Scan all buffers, current buffer last | |
3918 | (message "Scanning all buffers...") | |
3919 | (setq res (idlwave-get-routine-info-from-buffers | |
3920 | (reverse (buffer-list))))) | |
3921 | ((null idlwave-scan-all-buffers-for-routine-info) | |
3922 | ;; Don't scan any buffers | |
3923 | (setq res nil)) | |
3924 | (t | |
f32b3b91 CD |
3925 | ;; Just scan this buffer |
3926 | (if (eq major-mode 'idlwave-mode) | |
3927 | (progn | |
3928 | (message "Scanning current buffer...") | |
3929 | (setq res (idlwave-get-routine-info-from-buffers | |
15e42531 | 3930 | (list (current-buffer)))))))) |
f32b3b91 CD |
3931 | ;; Put the result into the correct variable |
3932 | (setq idlwave-buffer-routines | |
3933 | (idlwave-sintern-rinfo-list res t)))) | |
3934 | ||
15e42531 | 3935 | (defun idlwave-concatenate-rinfo-lists (&optional quiet) |
f32b3b91 CD |
3936 | "Put the different sources for routine information together." |
3937 | ;; The sequence here is important because earlier definitions shadow | |
3938 | ;; later ones. We assume that if things in the buffers are newer | |
3939 | ;; then in the shell of the system, it is meant to be different. | |
15e42531 CD |
3940 | |
3941 | (setcdr idlwave-last-system-routine-info-cons-cell | |
3942 | (append idlwave-buffer-routines | |
3943 | idlwave-compiled-routines | |
3944 | idlwave-library-routines)) | |
f32b3b91 | 3945 | (setq idlwave-class-alist nil) |
15e42531 | 3946 | |
f32b3b91 | 3947 | ;; Give a message with information about the number of routines we have. |
15e42531 CD |
3948 | (unless quiet |
3949 | (message | |
3950 | "Routine info updated: buffer(%d) compiled(%d) catalog(%d) system(%d)" | |
3951 | (length idlwave-buffer-routines) | |
3952 | (length idlwave-compiled-routines) | |
3953 | (length idlwave-library-routines) | |
3954 | (length idlwave-system-routines)))) | |
3955 | ||
3956 | (defun idlwave-class-alist () | |
3957 | "Return the class alist - make it if necessary." | |
3958 | (or idlwave-class-alist | |
3959 | (let (class) | |
3960 | (loop for x in idlwave-routines do | |
3961 | (when (and (setq class (nth 2 x)) | |
3962 | (not (assq class idlwave-class-alist))) | |
3963 | (push (list class) idlwave-class-alist))) | |
3964 | idlwave-class-alist))) | |
3965 | ||
3966 | ;; Three functions for the hooks | |
3967 | (defun idlwave-save-buffer-update () | |
3968 | (idlwave-update-current-buffer-info 'save-buffer)) | |
3969 | (defun idlwave-kill-buffer-update () | |
3970 | (idlwave-update-current-buffer-info 'kill-buffer)) | |
3971 | (defun idlwave-new-buffer-update () | |
3972 | (idlwave-update-current-buffer-info 'find-file)) | |
3973 | ||
3974 | (defun idlwave-update-current-buffer-info (why) | |
3975 | "Undate idlwave-routines for current buffer. Can run from after-save-hook." | |
3976 | (when (and (eq major-mode 'idlwave-mode) | |
3977 | (or (eq t idlwave-auto-routine-info-updates) | |
3978 | (memq why idlwave-auto-routine-info-updates)) | |
3979 | idlwave-scan-all-buffers-for-routine-info | |
3980 | idlwave-routines) | |
3981 | (condition-case nil | |
3982 | (let (routines) | |
3983 | (idlwave-replace-buffer-routine-info | |
3984 | (buffer-file-name) | |
3985 | (if (eq why 'kill-buffer) | |
3986 | nil | |
3987 | (setq routines | |
3988 | (idlwave-sintern-rinfo-list | |
3989 | (idlwave-get-routine-info-from-buffers | |
3990 | (list (current-buffer))) 'set)))) | |
3991 | (idlwave-concatenate-rinfo-lists 'quiet) | |
3992 | routines) | |
3993 | (error nil)))) | |
3994 | ||
3995 | (defun idlwave-replace-buffer-routine-info (file new) | |
3996 | "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." | |
3997 | (let ((list idlwave-buffer-routines) | |
3998 | found) | |
3999 | (while list | |
4000 | ;; The following test uses eq to make sure it works correctly | |
4001 | ;; when two buffers visit the same file. Then the file names | |
4002 | ;; will be equal, but not eq. | |
4003 | (if (eq (cdr (nth 3 (car list))) file) | |
4004 | (progn | |
4005 | (setcar list nil) | |
4006 | (setq found t)) | |
4007 | (if found | |
4008 | ;; End of that section reached. Jump. | |
4009 | (setq list nil))) | |
4010 | (setq list (cdr list))) | |
4011 | (setq idlwave-buffer-routines | |
4012 | (append new (delq nil idlwave-buffer-routines))))) | |
f32b3b91 CD |
4013 | |
4014 | ;;----- Scanning buffers ------------------- | |
4015 | ||
4016 | (defun idlwave-get-routine-info-from-buffers (buffers) | |
4017 | "Call `idlwave-get-buffer-routine-info' on idlwave-mode buffers in BUFFERS." | |
4018 | (let (buf routine-lists res) | |
4019 | (save-excursion | |
4020 | (while (setq buf (pop buffers)) | |
4021 | (set-buffer buf) | |
4022 | (if (eq major-mode 'idlwave-mode) | |
4023 | ;; yes, this buffer has the right mode. | |
4024 | (progn (setq res (condition-case nil | |
4025 | (idlwave-get-buffer-routine-info) | |
4026 | (error nil))) | |
4027 | (push res routine-lists))))) | |
4028 | ;; Concatenate the individual lists and return the result | |
4029 | (apply 'nconc routine-lists))) | |
4030 | ||
4031 | (defun idlwave-get-buffer-routine-info () | |
4032 | "Scan the current buffer for routine info. Return (PRO-LIST FUNC-LIST)." | |
4033 | (let* ((case-fold-search t) | |
4034 | routine-list string entry) | |
4035 | (save-excursion | |
4036 | (save-restriction | |
4037 | (widen) | |
4038 | (goto-char (point-min)) | |
4039 | (while (re-search-forward | |
15e42531 | 4040 | "^[ \t]*\\(pro\\|function\\)[ \t]" nil t) |
f32b3b91 CD |
4041 | (setq string (buffer-substring |
4042 | (match-beginning 0) | |
4043 | (progn | |
4044 | (idlwave-end-of-statement) | |
4045 | (point)))) | |
4046 | (setq entry (idlwave-parse-definition string)) | |
4047 | (push entry routine-list)))) | |
4048 | routine-list)) | |
4049 | ||
15e42531 | 4050 | (defvar idlwave-scanning-lib-dir) |
f32b3b91 CD |
4051 | (defun idlwave-parse-definition (string) |
4052 | "Parse a module definition." | |
4053 | (let ((case-fold-search t) | |
4054 | start name args type keywords class) | |
4055 | ;; Remove comments | |
4056 | (while (string-match ";.*" string) | |
4057 | (setq string (replace-match "" t t string))) | |
4058 | ;; Remove the continuation line stuff | |
4059 | (while (string-match "\\([^a-zA-Z0-9$_]\\)\\$[ \t]*\n" string) | |
4060 | (setq string (replace-match "\\1 " t nil string))) | |
4061 | ;; Match the name and type. | |
4062 | (when (string-match | |
4063 | "\\<\\(pro\\|function\\)\\>\\s-+\\(\\([a-zA-Z0-9$_]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)" string) | |
4064 | (setq start (match-end 0)) | |
4065 | (setq type (downcase (match-string 1 string))) | |
4066 | (if (match-beginning 3) | |
4067 | (setq class (match-string 3 string))) | |
4068 | (setq name (match-string 4 string))) | |
4069 | ;; Match normal args and keyword args | |
4070 | (while (string-match | |
15e42531 | 4071 | ",\\s-*\\([a-zA-Z][a-zA-Z0-9$_]*\\|\\(_ref\\)?_extra\\)\\s-*\\(=\\)?" |
f32b3b91 CD |
4072 | string start) |
4073 | (setq start (match-end 0)) | |
15e42531 | 4074 | (if (match-beginning 3) |
f32b3b91 CD |
4075 | (push (match-string 1 string) keywords) |
4076 | (push (match-string 1 string) args))) | |
4077 | ;; Normalize and sort. | |
4078 | (setq args (nreverse args)) | |
4079 | (setq keywords (sort keywords (lambda (a b) | |
4080 | (string< (downcase a) (downcase b))))) | |
4081 | ;; Make and return the entry | |
4082 | ;; We don't know which argument are optional, so this information | |
4083 | ;; will not be contained in the calling sequence. | |
4084 | (list name | |
4085 | (if (equal type "pro") 'pro 'fun) | |
4086 | class | |
4087 | (cond ((not (boundp 'idlwave-scanning-lib)) | |
4088 | (cons 'buffer (buffer-file-name))) | |
15e42531 CD |
4089 | ; ((string= (downcase |
4090 | ; (file-name-sans-extension | |
4091 | ; (file-name-nondirectory (buffer-file-name)))) | |
4092 | ; (downcase name)) | |
4093 | ; (list 'lib)) | |
4094 | ; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) | |
4095 | (t (cons 'lib (concat idlwave-scanning-lib-dir | |
4096 | (file-name-nondirectory (buffer-file-name)))))) | |
f32b3b91 CD |
4097 | (concat |
4098 | (if (string= type "function") "Result = " "") | |
4099 | (if class "Obj ->[%s::]" "") | |
4100 | "%s" | |
4101 | (if args | |
4102 | (concat | |
4103 | (if (string= type "function") "(" ", ") | |
4104 | (mapconcat 'identity args ", ") | |
4105 | (if (string= type "function") ")" "")))) | |
4106 | (if keywords | |
4107 | (mapcar 'list keywords) | |
4108 | nil)))) | |
4109 | ||
4110 | ;;----- Scanning the library ------------------- | |
4111 | ||
15e42531 CD |
4112 | (defvar idlwave-sys-dir nil |
4113 | "Internal variable.") | |
4114 | ||
4115 | (defun idlwave-sys-dir () | |
4116 | "Return the syslib directory, or a dummy that never matches." | |
4117 | (or idlwave-sys-dir | |
4118 | "@@@@@@@@")) | |
4119 | ||
4120 | (defvar idlwave-shell-path-query) | |
f32b3b91 CD |
4121 | (defun idlwave-create-libinfo-file (&optional arg) |
4122 | "Scan all files on selected dirs of IDL search path for routine information. | |
4123 | A widget checklist will allow you to choose the directories. | |
4124 | Write the result as a file `idlwave-libinfo-file'. When this file exists, | |
4125 | will be automatically loaded to give routine information about library | |
4126 | routines. | |
4127 | With ARG, just rescan the same directories as last time - so no widget | |
4128 | will pop up." | |
4129 | (interactive "P") | |
4130 | ;; Make sure the file is loaded if it exists. | |
4131 | (if (and (stringp idlwave-libinfo-file) | |
4132 | (file-regular-p idlwave-libinfo-file)) | |
4133 | (condition-case nil | |
4134 | (load-file idlwave-libinfo-file) | |
4135 | (error nil))) | |
4136 | ;; Make sure the file name makes sense | |
4137 | (unless (and (stringp idlwave-libinfo-file) | |
15e42531 | 4138 | (> (length idlwave-libinfo-file) 0) |
f32b3b91 CD |
4139 | (file-accessible-directory-p |
4140 | (file-name-directory idlwave-libinfo-file)) | |
4141 | (not (string= "" (file-name-nondirectory | |
4142 | idlwave-libinfo-file)))) | |
4143 | (error "`idlwave-libinfo-file' does not point to file in accessible directory.")) | |
4144 | ||
4145 | (cond | |
15e42531 CD |
4146 | ((and arg idlwave-path-alist |
4147 | (consp (car idlwave-path-alist)) | |
4148 | idlwave-sys-dir) | |
f32b3b91 | 4149 | ;; Rescan the known directories |
15e42531 CD |
4150 | (idlwave-scan-lib-files |
4151 | idlwave-sys-dir | |
4152 | idlwave-path-alist)) | |
f32b3b91 CD |
4153 | (idlwave-library-path |
4154 | ;; Get the directories from that variable | |
4155 | (idlwave-display-libinfo-widget | |
15e42531 | 4156 | idlwave-system-directory |
f32b3b91 | 4157 | (idlwave-expand-path idlwave-library-path) |
15e42531 CD |
4158 | (delq nil (mapcar (lambda (x) (if (consp x) (if (cdr x) (car x) nil) x)) |
4159 | idlwave-path-alist)))) | |
f32b3b91 CD |
4160 | (t |
4161 | ;; Ask the shell for the path and run the widget | |
4162 | (message "Asking the shell for IDL path...") | |
15e42531 CD |
4163 | (require 'idlw-shell) |
4164 | (idlwave-shell-send-command idlwave-shell-path-query | |
4165 | '(idlwave-libinfo-command-hook nil) | |
4166 | 'hide)))) | |
f32b3b91 CD |
4167 | |
4168 | (defun idlwave-libinfo-command-hook (&optional arg) | |
4169 | ;; Command hook used by `idlwave-create-libinfo-file'. | |
4170 | (if arg | |
4171 | ;; Scan immediately | |
15e42531 CD |
4172 | (idlwave-scan-lib-files |
4173 | idlwave-sys-dir | |
4174 | idlwave-path-alist) | |
f32b3b91 | 4175 | ;; Display the widget |
15e42531 CD |
4176 | (let* ((rpl (idlwave-shell-path-filter)) |
4177 | (sysdir (car rpl)) | |
4178 | (dirs (cdr rpl))) | |
4179 | (idlwave-display-libinfo-widget | |
4180 | sysdir dirs | |
4181 | (delq nil (mapcar (lambda (x) (if (cdr x) (car x) nil)) | |
4182 | idlwave-path-alist)))))) | |
f32b3b91 CD |
4183 | |
4184 | (defconst idlwave-libinfo-widget-help-string | |
15e42531 | 4185 | "This is the front-end to the creation of IDLWAVE library catalog. |
f32b3b91 CD |
4186 | Please select below the directories on IDL's search path from which you |
4187 | would like to extract routine information, which will be stored in the file | |
4188 | ||
4189 | %s | |
4190 | ||
4191 | If this is not the correct file, first set variable `idlwave-libinfo-file'. | |
4192 | Then call this command again. | |
15e42531 CD |
4193 | |
4194 | For writing code, you need to include the directories which contain the | |
4195 | routines you use. If IDLWAVE should be able to analyse routine shadowing | |
4196 | it is best to scan all directories. | |
4197 | ||
f32b3b91 CD |
4198 | After selecting the directories, choose [Scan & Save] to scan the library |
4199 | directories and save the routine info. | |
4200 | \n") | |
4201 | ||
4202 | (defvar idlwave-widget) | |
4203 | (defvar widget-keymap) | |
15e42531 | 4204 | (defun idlwave-display-libinfo-widget (sysdir dirs selected-dirs) |
f32b3b91 CD |
4205 | "Create the widget to select IDL search path directories for scanning." |
4206 | (interactive) | |
4207 | (require 'widget) | |
4208 | (require 'wid-edit) | |
4209 | (unless dirs | |
4210 | (error "Don't know IDL's search path")) | |
4211 | ||
4212 | ;; Allow only those directories to be selected which are in the path. | |
4213 | (setq selected-dirs (delq nil (mapcar (lambda (x) | |
4214 | (if (member x dirs) x nil)) | |
4215 | selected-dirs))) | |
4216 | (kill-buffer (get-buffer-create "*IDLWAVE Widget*")) | |
4217 | (switch-to-buffer (get-buffer-create "*IDLWAVE Widget*")) | |
4218 | (kill-all-local-variables) | |
4219 | (make-local-variable 'idlwave-widget) | |
4220 | (widget-insert (format idlwave-libinfo-widget-help-string | |
4221 | idlwave-libinfo-file)) | |
4222 | ||
4223 | (widget-create 'push-button | |
4224 | :notify 'idlwave-widget-scan-lib-files | |
f32b3b91 CD |
4225 | "Scan & Save") |
4226 | (widget-insert " ") | |
4227 | (widget-create 'push-button | |
4228 | :notify (lambda (&rest ignore) | |
4229 | (kill-buffer (current-buffer))) | |
4230 | "Quit") | |
4231 | (widget-insert " ") | |
4232 | (widget-create 'push-button | |
4233 | :notify 'idlwave-delete-libinfo-file | |
4234 | "Delete File") | |
4235 | (widget-insert " ") | |
4236 | (widget-create 'push-button | |
4237 | :notify '(lambda (&rest ignore) | |
4238 | (idlwave-display-libinfo-widget | |
15e42531 | 4239 | (widget-get idlwave-widget :sysdir) |
f32b3b91 CD |
4240 | (widget-get idlwave-widget :path-dirs) |
4241 | (widget-get idlwave-widget :path-dirs))) | |
4242 | "Select All") | |
4243 | (widget-insert " ") | |
4244 | (widget-create 'push-button | |
4245 | :notify '(lambda (&rest ignore) | |
4246 | (idlwave-display-libinfo-widget | |
15e42531 | 4247 | (widget-get idlwave-widget :sysdir) |
f32b3b91 CD |
4248 | (widget-get idlwave-widget :path-dirs) |
4249 | nil)) | |
4250 | "Deselect All") | |
4251 | (widget-insert "\n\n") | |
4252 | ||
4253 | (widget-insert "Select Directories\n") | |
4254 | ||
4255 | (setq idlwave-widget | |
4256 | (apply 'widget-create | |
4257 | 'checklist | |
4258 | :value selected-dirs | |
4259 | :greedy t | |
4260 | :tag "List of directories" | |
4261 | (mapcar (lambda (x) (list 'item x)) dirs))) | |
4262 | (widget-put idlwave-widget :path-dirs dirs) | |
15e42531 | 4263 | (widget-put idlwave-widget :sysdir sysdir) |
f32b3b91 CD |
4264 | (widget-insert "\n") |
4265 | (use-local-map widget-keymap) | |
4266 | (widget-setup) | |
4267 | (goto-char (point-min)) | |
4268 | (delete-other-windows)) | |
4269 | ||
4270 | (defun idlwave-delete-libinfo-file (&rest ignore) | |
4271 | (if (yes-or-no-p | |
4272 | (format "Delete file %s " idlwave-libinfo-file)) | |
4273 | (progn | |
4274 | (delete-file idlwave-libinfo-file) | |
4275 | (message "%s has been deleted" idlwave-libinfo-file)))) | |
4276 | ||
4277 | (defun idlwave-widget-scan-lib-files (&rest ignore) | |
4278 | ;; Call `idlwave-scan-lib-files' with data taken from the widget. | |
4279 | (let* ((widget idlwave-widget) | |
15e42531 CD |
4280 | (selected-dirs (widget-value widget)) |
4281 | (sysdir (widget-get widget :sysdir)) | |
4282 | (path-dirs (widget-get widget :path-dirs)) | |
4283 | (path-dir-alist | |
4284 | (mapcar (lambda (x) (cons x (if (member x selected-dirs) t nil))) | |
4285 | path-dirs))) | |
4286 | (idlwave-scan-lib-files sysdir path-dir-alist))) | |
f32b3b91 CD |
4287 | |
4288 | (defvar font-lock-mode) | |
15e42531 CD |
4289 | (defun idlwave-scan-lib-files (sysdir path-alist) |
4290 | ;; Scan the files in PATH-ALIST and store the info in a file | |
f32b3b91 | 4291 | (let* ((idlwave-scanning-lib t) |
15e42531 CD |
4292 | (idlwave-scanning-lib-dir "") |
4293 | (dircnt (1+ (length path-alist))) | |
f32b3b91 | 4294 | (idlwave-completion-case nil) |
15e42531 | 4295 | dirs-alist dir files file) |
f32b3b91 | 4296 | (setq idlwave-library-routines nil) |
15e42531 CD |
4297 | (setq idlwave-path-alist path-alist) |
4298 | (setq idlwave-true-path-alist nil) | |
4299 | (setq idlwave-sys-dir sysdir) | |
f32b3b91 CD |
4300 | (save-excursion |
4301 | (set-buffer (get-buffer-create "*idlwave-scan.pro*")) | |
4302 | (idlwave-mode) | |
15e42531 CD |
4303 | (setq dirs-alist (reverse path-alist)) |
4304 | (while (setq dir (pop dirs-alist)) | |
4305 | (decf dircnt) | |
4306 | (when (cdr dir) | |
4307 | ;; Has the flag of scanned directories | |
4308 | (setq dir (car dir)) | |
4309 | (setq idlwave-scanning-lib-dir (format "{%d}/" dircnt)) | |
4310 | (when (file-directory-p dir) | |
4311 | (setq files (directory-files dir 'full "\\.[pP][rR][oO]\\'")) | |
4312 | (while (setq file (pop files)) | |
4313 | (when (file-regular-p file) | |
4314 | (if (not (file-readable-p file)) | |
4315 | (message "Skipping %s (no read permission)" file) | |
4316 | (message "Scanning %s..." file) | |
4317 | (erase-buffer) | |
4318 | (insert-file-contents file 'visit) | |
4319 | (setq idlwave-library-routines | |
4320 | (append (idlwave-get-routine-info-from-buffers | |
4321 | (list (current-buffer))) | |
4322 | idlwave-library-routines))) | |
4323 | )))))) | |
4324 | ;; Sorting is not necessary since we sort each time before a routine | |
4325 | ;; is used. So we don't do it here - the catalog file looks nicer | |
4326 | ;; when it is unsorted. | |
4327 | ;;(message "Sorting...") | |
4328 | ;;(setq idlwave-library-routines | |
4329 | ;;(sort idlwave-library-routines 'idlwave-routine-entry-compare)) | |
4330 | ;;(message "Sorting...done") | |
4331 | (message "Creating libinfo file...") | |
f32b3b91 CD |
4332 | (kill-buffer "*idlwave-scan.pro*") |
4333 | (kill-buffer (get-buffer-create "*IDLWAVE Widget*")) | |
15e42531 CD |
4334 | (let ((font-lock-maximum-size 0) |
4335 | (auto-mode-alist nil)) | |
f32b3b91 CD |
4336 | (find-file idlwave-libinfo-file)) |
4337 | (if (and (boundp 'font-lock-mode) | |
4338 | font-lock-mode) | |
4339 | (font-lock-mode 0)) | |
4340 | (erase-buffer) | |
4341 | (insert ";; IDLWAVE libinfo file\n") | |
4342 | (insert (format ";; Created %s\n\n" (current-time-string))) | |
4343 | ||
15e42531 CD |
4344 | ;; Define the variable which knows the value of "!DIR" |
4345 | (insert (format "\n(setq idlwave-sys-dir \"%s\")\n" | |
4346 | idlwave-sys-dir)) | |
4347 | ||
f32b3b91 | 4348 | ;; Define the variable which contains a list of all scanned directories |
15e42531 | 4349 | (insert "\n(setq idlwave-path-alist\n '(") |
f32b3b91 | 4350 | (mapcar (lambda (x) |
15e42531 CD |
4351 | (insert (format "\n (\"%s\" . %s)" (car x) (cdr x)))) |
4352 | path-alist) | |
f32b3b91 | 4353 | (insert "))\n") |
15e42531 | 4354 | |
f32b3b91 CD |
4355 | ;; Define the routine info list |
4356 | (insert "\n(setq idlwave-library-routines\n '(") | |
4357 | (mapcar (lambda (x) | |
4358 | (insert "\n ") | |
4359 | (insert (with-output-to-string (prin1 x)))) | |
4360 | idlwave-library-routines) | |
4361 | (insert (format "))\n\n;;; %s ends here\n" | |
4362 | (file-name-nondirectory idlwave-libinfo-file))) | |
4363 | (goto-char (point-min)) | |
4364 | ;; Save the buffer | |
4365 | (save-buffer 0) | |
4366 | (kill-buffer (current-buffer))) | |
15e42531 | 4367 | (message "Creating libinfo file...done") |
f32b3b91 CD |
4368 | (message "Info for %d routines saved in %s" |
4369 | (length idlwave-library-routines) | |
4370 | idlwave-libinfo-file) | |
4371 | (sit-for 2) | |
4372 | (idlwave-update-routine-info t)) | |
4373 | ||
4374 | (defun idlwave-expand-path (path &optional default-dir) | |
4375 | ;; Expand parts of path starting with '+' recursively into directory list. | |
4376 | ;; Relative recursive path elements are expanded relative to DEFAULT-DIR. | |
4377 | (message "Expanding path...") | |
4378 | (let (path1 dir recursive) | |
4379 | (while (setq dir (pop path)) | |
4380 | (if (setq recursive (string= (substring dir 0 1) "+")) | |
4381 | (setq dir (substring dir 1))) | |
4382 | (if (and recursive | |
4383 | (not (file-name-absolute-p dir))) | |
4384 | (setq dir (expand-file-name dir default-dir))) | |
4385 | (if recursive | |
4386 | ;; Expand recursively | |
4387 | (setq path1 (append (idlwave-recursive-directory-list dir) path1)) | |
4388 | ;; Keep unchanged | |
4389 | (push dir path1))) | |
4390 | (message "Expanding path...done") | |
4391 | (nreverse path1))) | |
4392 | ||
4393 | (defun idlwave-recursive-directory-list (dir) | |
4394 | ;; Return a list of all directories below DIR, including DIR itself | |
4395 | (let ((path (list dir)) path1 file files) | |
4396 | (while (setq dir (pop path)) | |
4397 | (when (file-directory-p dir) | |
4398 | (setq files (nreverse (directory-files dir t "[^.]"))) | |
4399 | (while (setq file (pop files)) | |
4400 | (if (file-directory-p file) | |
4401 | (push (file-name-as-directory file) path))) | |
4402 | (push dir path1))) | |
4403 | path1)) | |
4404 | ||
4405 | ;;----- Asking the shell ------------------- | |
4406 | ||
4407 | ;; First, here is the idl program which can be used to query IDL for | |
4408 | ;; defined routines. | |
4409 | (defconst idlwave-routine-info.pro | |
4410 | " | |
15e42531 | 4411 | pro idlwave_print_info_entry,name,func=func,separator=sep |
f32b3b91 | 4412 | ;; See if it's an object method |
15e42531 | 4413 | if name eq '' then return |
f32b3b91 CD |
4414 | func = keyword_set(func) |
4415 | methsep = strpos(name,'::') | |
4416 | meth = methsep ne -1 | |
4417 | ||
4418 | ;; Get routine info | |
4419 | pars = routine_info(name,/parameters,functions=func) | |
4420 | source = routine_info(name,/source,functions=func) | |
4421 | nargs = pars.num_args | |
4422 | nkw = pars.num_kw_args | |
4423 | if nargs gt 0 then args = pars.args | |
4424 | if nkw gt 0 then kwargs = pars.kw_args | |
4425 | ||
4426 | ;; Trim the class, and make the name | |
4427 | if meth then begin | |
4428 | class = strmid(name,0,methsep) | |
4429 | name = strmid(name,methsep+2,strlen(name)-1) | |
4430 | if nargs gt 0 then begin | |
4431 | ;; remove the self argument | |
4432 | wh = where(args ne 'SELF',nargs) | |
4433 | if nargs gt 0 then args = args(wh) | |
4434 | endif | |
4435 | endif else begin | |
4436 | ;; No class, just a normal routine. | |
4437 | class = \"\" | |
4438 | endelse | |
4439 | ||
4440 | ;; Calling sequence | |
4441 | cs = \"\" | |
4442 | if func then cs = 'Result = ' | |
4443 | if meth then cs = cs + 'Obj -> [' + '%s' + '::]' | |
4444 | cs = cs + '%s' | |
4445 | if func then cs = cs + '(' else if nargs gt 0 then cs = cs + ', ' | |
4446 | if nargs gt 0 then begin | |
4447 | for j=0,nargs-1 do begin | |
4448 | cs = cs + args(j) | |
4449 | if j lt nargs-1 then cs = cs + ', ' | |
4450 | endfor | |
4451 | end | |
4452 | if func then cs = cs + ')' | |
4453 | ;; Keyword arguments | |
4454 | kwstring = '' | |
4455 | if nkw gt 0 then begin | |
4456 | for j=0,nkw-1 do begin | |
4457 | kwstring = kwstring + ' ' + kwargs(j) | |
4458 | endfor | |
4459 | endif | |
4460 | ||
15e42531 | 4461 | ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])(func) |
f32b3b91 | 4462 | |
15e42531 | 4463 | print,ret + ': ' + name + sep + class + sep + source(0).path $ |
f32b3b91 CD |
4464 | + sep + cs + sep + kwstring |
4465 | end | |
4466 | ||
4467 | pro idlwave_routine_info | |
4468 | sep = '<@>' | |
4469 | print,'>>>BEGIN OF IDLWAVE ROUTINE INFO (\"' + sep + '\" IS THE SEPARATOR)' | |
4470 | all = routine_info() | |
4471 | for i=0,n_elements(all)-1 do $ | |
15e42531 | 4472 | idlwave_print_info_entry,all(i),separator=sep |
f32b3b91 CD |
4473 | all = routine_info(/functions) |
4474 | for i=0,n_elements(all)-1 do $ | |
15e42531 | 4475 | idlwave_print_info_entry,all(i),/func,separator=sep |
f32b3b91 CD |
4476 | print,'>>>END OF IDLWAVE ROUTINE INFO' |
4477 | end | |
4478 | " | |
4479 | "The idl program to get the routine info stuff. | |
4480 | The output of this program is parsed by `idlwave-shell-routine-info-filter'.") | |
4481 | ||
15e42531 CD |
4482 | (defvar idlwave-idlwave_routine_info-compiled nil |
4483 | "Remembers if the routine info procedure is already compiled.") | |
f32b3b91 CD |
4484 | |
4485 | (defvar idlwave-shell-temp-pro-file) | |
15e42531 CD |
4486 | (defvar idlwave-shell-temp-rinfo-save-file) |
4487 | (defun idlwave-shell-update-routine-info (&optional quiet) | |
f32b3b91 | 4488 | "Query the shell for routine_info of compiled modules and update the lists." |
15e42531 CD |
4489 | ;; Save and compile the procedure. The compiled procedure is then |
4490 | ;; saved into an IDL SAVE file, to allow for fast RESTORE. | |
4491 | ;; We need to RESTORE the procedure each time we use it, since | |
4492 | ;; the user may have killed or redefined it. In particluar, | |
4493 | ;; .RESET_SESSION will kill all user procedures. | |
4494 | (unless (and idlwave-idlwave_routine_info-compiled | |
4495 | (file-readable-p idlwave-shell-temp-rinfo-save-file)) | |
4496 | (save-excursion | |
4497 | (set-buffer (idlwave-find-file-noselect | |
4498 | idlwave-shell-temp-pro-file)) | |
4499 | (erase-buffer) | |
4500 | (insert idlwave-routine-info.pro) | |
4501 | (save-buffer 0)) | |
4502 | (idlwave-shell-send-command | |
4503 | (concat ".run " idlwave-shell-temp-pro-file) | |
4504 | nil 'hide) | |
4505 | (idlwave-shell-send-command | |
4506 | (format "save,'idlwave_routine_info','idlwave_print_info_entry',FILE='%s',/ROUTINES" | |
4507 | idlwave-shell-temp-rinfo-save-file) | |
4508 | nil 'hide)) | |
4509 | ||
4510 | ;; Restore and execute the procedure, analyze the output | |
4511 | (idlwave-shell-send-command | |
4512 | (format "RESTORE, '%s' & idlwave_routine_info" | |
4513 | idlwave-shell-temp-rinfo-save-file) | |
4514 | `(progn | |
4515 | (idlwave-shell-routine-info-filter) | |
4516 | (idlwave-concatenate-rinfo-lists ,quiet)) | |
4517 | 'hide)) | |
f32b3b91 CD |
4518 | |
4519 | ;; --------------------------------------------------------------------------- | |
4520 | ;; | |
4521 | ;; Completion and displaying routine calling sequences | |
4522 | ||
15e42531 CD |
4523 | (defvar idlwave-completion-help-info nil) |
4524 | (defvar idlwave-current-obj_new-class nil) | |
4525 | ||
f32b3b91 CD |
4526 | (defun idlwave-complete (&optional arg module class) |
4527 | "Complete a function, procedure or keyword name at point. | |
4528 | This function is smart and figures out what can be legally completed | |
4529 | at this point. | |
4530 | - At the beginning of a statement it completes procedure names. | |
4531 | - In the middle of a statement it completes function names. | |
4532 | - after a `(' or `,' in the argument list of a function or procedure, | |
4533 | it completes a keyword of the relevant function or procedure. | |
4534 | - In the first arg of `OBJ_NEW', it completes a class name. | |
4535 | ||
4536 | When several completions are possible, a list will be displayed in the | |
4537 | *Completions* buffer. If this list is too long to fit into the | |
4538 | window, scrolling can be achieved by repeatedly pressing \\[idlwave-complete]. | |
4539 | ||
4540 | The function also knows about object methods. When it needs a class | |
4541 | name, the action depends upon `idlwave-query-class', which see. You | |
4542 | can force IDLWAVE to ask you for a class name with a \\[universal-argument] prefix | |
4543 | argument to this command. | |
4544 | ||
4545 | See also the variables `idlwave-keyword-completion-adds-equal' and | |
4546 | `idlwave-function-completion-adds-paren'. | |
4547 | ||
4548 | The optional ARG can be used to specify the completion type in order | |
4549 | to override IDLWAVE's idea of what should be completed at point. | |
4550 | Possible values are: | |
4551 | ||
4552 | 0 <=> query for the completion type | |
4553 | 1 <=> 'procedure | |
4554 | 2 <=> 'procedure-keyword | |
4555 | 3 <=> 'function | |
4556 | 4 <=> 'function-keyword | |
4557 | 5 <=> 'procedure-method | |
4558 | 6 <=> 'procedure-method-keyword | |
4559 | 7 <=> 'function-method | |
4560 | 8 <=> 'function-method-keyword | |
4561 | 9 <=> 'class | |
4562 | ||
4563 | For Lisp programmers only: | |
4564 | When we force a keyword, optional argument MODULE can contain the module name. | |
4565 | When we force a method or a method keyword, CLASS can specify the class." | |
4566 | (interactive "P") | |
4567 | (idlwave-routines) | |
4568 | (let* ((where-list | |
4569 | (if (and arg | |
4570 | (or (integerp arg) | |
4571 | (symbolp arg))) | |
4572 | (idlwave-make-force-complete-where-list arg module class) | |
4573 | (idlwave-where))) | |
4574 | (what (nth 2 where-list)) | |
595ab50b | 4575 | (idlwave-force-class-query (equal arg '(4)))) |
f32b3b91 CD |
4576 | |
4577 | (if (and module (string-match "::" module)) | |
4578 | (setq class (substring module 0 (match-beginning 0)) | |
4579 | module (substring module (match-end 0)))) | |
4580 | ||
4581 | (cond | |
4582 | ||
4583 | ((and (null arg) | |
4584 | (eq (car-safe last-command) 'idlwave-display-completion-list) | |
595ab50b | 4585 | (get-buffer-window "*Completions*")) |
f32b3b91 CD |
4586 | (setq this-command last-command) |
4587 | (idlwave-scroll-completions)) | |
4588 | ||
4589 | ((null what) | |
4590 | (error "Nothing to complete here")) | |
4591 | ||
4592 | ((eq what 'class) | |
15e42531 | 4593 | (setq idlwave-completion-help-info '(class)) |
f32b3b91 CD |
4594 | (idlwave-complete-class)) |
4595 | ||
4596 | ((eq what 'procedure) | |
4597 | ;; Complete a procedure name | |
4598 | (let* ((class-selector (idlwave-determine-class (nth 3 where-list) 'pro)) | |
4599 | (isa (concat "procedure" (if class-selector "-method" ""))) | |
4600 | (type-selector 'pro)) | |
15e42531 CD |
4601 | (setq idlwave-completion-help-info |
4602 | (list 'routine nil type-selector class-selector)) | |
f32b3b91 CD |
4603 | (idlwave-complete-in-buffer |
4604 | 'procedure (if class-selector 'method 'routine) | |
4605 | (idlwave-routines) 'idlwave-selector | |
4606 | (format "Select a %s name%s" | |
4607 | isa | |
4608 | (if class-selector | |
4609 | (format " (class is %s)" class-selector) | |
4610 | "")) | |
4611 | isa | |
4612 | 'idlwave-attach-method-classes))) | |
4613 | ||
4614 | ((eq what 'function) | |
4615 | ;; Complete a function name | |
4616 | (let* ((class-selector (idlwave-determine-class (nth 3 where-list) 'fun)) | |
4617 | (isa (concat "function" (if class-selector "-method" ""))) | |
4618 | (type-selector 'fun)) | |
15e42531 CD |
4619 | (setq idlwave-completion-help-info |
4620 | (list 'routine nil type-selector class-selector)) | |
f32b3b91 CD |
4621 | (idlwave-complete-in-buffer |
4622 | 'function (if class-selector 'method 'routine) | |
4623 | (idlwave-routines) 'idlwave-selector | |
4624 | (format "Select a %s name%s" | |
4625 | isa | |
4626 | (if class-selector | |
4627 | (format " (class is %s)" class-selector) | |
4628 | "")) | |
4629 | isa | |
4630 | 'idlwave-attach-method-classes))) | |
4631 | ||
4632 | ((eq what 'procedure-keyword) | |
4633 | ;; Complete a procedure keyword | |
4634 | (let* ((where (nth 3 where-list)) | |
4635 | (name (car where)) | |
4636 | (method-selector name) | |
4637 | (type-selector 'pro) | |
4638 | (class (idlwave-determine-class where 'pro)) | |
4639 | (class-selector class) | |
4640 | (isa (format "procedure%s-keyword" (if class "-method" ""))) | |
15e42531 | 4641 | (entry (idlwave-best-rinfo-assq |
f32b3b91 CD |
4642 | name 'pro class (idlwave-routines))) |
4643 | (list (nth 5 entry))) | |
4644 | (unless (or entry (eq class t)) | |
4645 | (error "Nothing known about procedure %s" | |
4646 | (idlwave-make-full-name class name))) | |
4647 | (setq list (idlwave-fix-keywords name 'pro class list)) | |
4648 | (unless list (error (format "No keywords available for procedure %s" | |
4649 | (idlwave-make-full-name class name)))) | |
15e42531 CD |
4650 | (setq idlwave-completion-help-info |
4651 | (list 'keyword name type-selector class-selector)) | |
f32b3b91 CD |
4652 | (idlwave-complete-in-buffer |
4653 | 'keyword 'keyword list nil | |
4654 | (format "Select keyword for procedure %s%s" | |
4655 | (idlwave-make-full-name class name) | |
15e42531 CD |
4656 | (if (or (member '("_EXTRA") list) |
4657 | (member '("_REF_EXTRA") list)) | |
4658 | " (note _EXTRA)" "")) | |
f32b3b91 CD |
4659 | isa |
4660 | 'idlwave-attach-keyword-classes))) | |
4661 | ||
4662 | ((eq what 'function-keyword) | |
4663 | ;; Complete a function keyword | |
4664 | (let* ((where (nth 3 where-list)) | |
4665 | (name (car where)) | |
4666 | (method-selector name) | |
4667 | (type-selector 'fun) | |
4668 | (class (idlwave-determine-class where 'fun)) | |
4669 | (class-selector class) | |
4670 | (isa (format "function%s-keyword" (if class "-method" ""))) | |
15e42531 | 4671 | (entry (idlwave-best-rinfo-assq |
f32b3b91 | 4672 | name 'fun class (idlwave-routines))) |
15e42531 CD |
4673 | (list (nth 5 entry)) |
4674 | msg-name) | |
f32b3b91 CD |
4675 | (unless (or entry (eq class t)) |
4676 | (error "Nothing known about function %s" | |
4677 | (idlwave-make-full-name class name))) | |
4678 | (setq list (idlwave-fix-keywords name 'fun class list)) | |
15e42531 CD |
4679 | ;; OBJ_NEW: Messages mention the proper Init method |
4680 | (setq msg-name (if (and (null class) | |
4681 | (string= (upcase name) "OBJ_NEW")) | |
4682 | (concat idlwave-current-obj_new-class | |
4683 | "::Init (via OBJ_NEW)") | |
4684 | (idlwave-make-full-name class name))) | |
f32b3b91 | 4685 | (unless list (error (format "No keywords available for function %s" |
15e42531 CD |
4686 | msg-name))) |
4687 | (setq idlwave-completion-help-info | |
4688 | (list 'keyword name type-selector class-selector)) | |
f32b3b91 CD |
4689 | (idlwave-complete-in-buffer |
4690 | 'keyword 'keyword list nil | |
15e42531 CD |
4691 | (format "Select keyword for function %s%s" msg-name |
4692 | (if (or (member '("_EXTRA") list) | |
4693 | (member '("_REF_EXTRA") list)) | |
4694 | " (note _EXTRA)" "")) | |
f32b3b91 CD |
4695 | isa |
4696 | 'idlwave-attach-keyword-classes))) | |
15e42531 | 4697 | |
f32b3b91 CD |
4698 | (t (error "This should not happen (idlwave-complete)"))))) |
4699 | ||
4700 | (defun idlwave-make-force-complete-where-list (what &optional module class) | |
4701 | ;; Return an artificial WHERE specification to force the completion | |
4702 | ;; routine to complete a specific item independent of context. | |
4703 | ;; WHAT is the prefix arg of `idlwave-complete', see there for details. | |
4704 | ;; MODULE and CLASS can be used to specify the routine name and class. | |
4705 | ;; The class name will also be found in MODULE if that is like "class::mod". | |
4706 | (let* ((what-list '(("procedure") ("procedure-keyword") | |
4707 | ("function") ("function-keyword") | |
4708 | ("procedure-method") ("procedure-method-keyword") | |
4709 | ("function-method") ("function-method-keyword") | |
4710 | ("class"))) | |
4711 | (module (idlwave-sintern-routine-or-method module class)) | |
4712 | (class (idlwave-sintern-class class)) | |
4713 | (what (cond | |
4714 | ((equal what 0) | |
4715 | (setq what | |
4716 | (intern (completing-read | |
4717 | "Complete what? " what-list nil t)))) | |
4718 | ((integerp what) | |
4719 | (setq what (intern (car (nth (1- what) what-list))))) | |
4720 | ((and what | |
4721 | (symbolp what) | |
4722 | (assoc (symbol-name what) what-list)) | |
4723 | what) | |
4724 | (t (error "Illegal WHAT")))) | |
4725 | (nil-list '(nil nil nil nil)) | |
4726 | (class-list (list nil nil (or class t) nil))) | |
4727 | ||
4728 | (cond | |
4729 | ||
4730 | ((eq what 'procedure) | |
4731 | (list nil-list nil-list 'procedure nil-list nil)) | |
4732 | ||
4733 | ((eq what 'procedure-keyword) | |
4734 | (let* ((class-selector nil) | |
4735 | (type-selector 'pro) | |
4736 | (pro (or module | |
4737 | (idlwave-completing-read | |
4738 | "Procedure: " (idlwave-routines) 'idlwave-selector)))) | |
4739 | (setq pro (idlwave-sintern-routine pro)) | |
4740 | (list nil-list nil-list 'procedure-keyword | |
4741 | (list pro nil nil nil) nil))) | |
4742 | ||
4743 | ((eq what 'function) | |
4744 | (list nil-list nil-list 'function nil-list nil)) | |
4745 | ||
4746 | ((eq what 'function-keyword) | |
4747 | (let* ((class-selector nil) | |
4748 | (type-selector 'fun) | |
4749 | (func (or module | |
4750 | (idlwave-completing-read | |
4751 | "Function: " (idlwave-routines) 'idlwave-selector)))) | |
4752 | (setq func (idlwave-sintern-routine func)) | |
4753 | (list nil-list nil-list 'function-keyword | |
4754 | (list func nil nil nil) nil))) | |
4755 | ||
4756 | ((eq what 'procedure-method) | |
4757 | (list nil-list nil-list 'procedure class-list nil)) | |
4758 | ||
4759 | ((eq what 'procedure-method-keyword) | |
4760 | (let* ((class (idlwave-determine-class class-list 'pro)) | |
4761 | (class-selector class) | |
4762 | (type-selector 'pro) | |
4763 | (pro (or module | |
4764 | (idlwave-completing-read | |
4765 | (format "Procedure in %s class: " class-selector) | |
4766 | (idlwave-routines) 'idlwave-selector)))) | |
4767 | (setq pro (idlwave-sintern-method pro)) | |
4768 | (list nil-list nil-list 'procedure-keyword | |
4769 | (list pro nil class nil) nil))) | |
4770 | ||
4771 | ((eq what 'function-method) | |
4772 | (list nil-list nil-list 'function class-list nil)) | |
4773 | ||
4774 | ((eq what 'function-method-keyword) | |
4775 | (let* ((class (idlwave-determine-class class-list 'fun)) | |
4776 | (class-selector class) | |
4777 | (type-selector 'fun) | |
4778 | (func (or module | |
4779 | (idlwave-completing-read | |
4780 | (format "Function in %s class: " class-selector) | |
4781 | (idlwave-routines) 'idlwave-selector)))) | |
4782 | (setq func (idlwave-sintern-method func)) | |
4783 | (list nil-list nil-list 'function-keyword | |
4784 | (list func nil class nil) nil))) | |
4785 | ||
4786 | ((eq what 'class) | |
4787 | (list nil-list nil-list 'class nil-list nil)) | |
4788 | ||
4789 | (t (error "Illegal value for WHAT"))))) | |
4790 | ||
4791 | (defun idlwave-completing-read (&rest args) | |
4792 | ;; Completing read, case insensitive | |
4793 | (let ((old-value (default-value 'completion-ignore-case))) | |
4794 | (unwind-protect | |
4795 | (progn | |
4796 | (setq-default completion-ignore-case t) | |
4797 | (apply 'completing-read args)) | |
4798 | (setq-default completion-ignore-case old-value)))) | |
4799 | ||
4800 | (defun idlwave-make-full-name (class name) | |
4801 | ;; Make a fully qualified module name including the class name | |
4802 | (concat (if class (format "%s::" class) "") name)) | |
4803 | ||
15e42531 CD |
4804 | (defun idlwave-rinfo-assoc (name type class list) |
4805 | "Like `idlwave-rinfo-assq', but sintern strings first." | |
4806 | (idlwave-rinfo-assq | |
4807 | (idlwave-sintern-routine-or-method name class) | |
4808 | type (idlwave-sintern-class class) list)) | |
4809 | ||
f32b3b91 CD |
4810 | (defun idlwave-rinfo-assq (name type class list) |
4811 | ;; Works like assq, but also checks type and class | |
4812 | (catch 'exit | |
4813 | (let (match) | |
4814 | (while (setq match (assq name list)) | |
4815 | (and (or (eq type t) | |
4816 | (eq (nth 1 match) type)) | |
4817 | (eq (nth 2 match) class) | |
4818 | (throw 'exit match)) | |
4819 | (setq list (cdr (memq match list))))))) | |
4820 | ||
15e42531 CD |
4821 | (defun idlwave-best-rinfo-assq (name type class list) |
4822 | "Like `idlwave-rinfo-assq', but get all twins and sort, then return first." | |
4823 | (let ((twins (idlwave-routine-twins | |
4824 | (idlwave-rinfo-assq name type class list) | |
4825 | list)) | |
4826 | syslibp) | |
4827 | (when (> (length twins) 1) | |
4828 | (setq twins (sort twins 'idlwave-routine-entry-compare-twins)) | |
4829 | (if (and (eq 'system (car (nth 3 (car twins)))) | |
4830 | (setq syslibp (idlwave-any-syslib (cdr twins))) | |
4831 | (not (equal 1 syslibp))) | |
4832 | ;; Its a syslib, so we need to remove the system entry | |
4833 | (setq twins (cdr twins)))) | |
4834 | (car twins))) | |
4835 | ||
4836 | (defun idlwave-best-rinfo-assoc (name type class list) | |
4837 | "Like `idlwave-best-rinfo-assq', but sintern strings first." | |
4838 | (idlwave-best-rinfo-assq | |
4839 | (idlwave-sintern-routine-or-method name class) | |
4840 | type (idlwave-sintern-class class) list)) | |
4841 | ||
4842 | (defun idlwave-any-syslib (entries) | |
4843 | "Does the entry list ENTRIES contain a syslib entry? | |
4844 | If yes, return the index (>=1)." | |
4845 | (let (file (cnt 0)) | |
4846 | (catch 'exit | |
4847 | (while entries | |
4848 | (incf cnt) | |
4849 | (setq file (cdr (nth 3 (car entries)))) | |
4850 | (if (and file | |
4851 | (idlwave-syslib-p | |
4852 | (idlwave-expand-lib-file-name file))) | |
4853 | (throw 'exit cnt) | |
4854 | (setq entries (cdr entries)))) | |
4855 | nil))) | |
4856 | ||
f32b3b91 CD |
4857 | (defun idlwave-all-assq (key list) |
4858 | "Return a list of all associations of Key in LIST." | |
4859 | (let (rtn elt) | |
4860 | (while (setq elt (assq key list)) | |
4861 | (push elt rtn) | |
4862 | (setq list (cdr (memq elt list)))) | |
4863 | (nreverse rtn))) | |
4864 | ||
4865 | (defun idlwave-all-method-classes (method &optional type) | |
4866 | "Return all classes which have a method METHOD. TYPE is 'fun or 'pro. | |
4867 | When TYPE is not specified, both procedures and functions will be considered." | |
4868 | (if (null method) | |
15e42531 | 4869 | (mapcar 'car (idlwave-class-alist)) |
f32b3b91 CD |
4870 | (let (rtn) |
4871 | (mapcar (lambda (x) | |
4872 | (and (nth 2 x) | |
4873 | (or (not type) | |
4874 | (eq type (nth 1 x))) | |
4875 | (push (nth 2 x) rtn))) | |
4876 | (idlwave-all-assq method (idlwave-routines))) | |
4877 | (idlwave-uniquify rtn)))) | |
4878 | ||
4879 | (defun idlwave-all-method-keyword-classes (method keyword &optional type) | |
4880 | "Return all classes which have a method METHOD with keyword KEYWORD. | |
4881 | TYPE is 'fun or 'pro. | |
4882 | When TYPE is not specified, both procedures and functions will be considered." | |
4883 | (if (or (null method) | |
4884 | (null keyword)) | |
4885 | nil | |
4886 | (let (rtn) | |
4887 | (mapcar (lambda (x) | |
4888 | (and (nth 2 x) | |
4889 | (or (not type) | |
4890 | (eq type (nth 1 x))) | |
4891 | (assoc keyword (nth 5 x)) | |
4892 | (push (nth 2 x) rtn))) | |
4893 | (idlwave-all-assq method (idlwave-routines))) | |
4894 | (idlwave-uniquify rtn)))) | |
4895 | ||
4896 | (defun idlwave-determine-class (info type) | |
4897 | ;; Determine the class of a routine call. INFO is the structure returned | |
4898 | ;; `idlwave-what-function' or `idlwave-what-procedure'. | |
4899 | ;; The third element in this structure is the class. When nil, we return nil. | |
15e42531 CD |
4900 | ;; When t, try to get the class from text properties at the arrow. When |
4901 | ;; the object is "self", we use the class of the current routine. | |
f32b3b91 CD |
4902 | ;; otherwise prompt the user for a class name. Also stores the selected |
4903 | ;; class as a text property at the arrow. | |
4904 | ;; TYPE is 'fun or 'pro. | |
4905 | (let* ((class (nth 2 info)) | |
4906 | (apos (nth 3 info)) | |
4907 | (nassoc (assoc (if (stringp (car info)) | |
4908 | (upcase (car info)) | |
4909 | (car info)) | |
4910 | idlwave-query-class)) | |
4911 | (dassoc (assq (if (car info) 'keyword-default 'method-default) | |
4912 | idlwave-query-class)) | |
4913 | (query (cond (nassoc (cdr nassoc)) | |
4914 | (dassoc (cdr dassoc)) | |
4915 | (t t))) | |
4916 | (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) | |
15e42531 CD |
4917 | (is-self |
4918 | (and arrow | |
4919 | (save-excursion (goto-char apos) | |
4920 | (forward-word -1) | |
4921 | (let ((case-fold-search t)) | |
4922 | (looking-at "self\\>"))))) | |
f32b3b91 CD |
4923 | (force-query idlwave-force-class-query) |
4924 | store class-alist) | |
4925 | (cond | |
4926 | ((null class) nil) | |
4927 | ((eq t class) | |
4928 | ;; There is an object which would like to know its class | |
4929 | (if (and arrow (get-text-property apos 'idlwave-class) | |
4930 | idlwave-store-inquired-class | |
4931 | (not force-query)) | |
4932 | (setq class (get-text-property apos 'idlwave-class) | |
4933 | class (idlwave-sintern-class class))) | |
15e42531 CD |
4934 | (when (and (eq t class) |
4935 | is-self) | |
4936 | (setq class (or (nth 2 (idlwave-current-routine)) class))) | |
f32b3b91 CD |
4937 | (when (and (eq class t) |
4938 | (or force-query query)) | |
4939 | (setq class-alist | |
4940 | (mapcar 'list (idlwave-all-method-classes (car info) type))) | |
4941 | (setq class | |
4942 | (idlwave-sintern-class | |
4943 | (cond | |
4944 | ((and (= (length class-alist) 0) (not force-query)) | |
4945 | (error "No classes available with method %s" (car info))) | |
4946 | ((and (= (length class-alist) 1) (not force-query)) | |
4947 | (car (car class-alist))) | |
4948 | (t | |
4949 | (setq store idlwave-store-inquired-class) | |
4950 | (idlwave-completing-read | |
4951 | (format "Class%s: " (if (stringp (car info)) | |
4952 | (format " for %s method %s" | |
4953 | type (car info)) | |
4954 | "")) | |
4955 | class-alist nil nil nil 'idlwave-class-history)))))) | |
4956 | (when (and class (not (eq t class))) | |
4957 | ;; We have a real class here | |
4958 | (when (and store arrow) | |
4959 | (put-text-property apos (+ apos 2) 'idlwave-class class) | |
4960 | (put-text-property apos (+ apos 2) 'face idlwave-class-arrow-face)) | |
4961 | (setf (nth 2 info) class)) | |
4962 | ;; Return the class | |
4963 | class) | |
4964 | ;; Default as fallback | |
4965 | (t class)))) | |
4966 | ||
4967 | (defvar type-selector) | |
4968 | (defvar class-selector) | |
4969 | (defvar method-selector) | |
4970 | (defun idlwave-selector (a) | |
4971 | (and (eq (nth 1 a) type-selector) | |
4972 | (or (and (nth 2 a) (eq class-selector t)) | |
4973 | (eq (nth 2 a) class-selector)))) | |
4974 | ||
4975 | (defun idlwave-where () | |
4976 | "Find out where we are. | |
4977 | The return value is a list with the following stuff: | |
4978 | (PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) | |
4979 | ||
4980 | PRO-LIST (PRO POINT CLASS ARROW) | |
4981 | FUNC-LIST (FUNC POINT CLASS ARROW) | |
4982 | COMPLETE-WHAT a symbol indicating what kind of completion makes sense here | |
4983 | CW-LIST Like PRO-LIST, for what can be copmpleted here. | |
4984 | LAST-CHAR last relevant character before point (non-white non-comment, | |
4985 | not part of current identifier or leading slash). | |
4986 | ||
4987 | In the lists, we have these meanings: | |
4988 | PRO: Procedure name | |
4989 | FUNC: Function name | |
4990 | POINT: Where is this | |
4991 | CLASS: What class has the routine (nil=no, t=is method, but class unknown) | |
4992 | ARROW: Where is the arrow?" | |
4993 | (idlwave-routines) | |
15e42531 CD |
4994 | (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) |
4995 | ;; FIXME: WAS THIS CHANGE CORRECT??? Answer: yes. | |
4996 | (bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) | |
f32b3b91 CD |
4997 | (func-entry (idlwave-what-function bos)) |
4998 | (func (car func-entry)) | |
4999 | (func-class (nth 1 func-entry)) | |
5000 | (func-arrow (nth 2 func-entry)) | |
5001 | (func-point (or (nth 3 func-entry) 0)) | |
5002 | (func-level (or (nth 4 func-entry) 0)) | |
5003 | (pro-entry (idlwave-what-procedure bos)) | |
5004 | (pro (car pro-entry)) | |
5005 | (pro-class (nth 1 pro-entry)) | |
5006 | (pro-arrow (nth 2 pro-entry)) | |
5007 | (pro-point (or (nth 3 pro-entry) 0)) | |
5008 | (last-char (idlwave-last-valid-char)) | |
5009 | (case-fold-search t) | |
5010 | cw cw-mod cw-arrow cw-class cw-point) | |
5011 | (if (< func-point pro-point) (setq func nil)) | |
5012 | (cond | |
15e42531 CD |
5013 | ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" |
5014 | (buffer-substring bos (point))) | |
5015 | (setq cw 'class)) | |
f32b3b91 CD |
5016 | ((string-match |
5017 | "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" | |
5018 | (buffer-substring (if (> pro-point 0) pro-point bos) (point))) | |
5019 | (setq cw 'procedure cw-class pro-class cw-point pro-point | |
5020 | cw-arrow pro-arrow)) | |
5021 | ((string-match "\\`[ \t]*\\(pro\\|function\\)\\>" | |
5022 | (buffer-substring bos (point))) | |
5023 | nil) | |
15e42531 | 5024 | ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" |
f32b3b91 CD |
5025 | (buffer-substring bos (point))) |
5026 | (setq cw 'class)) | |
5027 | ((and func | |
5028 | (> func-point pro-point) | |
5029 | (= func-level 1) | |
5030 | (memq last-char '(?\( ?,))) | |
5031 | (setq cw 'function-keyword cw-mod func cw-point func-point | |
5032 | cw-class func-class cw-arrow func-arrow)) | |
5033 | ((and pro (eq last-char ?,)) | |
5034 | (setq cw 'procedure-keyword cw-mod pro cw-point pro-point | |
5035 | cw-class pro-class cw-arrow pro-arrow)) | |
5036 | ; ((member last-char '(?\' ?\) ?\] ?!)) | |
5037 | ; ;; after these chars, a function makes no sense | |
5038 | ; ;; FIXME: I am sure there can be more in this list | |
5039 | ; ;; FIXME: Do we want to do this at all? | |
5040 | ; nil) | |
5041 | ;; Everywhere else we try a function. | |
5042 | (t | |
5043 | (setq cw 'function) | |
5044 | (save-excursion | |
5045 | (if (re-search-backward "->[ \t]*\\(\\([$a-zA-Z0-9_]+\\)::\\)?[$a-zA-Z0-9_]*\\=" bos t) | |
5046 | (setq cw-arrow (match-beginning 0) | |
5047 | cw-class (if (match-end 2) | |
5048 | (idlwave-sintern-class (match-string 2)) | |
5049 | t)))))) | |
5050 | (list (list pro pro-point pro-class pro-arrow) | |
5051 | (list func func-point func-class func-arrow) | |
5052 | cw | |
5053 | (list cw-mod cw-point cw-class cw-arrow) | |
5054 | last-char))) | |
5055 | ||
5056 | (defun idlwave-this-word (&optional class) | |
5057 | ;; Grab the word around point. CLASS is for the `skip-chars=...' functions | |
5058 | (setq class (or class "a-zA-Z0-9$_")) | |
5059 | (save-excursion | |
5060 | (buffer-substring-no-properties | |
5061 | (progn (skip-chars-backward class) (point)) | |
5062 | (progn (skip-chars-forward class) (point))))) | |
5063 | ||
f32b3b91 CD |
5064 | (defun idlwave-what-function (&optional bound) |
5065 | ;; Find out if point is within the argument list of a function. | |
5066 | ;; The return value is ("function-name" (point) level). | |
5067 | ;; Level is 1 on the to level parenthesis, higher further down. | |
5068 | ||
5069 | ;; If the optional BOUND is an integer, bound backwards directed | |
5070 | ;; searches to this point. | |
5071 | ||
5072 | (catch 'exit | |
5073 | (let (pos | |
5074 | func-point | |
f32b3b91 CD |
5075 | (cnt 0) |
5076 | func arrow-start class) | |
15e42531 CD |
5077 | (idlwave-with-special-syntax |
5078 | (save-restriction | |
5079 | (save-excursion | |
5080 | (narrow-to-region (max 1 (or bound 0)) (point-max)) | |
5081 | ;; move back out of the current parenthesis | |
5082 | (while (condition-case nil | |
5083 | (progn (up-list -1) t) | |
5084 | (error nil)) | |
5085 | (setq pos (point)) | |
5086 | (incf cnt) | |
5087 | (when (and (= (following-char) ?\() | |
5088 | (re-search-backward | |
5089 | "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" | |
5090 | bound t)) | |
5091 | (setq func (match-string 2) | |
5092 | func-point (goto-char (match-beginning 2)) | |
5093 | pos func-point) | |
5094 | (if (re-search-backward | |
5095 | "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) | |
5096 | (setq arrow-start (match-beginning 0) | |
5097 | class (or (match-string 2) t))) | |
5098 | (throw | |
5099 | 'exit | |
5100 | (list | |
5101 | (idlwave-sintern-routine-or-method func class) | |
5102 | (idlwave-sintern-class class) | |
5103 | arrow-start func-point cnt))) | |
5104 | (goto-char pos)) | |
5105 | (throw 'exit nil))))))) | |
f32b3b91 CD |
5106 | |
5107 | (defun idlwave-what-procedure (&optional bound) | |
5108 | ;; Find out if point is within the argument list of a procedure. | |
5109 | ;; The return value is ("procedure-name" class arrow-pos (point)). | |
5110 | ||
5111 | ;; If the optional BOUND is an integer, bound backwards directed | |
5112 | ;; searches to this point. | |
5113 | (let ((pos (point)) pro-point | |
5114 | pro class arrow-start string) | |
5115 | (save-excursion | |
15e42531 CD |
5116 | ;????(idlwave-beginning-of-statement) |
5117 | ;; FIXME: WAS THIS CHANGE CORRECT: Answer: yes | |
5118 | (idlwave-start-of-substatement 'pre) | |
f32b3b91 CD |
5119 | (setq string (buffer-substring (point) pos)) |
5120 | (if (string-match | |
5121 | "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) | |
5122 | (setq pro (match-string 1 string) | |
5123 | pro-point (+ (point) (match-beginning 1))) | |
5124 | (if (and (idlwave-skip-object) | |
5125 | (setq string (buffer-substring (point) pos)) | |
5126 | (string-match | |
5127 | "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\'\\)" string)) | |
5128 | (setq pro (if (match-beginning 4) | |
5129 | (match-string 4 string)) | |
5130 | pro-point (if (match-beginning 4) | |
5131 | (+ (point) (match-beginning 4)) | |
5132 | pos) | |
5133 | arrow-start (+ (point) (match-beginning 1)) | |
5134 | class (or (match-string 3 string) t))))) | |
5135 | (list (idlwave-sintern-routine-or-method pro class) | |
5136 | (idlwave-sintern-class class) | |
5137 | arrow-start | |
5138 | pro-point))) | |
5139 | ||
5140 | (defun idlwave-skip-object () | |
5141 | ;; If there is an object at point, move over it and return t. | |
5142 | (let ((pos (point))) | |
5143 | (if (catch 'exit | |
5144 | (save-excursion | |
5145 | (skip-chars-forward " ") ; white space | |
5146 | (skip-chars-forward "*") ; de-reference | |
5147 | (cond | |
5148 | ((looking-at idlwave-identifier) | |
5149 | (goto-char (match-end 0))) | |
5150 | ((eq (following-char) ?\() | |
5151 | nil) | |
5152 | (t (throw 'exit nil))) | |
5153 | (catch 'endwhile | |
5154 | (while t | |
5155 | (cond ((eq (following-char) ?.) | |
5156 | (forward-char 1) | |
5157 | (if (not (looking-at idlwave-identifier)) | |
5158 | (throw 'exit nil)) | |
5159 | (goto-char (match-end 0))) | |
5160 | ((memq (following-char) '(?\( ?\[)) | |
5161 | (condition-case nil | |
5162 | (forward-list 1) | |
5163 | (error (throw 'exit nil)))) | |
5164 | (t (throw 'endwhile t))))) | |
5165 | (if (looking-at "[ \t]*->") | |
5166 | (throw 'exit (setq pos (match-beginning 0))) | |
5167 | (throw 'exit nil)))) | |
5168 | (goto-char pos) | |
5169 | nil))) | |
5170 | ||
5171 | ||
5172 | (defun idlwave-last-valid-char () | |
5173 | "Return the last character before point which is not white or a comment | |
5174 | and also not part of the current identifier. Since we do this in | |
5175 | order to identify places where keywords are, we consider the initial | |
5176 | `/' of a keyword as part of the identifier. | |
5177 | This function is not general, can only be used for completion stuff." | |
5178 | (catch 'exit | |
5179 | (save-excursion | |
5180 | ;; skip the current identifier | |
5181 | (skip-chars-backward "a-zA-Z0-9_$") | |
5182 | ;; also skip a leading slash which might be belong to the keyword | |
5183 | (if (eq (preceding-char) ?/) | |
5184 | (backward-char 1)) | |
5185 | ;; FIXME: does not check if this is a valid identifier | |
5186 | (while t | |
5187 | (skip-chars-backward " \t") | |
5188 | (cond | |
5189 | ((memq (preceding-char) '(?\; ?\$)) (throw 'exit nil)) | |
5190 | ((eq (preceding-char) ?\n) | |
5191 | (beginning-of-line 0) | |
5192 | (if (looking-at "\\([^;]\\)*\\$[ \t]*\\(;.*\\)?\n") | |
5193 | ;; continuation line | |
5194 | (goto-char (match-end 1)) | |
5195 | (throw 'exit nil))) | |
5196 | (t (throw 'exit (preceding-char)))))))) | |
5197 | ||
5198 | (defvar idlwave-complete-after-success-form nil | |
5199 | "A form to evaluate after successful completion.") | |
5200 | (defvar idlwave-complete-after-success-form-force nil | |
5201 | "A form to evaluate after completion selection in *Completions* buffer.") | |
5202 | (defconst idlwave-completion-mark (make-marker) | |
5203 | "A mark pointing to the beginning of the completion string.") | |
5204 | ||
5205 | (defun idlwave-complete-in-buffer (type stype list selector prompt isa | |
5206 | &optional prepare-display-function) | |
5207 | "Perform TYPE completion of word before point against LIST. | |
5208 | SELECTOR is the PREDICATE argument for the completion function. | |
5209 | Show PROMPT in echo area. TYPE is one of 'function, 'procedure or 'keyword." | |
5210 | (let* ((completion-ignore-case t) | |
5211 | beg (end (point)) slash part spart completion all-completions | |
5212 | dpart dcompletion) | |
5213 | ||
5214 | (unless list | |
5215 | (error (concat prompt ": No completions available"))) | |
5216 | ||
5217 | ;; What is already in the buffer? | |
5218 | (save-excursion | |
5219 | (skip-chars-backward "a-zA-Z0-9_$") | |
5220 | (setq slash (eq (preceding-char) ?/) | |
5221 | beg (point) | |
5222 | idlwave-complete-after-success-form | |
5223 | (list 'idlwave-after-successful-completion | |
5224 | (list 'quote type) slash beg) | |
5225 | idlwave-complete-after-success-form-force | |
5226 | (list 'idlwave-after-successful-completion | |
5227 | (list 'quote type) slash (list 'quote 'force)))) | |
5228 | ||
5229 | ;; Try a completion | |
5230 | (setq part (buffer-substring beg end) | |
5231 | dpart (downcase part) | |
5232 | spart (idlwave-sintern stype part) | |
5233 | completion (try-completion part list selector) | |
5234 | dcompletion (if (stringp completion) (downcase completion))) | |
5235 | (cond | |
5236 | ((null completion) | |
5237 | ;; nothing available. | |
5238 | (error "Can't find %s completion for \"%s\"" isa part)) | |
5239 | ((and (not (equal dpart dcompletion)) | |
5240 | (not (eq t completion))) | |
5241 | ;; We can add something | |
5242 | (delete-region beg end) | |
5243 | (if (and (string= part dpart) | |
5244 | (or (not (string= part "")) | |
5245 | idlwave-complete-empty-string-as-lower-case) | |
5246 | (not idlwave-completion-force-default-case)) | |
5247 | (insert dcompletion) | |
5248 | (insert completion)) | |
5249 | (if (eq t (try-completion completion list selector)) | |
5250 | ;; Now this is a unique match | |
5251 | (idlwave-after-successful-completion type slash beg)) | |
5252 | t) | |
5253 | ((or (eq completion t) | |
5254 | (and (equal dpart dcompletion) | |
5255 | (= 1 (length (setq all-completions | |
5256 | (idlwave-uniquify | |
5257 | (all-completions part list selector))))))) | |
5258 | ;; This is already complete | |
5259 | (idlwave-after-successful-completion type slash beg) | |
5260 | (message "%s is already the complete %s" part isa) | |
5261 | nil) | |
5262 | (t | |
5263 | ;; We cannot add something - offer a list. | |
5264 | (message "Making completion list...") | |
5265 | (let* ((list all-completions) | |
5266 | (complete (memq spart all-completions)) | |
5267 | (completion-highlight-first-word-only t) ; XEmacs | |
5268 | (completion-fixup-function ; Emacs | |
5269 | (lambda () (and (eq (preceding-char) ?>) | |
5270 | (re-search-backward " <" beg t))))) | |
5271 | (setq list (sort list (lambda (a b) | |
5272 | (string< (downcase a) (downcase b))))) | |
5273 | (if prepare-display-function | |
5274 | (setq list (funcall prepare-display-function list))) | |
5275 | (if (and (string= part dpart) | |
5276 | (or (not (string= part "")) | |
5277 | idlwave-complete-empty-string-as-lower-case) | |
5278 | (not idlwave-completion-force-default-case)) | |
5279 | (setq list (mapcar (lambda (x) | |
5280 | (if (listp x) | |
5281 | (setcar x (downcase (car x))) | |
5282 | (setq x (downcase x))) | |
5283 | x) | |
5284 | list))) | |
5285 | (idlwave-display-completion-list list prompt beg complete)) | |
5286 | t)))) | |
5287 | ||
5288 | (defun idlwave-complete-class () | |
5289 | "Complete a class at point." | |
5290 | (interactive) | |
5291 | ;; Call `idlwave-routines' to make sure the class list will be available | |
5292 | (idlwave-routines) | |
15e42531 CD |
5293 | ;; Check for the special case of completing empty string after pro/function |
5294 | (if (let ((case-fold-search t)) | |
5295 | (save-excursion | |
5296 | (and | |
5297 | (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" | |
5298 | (- (point) 15) t) | |
5299 | (goto-char (point-min)) | |
5300 | (re-search-forward | |
5301 | "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) | |
5302 | ;; Yank the full class specification | |
5303 | (insert (match-string 2)) | |
5304 | ;; Do the completion | |
5305 | (idlwave-complete-in-buffer 'class 'class (idlwave-class-alist) nil | |
5306 | "Select a class" "class"))) | |
f32b3b91 CD |
5307 | |
5308 | (defun idlwave-attach-classes (list is-kwd show-classes) | |
5309 | ;; attach the proper class list to a LIST of completion items. | |
5310 | ;; IS-KWD, when non-nil, shows its keywords - otherwise its methods | |
5311 | ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. | |
5312 | (catch 'exit | |
5313 | (if (or (null show-classes) ; don't wnat to see classes | |
5314 | (null class-selector) ; not a method call | |
5315 | (stringp class-selector)) ; the class is already known | |
5316 | ;; In these cases, we do not have to do anything | |
5317 | (throw 'exit list)) | |
5318 | ||
5319 | ;; The property and dots stuff currently only make sense with XEmacs | |
5320 | ;; because Emacs drops text properties when filling the *Completions* | |
5321 | ;; buffer. | |
5322 | (let* ((do-prop (and (featurep 'xemacs) (>= show-classes 0))) | |
5323 | (do-buf (not (= show-classes 0))) | |
5324 | (do-dots (featurep 'xemacs)) | |
5325 | (max (abs show-classes)) | |
5326 | (lmax (if do-dots (apply 'max (mapcar 'length list)))) | |
5327 | classes nclasses class-info space) | |
5328 | (mapcar | |
5329 | (lambda (x) | |
5330 | ;; get the classes | |
5331 | (setq classes | |
5332 | (if is-kwd | |
5333 | (idlwave-all-method-keyword-classes | |
5334 | method-selector x type-selector) | |
5335 | (idlwave-all-method-classes x type-selector))) | |
5336 | (setq nclasses (length classes)) | |
5337 | ;; Make the separator between item and class-info | |
5338 | (if do-dots | |
5339 | (setq space (concat " " (make-string (- lmax (length x)) ?.))) | |
5340 | (setq space " ")) | |
5341 | (if do-buf | |
5342 | ;; We do want info in the buffer | |
5343 | (if (<= nclasses max) | |
5344 | (setq class-info (concat | |
5345 | space | |
5346 | "<" (mapconcat 'identity classes ",") ">")) | |
5347 | (setq class-info (format "%s<%d classes>" space nclasses))) | |
5348 | (setq class-info nil)) | |
5349 | (when do-prop | |
5350 | ;; We do want properties | |
5351 | (setq x (copy-sequence x)) | |
5352 | (put-text-property 0 (length x) | |
5353 | 'help-echo (mapconcat 'identity classes " ") | |
5354 | x)) | |
5355 | (if class-info | |
5356 | (list x class-info) | |
5357 | x)) | |
5358 | list)))) | |
5359 | ||
5360 | (defun idlwave-attach-method-classes (list) | |
5361 | ;; Call idlwave-attach-classes with method parameters | |
5362 | (idlwave-attach-classes list nil idlwave-completion-show-classes)) | |
5363 | (defun idlwave-attach-keyword-classes (list) | |
5364 | ;; Call idlwave-attach-classes with keyword parameters | |
5365 | (idlwave-attach-classes list t idlwave-completion-show-classes)) | |
5366 | ||
5367 | ;;---------------------------------------------------------------------- | |
5368 | ;;---------------------------------------------------------------------- | |
5369 | ;;---------------------------------------------------------------------- | |
5370 | ;;---------------------------------------------------------------------- | |
5371 | ;;---------------------------------------------------------------------- | |
5372 | ||
15e42531 CD |
5373 | (defvar idlwave-completion-setup-hook nil) |
5374 | ||
f32b3b91 CD |
5375 | (defun idlwave-scroll-completions (&optional message) |
5376 | "Scroll the completion window on this frame." | |
5377 | (let ((cwin (get-buffer-window "*Completions*" 'visible)) | |
5378 | (win (selected-window))) | |
5379 | (unwind-protect | |
5380 | (progn | |
5381 | (select-window cwin) | |
5382 | (condition-case nil | |
5383 | (scroll-up) | |
5384 | (error (if (and (listp last-command) | |
5385 | (nth 2 last-command)) | |
5386 | (progn | |
5387 | (select-window win) | |
5388 | (eval idlwave-complete-after-success-form)) | |
5389 | (set-window-start cwin (point-min))))) | |
5390 | (and message (message message))) | |
5391 | (select-window win)))) | |
5392 | ||
5393 | (defun idlwave-display-completion-list (list &optional message beg complete) | |
5394 | "Display the completions in LIST in the completions buffer and echo MESSAGE." | |
5395 | (unless (and (get-buffer-window "*Completions*") | |
5396 | (idlwave-local-value 'idlwave-completion-p "*Completions*")) | |
5397 | (move-marker idlwave-completion-mark beg) | |
5398 | (setq idlwave-before-completion-wconf (current-window-configuration))) | |
5399 | ||
5400 | (if (featurep 'xemacs) | |
15e42531 CD |
5401 | (idlwave-display-completion-list-xemacs |
5402 | list) | |
f32b3b91 CD |
5403 | (idlwave-display-completion-list-emacs list)) |
5404 | ||
5405 | ;; Store a special value in `this-command'. When `idlwave-complete' | |
5406 | ;; finds this in `last-command', it will scroll the *Completions* buffer. | |
5407 | (setq this-command (list 'idlwave-display-completion-list message complete)) | |
5408 | ||
5409 | ;; Mark the completions buffer as created by cib | |
5410 | (idlwave-set-local 'idlwave-completion-p t "*Completions*") | |
5411 | ||
5412 | ;; Fontify the classes | |
5413 | (if (and idlwave-completion-fontify-classes | |
5414 | (consp (car list))) | |
5415 | (idlwave-completion-fontify-classes)) | |
5416 | ||
15e42531 CD |
5417 | ;; Run the hook |
5418 | (run-hooks 'idlwave-completion-setup-hook) | |
5419 | ||
f32b3b91 CD |
5420 | ;; Display the message |
5421 | (message (or message "Making completion list...done"))) | |
5422 | ||
5423 | (defun idlwave-choose (function &rest args) | |
5424 | "Call FUNCTION as a completion chooser and pass ARGS to it." | |
5425 | (let ((completion-ignore-case t)) ; install correct value | |
5426 | (apply function args)) | |
15e42531 CD |
5427 | (if (and (eq major-mode 'idlwave-shell-mode) |
5428 | (boundp 'font-lock-mode) | |
5429 | (not font-lock-mode)) | |
5430 | ;; Remove the fontification of the word before point | |
5431 | (let ((beg (save-excursion | |
5432 | (skip-chars-backward "a-zA-Z0-9_") | |
5433 | (point)))) | |
5434 | (remove-text-properties beg (point) '(face nil)))) | |
f32b3b91 CD |
5435 | (eval idlwave-complete-after-success-form-force)) |
5436 | ||
5437 | (defun idlwave-restore-wconf-after-completion () | |
5438 | "Restore the old (before completion) window configuration." | |
5439 | (and idlwave-completion-restore-window-configuration | |
5440 | idlwave-before-completion-wconf | |
5441 | (set-window-configuration idlwave-before-completion-wconf))) | |
5442 | ||
5443 | (defun idlwave-set-local (var value &optional buffer) | |
5444 | "Set the buffer-local value of VAR in BUFFER to VALUE." | |
5445 | (save-excursion | |
5446 | (set-buffer (or buffer (current-buffer))) | |
5447 | (set (make-local-variable var) value))) | |
5448 | ||
5449 | (defun idlwave-local-value (var &optional buffer) | |
5450 | "Return the value of VAR in BUFFER, but only if VAR is local to BUFFER." | |
5451 | (save-excursion | |
5452 | (set-buffer (or buffer (current-buffer))) | |
5453 | (and (local-variable-p var (current-buffer)) | |
5454 | (symbol-value var)))) | |
5455 | ||
15e42531 CD |
5456 | ;; In XEmacs, we can use :activate-callback directly to advice the |
5457 | ;; choose functions. We use the private keymap only for the online | |
5458 | ;; help feature. | |
f32b3b91 | 5459 | |
15e42531 CD |
5460 | (defvar idlwave-completion-map nil |
5461 | "Keymap for completion-list-mode with idlwave-complete.") | |
5462 | ||
5463 | (defun idlwave-display-completion-list-xemacs (list &rest cl-args) | |
f32b3b91 | 5464 | (with-output-to-temp-buffer "*Completions*" |
15e42531 CD |
5465 | (apply 'display-completion-list list |
5466 | ':activate-callback 'idlwave-default-choose-completion | |
5467 | cl-args)) | |
5468 | (save-excursion | |
5469 | (set-buffer "*Completions*") | |
5470 | (use-local-map | |
5471 | (or idlwave-completion-map | |
5472 | (setq idlwave-completion-map | |
5473 | (idlwave-make-modified-completion-map-xemacs | |
5474 | (current-local-map))))))) | |
f32b3b91 CD |
5475 | |
5476 | (defun idlwave-default-choose-completion (&rest args) | |
5477 | "Execute `default-choose-completion' and then restore the win-conf." | |
5478 | (apply 'idlwave-choose 'default-choose-completion args)) | |
5479 | ||
15e42531 CD |
5480 | (defun idlwave-make-modified-completion-map-xemacs (old-map) |
5481 | "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." | |
5482 | (let ((new-map (copy-keymap old-map))) | |
5483 | (define-key new-map [button3up] 'idlwave-mouse-completion-help) | |
5484 | (define-key new-map [button3] (lambda () | |
5485 | (interactive) | |
5486 | (setq this-command last-command))) | |
5487 | new-map)) | |
f32b3b91 | 5488 | |
15e42531 CD |
5489 | ;; In Emacs we also to replace choose keybindings in the completion |
5490 | ;; map in order to install our wrappers. | |
f32b3b91 CD |
5491 | |
5492 | (defun idlwave-display-completion-list-emacs (list) | |
5493 | "Display completion list and install the choose wrappers." | |
5494 | (with-output-to-temp-buffer "*Completions*" | |
5495 | (display-completion-list list)) | |
5496 | (save-excursion | |
5497 | (set-buffer "*Completions*") | |
5498 | (use-local-map | |
5499 | (or idlwave-completion-map | |
5500 | (setq idlwave-completion-map | |
15e42531 CD |
5501 | (idlwave-make-modified-completion-map-emacs |
5502 | (current-local-map))))))) | |
5503 | ||
5504 | (defun idlwave-make-modified-completion-map-emacs (old-map) | |
f32b3b91 CD |
5505 | "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." |
5506 | (let ((new-map (copy-keymap old-map))) | |
5507 | (substitute-key-definition | |
5508 | 'choose-completion 'idlwave-choose-completion new-map) | |
5509 | (substitute-key-definition | |
5510 | 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) | |
15e42531 | 5511 | (define-key new-map [mouse-3] 'idlwave-mouse-completion-help) |
f32b3b91 CD |
5512 | new-map)) |
5513 | ||
5514 | (defun idlwave-choose-completion (&rest args) | |
5515 | "Choose the completion that point is in or next to." | |
5516 | (interactive) | |
5517 | (apply 'idlwave-choose 'choose-completion args)) | |
5518 | ||
5519 | (defun idlwave-mouse-choose-completion (&rest args) | |
5520 | "Click on an alternative in the `*Completions*' buffer to choose it." | |
5521 | (interactive "e") | |
5522 | (apply 'idlwave-choose 'mouse-choose-completion args)) | |
5523 | ||
5524 | ;;---------------------------------------------------------------------- | |
5525 | ;;---------------------------------------------------------------------- | |
5526 | ||
5527 | (defun idlwave-completion-fontify-classes () | |
5528 | "Goto the *Completions* buffer and fontify the class info." | |
5529 | (when (featurep 'font-lock) | |
5530 | (save-excursion | |
5531 | (set-buffer "*Completions*") | |
5532 | (save-excursion | |
5533 | (goto-char (point-min)) | |
5534 | (while (re-search-forward "\\.*<[^>]+>" nil t) | |
5535 | (put-text-property (match-beginning 0) (match-end 0) | |
5536 | 'face 'font-lock-string-face)))))) | |
5537 | ||
5538 | (defun idlwave-uniquify (list) | |
5539 | (let (nlist) | |
5540 | (loop for x in list do | |
5541 | (add-to-list 'nlist x)) | |
5542 | nlist)) | |
5543 | ||
5544 | (defun idlwave-after-successful-completion (type slash &optional verify) | |
5545 | "Add `=' or `(' after successful completion of keyword and function. | |
5546 | Restore the pre-completion window configuration if possible." | |
5547 | (cond | |
5548 | ((eq type 'procedure) | |
5549 | nil) | |
5550 | ((eq type 'function) | |
5551 | (cond | |
5552 | ((equal idlwave-function-completion-adds-paren nil) nil) | |
5553 | ((or (equal idlwave-function-completion-adds-paren t) | |
5554 | (equal idlwave-function-completion-adds-paren 1)) | |
5555 | (insert "(")) | |
5556 | ((equal idlwave-function-completion-adds-paren 2) | |
5557 | (insert "()") | |
5558 | (backward-char 1)) | |
5559 | (t nil))) | |
5560 | ((eq type 'keyword) | |
5561 | (if (and idlwave-keyword-completion-adds-equal | |
5562 | (not slash)) | |
5563 | (progn (insert "=") t) | |
5564 | nil))) | |
5565 | ||
5566 | ;; Restore the pre-completion window configuration if this is safe. | |
5567 | ||
5568 | (if (or (eq verify 'force) ; force | |
5569 | (and | |
5570 | (get-buffer-window "*Completions*") ; visible | |
5571 | (idlwave-local-value 'idlwave-completion-p | |
5572 | "*Completions*") ; cib-buffer | |
5573 | (eq (marker-buffer idlwave-completion-mark) | |
5574 | (current-buffer)) ; buffer OK | |
5575 | (equal (marker-position idlwave-completion-mark) | |
5576 | verify))) ; pos OK | |
5577 | (idlwave-restore-wconf-after-completion)) | |
5578 | (move-marker idlwave-completion-mark nil) | |
5579 | (setq idlwave-before-completion-wconf nil)) | |
5580 | ||
15e42531 CD |
5581 | (defun idlwave-mouse-context-help (ev &optional arg) |
5582 | "Call `idlwave-context-help' on the clicked location." | |
5583 | (interactive "eP") | |
5584 | (mouse-set-point ev) | |
5585 | (idlwave-context-help arg)) | |
5586 | ||
5587 | (defvar idlwave-last-context-help-pos nil) | |
5588 | (defun idlwave-context-help (&optional arg) | |
5589 | "Display IDL Online Help on context. | |
5590 | If point is on a keyword, help for that keyword will be shown. | |
5591 | If point is on a routine name or in the argument list of a routine, | |
5592 | help for that routine will be displayed. | |
5593 | Works for system routines and keywords only." | |
f32b3b91 | 5594 | (interactive "P") |
15e42531 CD |
5595 | (idlwave-require-online-help) |
5596 | (idlwave-do-context-help arg)) | |
5597 | ||
5598 | (defun idlwave-mouse-completion-help (ev) | |
5599 | "Display online help about the completion at point." | |
5600 | (interactive "eP") | |
5601 | (idlwave-require-online-help) | |
5602 | ;; Restore last-command for next command, to make scrolling of completions | |
5603 | ;; work. | |
5604 | (setq this-command last-command) | |
5605 | (idlwave-do-mouse-completion-help ev)) | |
5606 | ||
5607 | ||
5608 | (defvar idlwave-help-is-loaded nil | |
5609 | "Is online help avaiable?") | |
5610 | ;; The following variables will be defined by `idlw-help.el'. | |
5611 | (defvar idlwave-help-frame-width nil) | |
5612 | (defvar idlwave-help-file nil) | |
5613 | (defvar idlwave-help-topics nil) | |
5614 | ||
5615 | (defun idlwave-help-directory () | |
5616 | "Return the help directory, or nil if that is not known." | |
5617 | (or (and (stringp idlwave-help-directory) | |
5618 | (> (length idlwave-help-directory) 0) | |
5619 | idlwave-help-directory) | |
5620 | (getenv "IDLWAVE_HELP_DIRECTORY"))) | |
5621 | ||
5622 | (defun idlwave-require-online-help () | |
5623 | (if idlwave-help-is-loaded | |
5624 | t ;; everything is OK. | |
5625 | (let* ((dir (or (idlwave-help-directory) | |
5626 | (error "Online Help is not installed (idlwave-help-directory is unknown)."))) | |
5627 | (lfile1 (expand-file-name "idlw-help.elc" dir)) | |
5628 | (lfile2 (expand-file-name "idlw-help.el" dir)) | |
5629 | (hfile (expand-file-name "idlw-help.txt" dir))) | |
5630 | (if (or (and (file-regular-p lfile1) (load-file lfile1)) | |
5631 | (and (file-regular-p lfile2) (load-file lfile2))) | |
5632 | (progn | |
5633 | (if (and idlwave-help-frame-parameters | |
5634 | (not (assoc 'width idlwave-help-frame-parameters))) | |
5635 | (push (cons 'width idlwave-help-frame-width) | |
5636 | idlwave-help-frame-parameters)) | |
5637 | (or idlwave-help-topics | |
5638 | (error "File `%s' in help dir `%s' does not define `idlwave-help-topics'" | |
5639 | "idlw-help.el" dir))) | |
5640 | (error "No such file `%s' in help dir `%s'" "idlw-help.el" dir)) | |
5641 | (if (file-regular-p hfile) | |
5642 | (setq idlwave-help-is-loaded t | |
5643 | idlwave-help-file hfile) | |
5644 | (error "No such file `%s' in dir `%s'" "idlw-help.txt" dir))))) | |
f32b3b91 CD |
5645 | |
5646 | (defun idlwave-routine-info (&optional arg external) | |
5647 | "Display a routines calling sequence and list of keywords. | |
5648 | When point is on the name a function or procedure, or in the argument | |
5649 | list of a function or procedure, this command displays a help buffer | |
5650 | with the information. When called with prefix arg, enforce class | |
5651 | query. | |
5652 | ||
5653 | When point is on an object operator `->', display the class stored in | |
5654 | this arrow, if any (see `idlwave-store-inquired-class'). With a | |
5655 | prefix arg, the class property is cleared out." | |
5656 | ||
5657 | (interactive "P") | |
5658 | (idlwave-routines) | |
5659 | (if (string-match "->" (buffer-substring | |
5660 | (max (point-min) (1- (point))) | |
5661 | (min (+ 2 (point)) (point-max)))) | |
5662 | ;; Cursor is on an arrow | |
5663 | (if (get-text-property (point) 'idlwave-class) | |
5664 | ;; arrow has class property | |
5665 | (if arg | |
5666 | ;; Remove property | |
5667 | (save-excursion | |
5668 | (backward-char 1) | |
5669 | (when (looking-at ".?\\(->\\)") | |
5670 | (remove-text-properties (match-beginning 1) (match-end 1) | |
5671 | '(idlwave-class nil face nil)) | |
5672 | (message "Class property removed from arrow"))) | |
5673 | ;; Echo class property | |
5674 | (message "Arrow has text property identifying object to be class %s" | |
5675 | (get-text-property (point) 'idlwave-class))) | |
5676 | ;; No property found | |
5677 | (message "Arrow has no class text property")) | |
5678 | ||
5679 | ;; Not on an arrow... | |
5680 | (let* ((idlwave-query-class nil) | |
5681 | (idlwave-force-class-query (equal arg '(4))) | |
5682 | (module (idlwave-what-module))) | |
15e42531 CD |
5683 | (if (car module) |
5684 | (apply 'idlwave-display-calling-sequence module) | |
5685 | (error "Don't know which calling sequence to show."))))) | |
f32b3b91 CD |
5686 | |
5687 | (defun idlwave-resolve (&optional arg) | |
5688 | "Call RESOLVE on the module name at point. | |
5689 | Like `idlwave-routine-info', this looks for a routine call at point. | |
5690 | After confirmation in the minibuffer, it will use the shell to issue | |
5691 | a RESOLVE call for this routine, to attempt to make it defined and its | |
5692 | routine info available for IDLWAVE. If the routine is a method call, | |
5693 | both `class__method' and `class__define' will be tried. | |
5694 | With ARG, enforce query for the class of object methods." | |
5695 | (interactive "P") | |
5696 | (let* ((idlwave-query-class nil) | |
5697 | (idlwave-force-class-query (equal arg '(4))) | |
5698 | (module (idlwave-what-module)) | |
5699 | (name (idlwave-make-full-name (nth 2 module) (car module))) | |
5700 | (type (if (eq (nth 1 module) 'pro) "pro" "function")) | |
5701 | (resolve (read-string "Resolve: " (format "%s %s" type name))) | |
5702 | (kwd "") | |
5703 | class) | |
5704 | (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" | |
5705 | resolve) | |
5706 | (setq type (match-string 1 resolve) | |
5707 | class (if (match-beginning 2) | |
5708 | (match-string 3 resolve) | |
5709 | nil) | |
5710 | name (match-string 4 resolve))) | |
5711 | (if (string= (downcase type) "function") | |
5712 | (setq kwd ",/is_function")) | |
5713 | ||
5714 | (cond | |
5715 | ((null class) | |
5716 | (idlwave-shell-send-command | |
5717 | (format "resolve_routine,'%s'%s" (downcase name) kwd) | |
5718 | 'idlwave-update-routine-info | |
5719 | nil t)) | |
5720 | (t | |
5721 | (idlwave-shell-send-command | |
5722 | (format "resolve_routine,'%s__define'%s" (downcase class) kwd) | |
5723 | (list 'idlwave-shell-send-command | |
5724 | (format "resolve_routine,'%s__%s'%s" | |
5725 | (downcase class) (downcase name) kwd) | |
5726 | '(idlwave-update-routine-info) | |
5727 | nil t)))))) | |
5728 | ||
5729 | (defun idlwave-find-module (&optional arg) | |
5730 | "Find the source code of an IDL module. | |
5731 | Works for modules for which IDLWAVE has routine info available. | |
5732 | The function offers as default the module name `idlwave-routine-info' would | |
5733 | use. With ARG force class query for object methods." | |
5734 | (interactive "P") | |
5735 | (let* ((idlwave-query-class nil) | |
5736 | (idlwave-force-class-query (equal arg '(4))) | |
5737 | (module (idlwave-what-module)) | |
5738 | (default (concat (idlwave-make-full-name (nth 2 module) (car module)) | |
5739 | (if (eq (nth 1 module) 'pro) "<p>" "<f>"))) | |
5740 | (list | |
5741 | (delq nil | |
5742 | (mapcar (lambda (x) | |
5743 | (if (eq 'system (car-safe (nth 3 x))) | |
5744 | ;; Take out system routines with no source. | |
5745 | nil | |
5746 | (cons | |
5747 | (concat (idlwave-make-full-name (nth 2 x) (car x)) | |
5748 | (if (eq (nth 1 x) 'pro) "<p>" "<f>")) | |
5749 | (cdr x)))) | |
5750 | (idlwave-routines)))) | |
5751 | (name (idlwave-completing-read | |
5752 | (format "Module (Default %s): " | |
5753 | (if default default "none")) | |
5754 | list)) | |
5755 | type class) | |
5756 | (if (string-match "\\`\\s-*\\'" name) | |
5757 | ;; Nothing, use the default. | |
5758 | (setq name default)) | |
5759 | (if (string-match "<[fp]>" name) | |
5760 | (setq type (substring name -2 -1) | |
5761 | name (substring name 0 -3))) | |
5762 | (if (string-match "\\(.*\\)::\\(.*\\)" name) | |
5763 | (setq class (match-string 1 name) | |
5764 | name (match-string 2 name))) | |
5765 | (setq name (idlwave-sintern-routine-or-method name class) | |
5766 | class (idlwave-sintern-class class) | |
5767 | type (cond ((equal type "f") 'fun) | |
5768 | ((equal type "p") 'pro) | |
5769 | (t t))) | |
5770 | (idlwave-do-find-module name type class))) | |
5771 | ||
15e42531 | 5772 | (defun idlwave-do-find-module (name type class &optional force-source) |
f32b3b91 CD |
5773 | (let ((name1 (idlwave-make-full-name class name)) |
5774 | source buf1 entry | |
5775 | (buf (current-buffer)) | |
5776 | (pos (point))) | |
15e42531 CD |
5777 | (setq entry (idlwave-best-rinfo-assq name type class (idlwave-routines)) |
5778 | source (or force-source (nth 3 entry))) | |
f32b3b91 CD |
5779 | (cond |
5780 | ((or (null name) (equal name "")) | |
5781 | (error "Abort")) | |
5782 | ((null entry) | |
5783 | (error "Nothing known about a module %s" name1)) | |
5784 | ((eq (car source) 'system) | |
5785 | (error "Source code for system routine %s is not available." | |
5786 | name1)) | |
5787 | ((equal (cdr source) "") | |
5788 | (error "Source code for routine %s is not available." | |
5789 | name1)) | |
5790 | ((memq (car source) '(buffer lib compiled)) | |
5791 | (setq buf1 | |
5792 | (if (eq (car source) 'lib) | |
15e42531 CD |
5793 | (idlwave-find-file-noselect |
5794 | (idlwave-expand-lib-file-name | |
5795 | (or (cdr source) | |
5796 | (format "%s.pro" (downcase name)))) 'find) | |
5797 | (idlwave-find-file-noselect (cdr source) 'find))) | |
5798 | (pop-to-buffer buf1 t) | |
5799 | (goto-char (point-max)) | |
f32b3b91 | 5800 | (let ((case-fold-search t)) |
15e42531 | 5801 | (if (re-search-backward |
f32b3b91 CD |
5802 | (concat "^[ \t]*\\<" |
5803 | (cond ((equal type "f") "function") | |
5804 | ((equal type "p") "pro") | |
5805 | (t "\\(pro\\|function\\)")) | |
5806 | "\\>[ \t]+" | |
5807 | (regexp-quote (downcase name1)) | |
5808 | "[^a-zA-Z0-9_$]") | |
5809 | nil t) | |
5810 | (goto-char (match-beginning 0)) | |
5811 | (pop-to-buffer buf) | |
5812 | (goto-char pos) | |
5813 | (error "Could not find routine %s" name1))))))) | |
5814 | ||
5815 | (defun idlwave-what-module () | |
5816 | "Return a default module for stuff near point. | |
5817 | Used by `idlwave-routine-info' and `idlwave-find-module'." | |
5818 | (idlwave-routines) | |
15e42531 CD |
5819 | (if (let ((case-fold-search t)) |
5820 | (save-excursion | |
5821 | (idlwave-beginning-of-statement) | |
5822 | (looking-at "[ \t]*\\(pro\\|function\\)[ \t]+\\(\\([a-zA-Z0-9_$]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)\\([, \t\n]\\|$\\)"))) | |
5823 | ;; This is a function or procedure definition statement | |
5824 | ;; We return the defined routine as module. | |
5825 | (list | |
5826 | (idlwave-sintern-routine-or-method (match-string 4) | |
5827 | (match-string 2)) | |
5828 | (if (equal (downcase (match-string 1)) "pro") 'pro 'fun) | |
5829 | (idlwave-sintern-class (match-string 3))) | |
5830 | ||
5831 | ;; Not a definition statement - analyze precise positon. | |
5832 | (let* ((where (idlwave-where)) | |
5833 | (cw (nth 2 where)) | |
5834 | (pro (car (nth 0 where))) | |
5835 | (func (car (nth 1 where))) | |
5836 | (this-word (idlwave-this-word "a-zA-Z0-9$_")) | |
5837 | (next-char (save-excursion (skip-chars-forward "a-zA-Z0-9$_") | |
5838 | (following-char))) | |
5839 | ) | |
5840 | (cond | |
5841 | ((and (eq cw 'procedure) | |
5842 | (not (equal this-word ""))) | |
5843 | (setq this-word (idlwave-sintern-routine-or-method | |
5844 | this-word (nth 2 (nth 3 where)))) | |
5845 | (list this-word 'pro | |
5846 | (idlwave-determine-class | |
5847 | (cons this-word (cdr (nth 3 where))) | |
5848 | 'pro))) | |
5849 | ((and (eq cw 'function) | |
5850 | (not (equal this-word "")) | |
5851 | (or (eq next-char ?\() ; exclude arrays, vars. | |
5852 | (looking-at "[a-zA-Z0-9_]*[ \t]*("))) | |
5853 | (setq this-word (idlwave-sintern-routine-or-method | |
5854 | this-word (nth 2 (nth 3 where)))) | |
5855 | (list this-word 'fun | |
5856 | (idlwave-determine-class | |
5857 | (cons this-word (cdr (nth 3 where))) | |
5858 | 'fun))) | |
5859 | ((and (memq cw '(function-keyword procedure-keyword)) | |
5860 | (not (equal this-word "")) | |
5861 | (eq next-char ?\()) ; A function! | |
5862 | (setq this-word (idlwave-sintern-routine this-word)) | |
5863 | (list this-word 'fun nil)) | |
5864 | (func | |
5865 | (list func 'fun (idlwave-determine-class (nth 1 where) 'fun))) | |
5866 | (pro | |
5867 | (list pro 'pro (idlwave-determine-class (nth 0 where) 'pro))) | |
5868 | (t nil))))) | |
f32b3b91 CD |
5869 | |
5870 | (defun idlwave-fix-keywords (name type class keywords) | |
5871 | ;; This fixes the list of keywords. | |
5872 | (let ((case-fold-search t) | |
5873 | name1 type1) | |
5874 | ||
5875 | ;; If this is the OBJ_NEW function, try to figure out the class and use | |
5876 | ;; the keywords from the corresponding INIT method. | |
5877 | (if (and (equal name "OBJ_NEW") | |
5878 | (eq major-mode 'idlwave-mode)) | |
5879 | (let* ((bos (save-excursion (idlwave-beginning-of-statement) (point))) | |
5880 | (string (buffer-substring bos (point))) | |
5881 | (case-fold-search t) | |
5882 | class) | |
5883 | (and (string-match "obj_new([^'\"]*['\"]\\([a-zA-Z0-9_]+\\)" | |
5884 | string) | |
5885 | (setq class (idlwave-sintern-class (match-string 1 string))) | |
15e42531 | 5886 | (setq idlwave-current-obj_new-class class) |
f32b3b91 CD |
5887 | (setq keywords |
5888 | (append keywords | |
5889 | (nth 5 (idlwave-rinfo-assq | |
5890 | (idlwave-sintern-method "INIT") | |
5891 | 'fun | |
5892 | class | |
5893 | (idlwave-routines)))))))) | |
5894 | ||
5895 | ;; If the class is `t', combine all keywords of all methods NAME | |
5896 | (when (eq class t) | |
5897 | (loop for x in (idlwave-routines) do | |
5898 | (and (nth 2 x) ; non-nil class | |
5899 | (or (and (eq (nth 1 x) type) ; default type | |
5900 | (eq (car x) name)) ; default name | |
5901 | (and (eq (nth 1 x) type1) ; backup type | |
5902 | (eq (car x) name1))) ; backup name | |
5903 | (mapcar (lambda (k) (add-to-list 'keywords k)) | |
5904 | (nth 5 x)))) | |
5905 | (setq keywords (idlwave-uniquify keywords))) | |
5906 | ;; Return the final list | |
5907 | keywords)) | |
5908 | ||
15e42531 CD |
5909 | (defun idlwave-expand-keyword (keyword module) |
5910 | "Expand KEYWORD to one of the legal keyword parameters of MODULE. | |
5911 | KEYWORD may be an exact match or an abbreviation of a keyword. | |
5912 | If the match is exact, KEYWORD itself is returned, even if there may be other | |
5913 | keywords of which KEYWORD is an abbreviation. This is necessary because some | |
5914 | system routines have keywords which are prefixes of other keywords. | |
5915 | If KEYWORD is an abbreviation of several keywords, a list of all possible | |
5916 | completions is returned. | |
5917 | If the abbreviation was unique, the correct keyword is returned. | |
5918 | If it cannot be a keyword, the function return nil. | |
5919 | If we do not know about MODULE, just return KEYWORD literally." | |
5920 | (let* ((name (car module)) | |
5921 | (type (nth 1 module)) | |
5922 | (class (nth 2 module)) | |
5923 | (kwd (idlwave-sintern-keyword keyword)) | |
5924 | (entry (idlwave-best-rinfo-assoc name type class (idlwave-routines))) | |
5925 | (kwd-alist (nth 5 entry)) | |
5926 | (extra (or (assq (idlwave-sintern-keyword "_EXTRA") kwd-alist) | |
5927 | (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) | |
5928 | (completion-ignore-case t) | |
5929 | candidates) | |
5930 | (cond ((assq kwd kwd-alist) | |
5931 | kwd) | |
5932 | ((setq candidates (all-completions kwd kwd-alist)) | |
5933 | (if (= (length candidates) 1) | |
5934 | (car candidates) | |
5935 | candidates)) | |
5936 | ((and entry extra) | |
5937 | ;; Inheritance may cause this keyword to be correct | |
5938 | keyword) | |
5939 | (entry | |
5940 | ;; We do know the function, which does not have the keyword. | |
5941 | nil) | |
5942 | (t | |
5943 | ;; We do not know the function, so this just might be a correct | |
5944 | ;; keyword - return it as it is. | |
5945 | keyword)))) | |
5946 | ||
5947 | (defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) | |
f32b3b91 | 5948 | (defvar idlwave-rinfo-map (make-sparse-keymap)) |
15e42531 | 5949 | (define-key idlwave-rinfo-mouse-map |
f32b3b91 CD |
5950 | (if (featurep 'xemacs) [button2] [mouse-2]) |
5951 | 'idlwave-mouse-active-rinfo) | |
15e42531 CD |
5952 | (define-key idlwave-rinfo-mouse-map |
5953 | (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) | |
5954 | 'idlwave-mouse-active-rinfo-shift) | |
5955 | (define-key idlwave-rinfo-mouse-map | |
f32b3b91 CD |
5956 | (if (featurep 'xemacs) [button3] [mouse-3]) |
5957 | 'idlwave-mouse-active-rinfo-right) | |
15e42531 CD |
5958 | (define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) |
5959 | (define-key idlwave-rinfo-map "q" 'idlwave-quit-help) | |
5960 | (define-key idlwave-rinfo-mouse-map "q" 'idlwave-quit-help) | |
5961 | (defvar idlwave-popup-source nil) | |
5962 | (defvar idlwave-rinfo-marker (make-marker)) | |
5963 | ||
5964 | (defun idlwave-quit-help () | |
5965 | (interactive) | |
5966 | (let ((ri-window (get-buffer-window "*Help*")) | |
5967 | (olh-window (get-buffer-window "*IDLWAVE Help*"))) | |
5968 | (when (and olh-window | |
5969 | (fboundp 'idlwave-help-quit)) | |
5970 | (select-window olh-window) | |
5971 | (idlwave-help-quit)) | |
5972 | (when (window-live-p ri-window) | |
5973 | (delete-window ri-window)))) | |
f32b3b91 CD |
5974 | |
5975 | (defun idlwave-display-calling-sequence (name type class) | |
5976 | ;; Display the calling sequence of module NAME, type TYPE in class CLASS. | |
15e42531 CD |
5977 | (let* ((entry (or (idlwave-best-rinfo-assq name type class |
5978 | (idlwave-routines)) | |
5979 | (idlwave-rinfo-assq name type class | |
5980 | idlwave-unresolved-routines))) | |
f32b3b91 CD |
5981 | (name (or (car entry) name)) |
5982 | (class (or (nth 2 entry) class)) | |
15e42531 CD |
5983 | (twins (idlwave-routine-twins entry)) |
5984 | (dtwins (idlwave-study-twins twins)) | |
5985 | (all dtwins) | |
5986 | (system (idlwave-rinfo-assq | |
5987 | name type class idlwave-system-routines)) | |
5988 | (have-sysdoc (and system (idlwave-help-directory))) | |
5989 | ;; (source (nth 3 entry)) | |
5990 | (have-olh (and (or system idlwave-extra-help-function) | |
5991 | (idlwave-help-directory))) | |
f32b3b91 CD |
5992 | (calling-seq (nth 4 entry)) |
5993 | (keywords (nth 5 entry)) | |
5994 | (olh (nth 6 entry)) | |
15e42531 CD |
5995 | (help-echo-kwd |
5996 | (if have-olh | |
5997 | "Button2: Insert KEYWORD (SHIFT=`/KEYWORD') Button3: Online Help " | |
5998 | "Button2: Insert KEYWORD (SHIFT=`/KEYWORD').")) | |
5999 | (help-echo-use | |
6000 | (if have-olh | |
6001 | "Button2/3: Online Help" | |
6002 | nil)) | |
6003 | (help-echo-src | |
6004 | (if (idlwave-help-directory) | |
6005 | "Button2: Pop to source and back. Button3: Source in Help window." | |
6006 | "Button2: Pop to source and back.")) | |
f32b3b91 CD |
6007 | (col 0) |
6008 | (data (list name type class (current-buffer) olh)) | |
6009 | (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) | |
15e42531 CD |
6010 | (face 'idlwave-help-link-face) |
6011 | beg props win cnt total) | |
f32b3b91 CD |
6012 | (setq keywords (idlwave-fix-keywords name type class keywords)) |
6013 | (cond | |
6014 | ((null entry) | |
6015 | (error "No %s %s known" type name)) | |
6016 | ((or (null name) (equal name "")) | |
6017 | (error "No function or procedure call at point.")) | |
6018 | ((null calling-seq) | |
6019 | (error "Calling sequence of %s %s is not available" type name)) | |
6020 | (t | |
6021 | (save-excursion | |
15e42531 | 6022 | (move-marker idlwave-rinfo-marker (point)) |
f32b3b91 | 6023 | (set-buffer (get-buffer-create "*Help*")) |
15e42531 | 6024 | (use-local-map idlwave-rinfo-map) |
f32b3b91 CD |
6025 | (setq buffer-read-only nil) |
6026 | (erase-buffer) | |
6027 | (set (make-local-variable 'idlwave-popup-source) nil) | |
15e42531 CD |
6028 | (set (make-local-variable 'idlwave-current-obj_new-class) |
6029 | idlwave-current-obj_new-class) | |
6030 | (setq props (if have-olh | |
6031 | (list 'mouse-face 'highlight | |
6032 | km-prop idlwave-rinfo-mouse-map | |
6033 | 'help-echo help-echo-use | |
6034 | 'data (cons 'usage data)))) | |
6035 | (if have-sysdoc (setq props (append (list 'face face) props))) | |
f32b3b91 CD |
6036 | (insert "Usage: ") |
6037 | (setq beg (point)) | |
6038 | (insert (if class | |
6039 | (format calling-seq class name) | |
6040 | (format calling-seq name)) | |
6041 | "\n") | |
6042 | (add-text-properties beg (point) props) | |
15e42531 | 6043 | |
f32b3b91 CD |
6044 | (insert "Keywords:") |
6045 | (if (null keywords) | |
6046 | (insert " No keywords accepted.") | |
6047 | (setq col 9) | |
6048 | (mapcar | |
6049 | (lambda (x) | |
6050 | (if (>= (+ col 1 (length (car x))) | |
6051 | (window-width)) | |
6052 | (progn | |
6053 | (insert "\n ") | |
6054 | (setq col 9))) | |
6055 | (insert " ") | |
6056 | (setq beg (point) | |
6057 | props (list 'mouse-face 'highlight | |
15e42531 | 6058 | km-prop idlwave-rinfo-mouse-map |
f32b3b91 | 6059 | 'data (cons 'keyword data) |
15e42531 | 6060 | 'help-echo help-echo-kwd |
f32b3b91 | 6061 | 'keyword (car x))) |
15e42531 | 6062 | (if have-sysdoc (setq props (append (list 'face face) props))) |
f32b3b91 CD |
6063 | (insert (car x)) |
6064 | (add-text-properties beg (point) props) | |
6065 | (setq col (+ col 1 (length (car x))))) | |
6066 | keywords)) | |
15e42531 CD |
6067 | |
6068 | (setq cnt 1 total (length all)) | |
6069 | (while (setq entry (pop all)) | |
6070 | (setq props (list 'mouse-face 'highlight | |
6071 | km-prop idlwave-rinfo-mouse-map | |
6072 | 'help-echo help-echo-src | |
6073 | 'source (cons (car (nth 2 entry)) (nth 1 entry)) | |
6074 | 'data (cons 'source data))) | |
6075 | (idlwave-insert-source-location | |
6076 | (format "\n%-8s %s" | |
6077 | (if (equal cnt 1) | |
6078 | (if (> total 1) "Sources:" "Source:") | |
6079 | "") | |
6080 | (if (> total 1) "- " "")) | |
6081 | entry props) | |
6082 | (incf cnt) | |
6083 | (when (and all (> cnt idlwave-rinfo-max-source-lines)) | |
6084 | ;; No more source lines, please | |
6085 | (insert (format | |
6086 | "\n Source information truncated to %d entries." | |
6087 | idlwave-rinfo-max-source-lines)) | |
6088 | (setq all nil))) | |
6089 | ||
f32b3b91 CD |
6090 | (setq buffer-read-only t)) |
6091 | (display-buffer "*Help*") | |
6092 | (if (and (setq win (get-buffer-window "*Help*")) | |
6093 | idlwave-resize-routine-help-window) | |
6094 | (progn | |
6095 | (let ((ww (selected-window))) | |
6096 | (unwind-protect | |
6097 | (progn | |
6098 | (select-window win) | |
6099 | (enlarge-window (- (/ (frame-height) 2) | |
6100 | (window-height))) | |
6101 | (shrink-window-if-larger-than-buffer)) | |
6102 | (select-window ww))))))))) | |
6103 | ||
15e42531 CD |
6104 | (defun idlwave-insert-source-location (prefix entry &optional file-props) |
6105 | "Insert a source location into the routine info buffer. | |
6106 | Start line with PREFIX. | |
6107 | If a file name is inserted, add FILE-PROPS to it." | |
6108 | ||
6109 | (let* ((key (car entry)) | |
6110 | (file (nth 1 entry)) | |
6111 | (types (nth 2 entry)) | |
6112 | (shell-flag (member 'compiled types)) | |
6113 | (buffer-flag (member 'buffer types)) | |
6114 | (lib-flag (member 'lib types)) | |
6115 | (ndupl (or (and buffer-flag (idlwave-count-eq 'buffer types)) | |
6116 | (and lib-flag (idlwave-count-eq 'lib types)) | |
6117 | 1)) | |
6118 | (doflags t) | |
6119 | beg special) | |
6120 | ||
6121 | (insert prefix) | |
6122 | ||
6123 | (cond | |
6124 | ((eq key 'system) | |
6125 | (setq doflags nil) | |
6126 | (insert "System ")) | |
6127 | ((eq key 'builtin) | |
6128 | (setq doflags nil) | |
6129 | (insert "Builtin ")) | |
6130 | ((and (not file) shell-flag) | |
6131 | (insert "Unresolved")) | |
6132 | ((null file) (insert "ERROR")) | |
6133 | ((setq special (idlwave-special-lib-test file)) | |
6134 | (insert (format "%-10s" special))) | |
6135 | ((idlwave-syslib-p file) | |
6136 | (if (string-match "obsolete" (file-name-directory file)) | |
6137 | (insert "Obsolete ") | |
6138 | (insert "SystemLib "))) | |
6139 | ((idlwave-lib-p file) (insert "Library ")) | |
6140 | (t (insert "Other "))) | |
6141 | ||
6142 | (when doflags | |
6143 | (insert (concat | |
6144 | " [" | |
6145 | (if lib-flag "C" "-") | |
6146 | (if shell-flag "S" "-") | |
6147 | (if buffer-flag "B" "-") | |
6148 | "] "))) | |
6149 | (when (> ndupl 1) | |
6150 | (setq beg (point)) | |
6151 | (insert (format "(%dx) " ndupl)) | |
6152 | (add-text-properties beg (point) (list 'face 'bold))) | |
6153 | (when (and file (not (equal file ""))) | |
6154 | (setq beg (point)) | |
6155 | (insert (apply 'abbreviate-file-name | |
6156 | (if (featurep 'xemacs) (list file t) (list file)))) | |
6157 | (if file-props | |
6158 | (add-text-properties beg (point) file-props))))) | |
6159 | ||
6160 | (defun idlwave-special-lib-test (file) | |
6161 | "Check the path of FILE against the regexps which define special libs. | |
6162 | Return the name of the special lib if there is a match." | |
6163 | (let ((alist idlwave-special-lib-alist) | |
6164 | entry rtn) | |
6165 | (cond | |
6166 | ((stringp file) | |
6167 | (while (setq entry (pop alist)) | |
6168 | (if (string-match (car entry) file) | |
6169 | (setq rtn (cdr entry) | |
6170 | alist nil))) | |
6171 | rtn) | |
6172 | (t nil)))) | |
6173 | ||
f32b3b91 CD |
6174 | (defun idlwave-mouse-active-rinfo-right (ev) |
6175 | (interactive "e") | |
6176 | (idlwave-mouse-active-rinfo ev 'right)) | |
6177 | ||
15e42531 | 6178 | (defun idlwave-mouse-active-rinfo-shift (ev) |
f32b3b91 | 6179 | (interactive "e") |
15e42531 CD |
6180 | (idlwave-mouse-active-rinfo ev nil 'shift)) |
6181 | ||
6182 | (defun idlwave-active-rinfo-space () | |
6183 | (interactive) | |
6184 | (idlwave-mouse-active-rinfo nil 'right)) | |
6185 | ||
6186 | (defun idlwave-mouse-active-rinfo (ev &optional right shift) | |
6187 | "Does the mouse actions in the routine info buffer. | |
6188 | Optional args RIGHT and SHIFT indicate, if mouse-3 was used, and if SHIFT | |
6189 | was pressed." | |
6190 | (interactive "e") | |
6191 | (if ev (mouse-set-point ev)) | |
6192 | (let (data id name type class buf keyword bufwin source) | |
f32b3b91 | 6193 | (setq data (get-text-property (point) 'data) |
15e42531 | 6194 | source (get-text-property (point) 'source) |
f32b3b91 CD |
6195 | keyword (get-text-property (point) 'keyword) |
6196 | id (car data) | |
15e42531 | 6197 | name (nth 1 data) type (nth 2 data) class (nth 3 data) |
f32b3b91 | 6198 | buf (nth 4 data) |
f32b3b91 | 6199 | bufwin (get-buffer-window buf t)) |
15e42531 CD |
6200 | (cond ((eq id 'usage) |
6201 | (idlwave-require-online-help) | |
6202 | (idlwave-online-help nil name type class)) | |
6203 | ((eq id 'source) | |
6204 | (if (and right (idlwave-help-directory)) | |
6205 | (let ((idlwave-extra-help-function 'idlwave-help-with-source) | |
6206 | (idlwave-help-source-try-header nil) | |
6207 | ;; Fake idlwave-routines, to make help find the right entry | |
6208 | (idlwave-routines | |
6209 | (list (list (nth 1 data) (nth 2 data) (nth 3 data) source "")))) | |
6210 | (idlwave-require-online-help) | |
6211 | (idlwave-help-get-special-help name type class nil)) | |
f32b3b91 CD |
6212 | (setq idlwave-popup-source (not idlwave-popup-source)) |
6213 | (if idlwave-popup-source | |
6214 | (condition-case err | |
15e42531 | 6215 | (idlwave-do-find-module name type class source) |
f32b3b91 CD |
6216 | (error |
6217 | (setq idlwave-popup-source nil) | |
6218 | (if (window-live-p bufwin) (select-window bufwin)) | |
6219 | (error (nth 1 err)))) | |
6220 | (if bufwin | |
6221 | (select-window bufwin) | |
15e42531 CD |
6222 | (pop-to-buffer buf)) |
6223 | (goto-char (marker-position idlwave-rinfo-marker))))) | |
f32b3b91 CD |
6224 | ((eq id 'keyword) |
6225 | (if right | |
15e42531 CD |
6226 | (progn |
6227 | (idlwave-require-online-help) | |
6228 | (idlwave-online-help nil name type class keyword)) | |
6229 | (idlwave-rinfo-insert-keyword keyword buf shift)))))) | |
6230 | ||
6231 | (defun idlwave-rinfo-insert-keyword (keyword buffer &optional shift) | |
6232 | "Insert KEYWORD in BUFFER. Make sure buffer is displayed in a window." | |
6233 | (let ((bwin (get-buffer-window buffer))) | |
6234 | (if idlwave-complete-empty-string-as-lower-case | |
6235 | (setq keyword (downcase keyword))) | |
6236 | (if bwin | |
6237 | (select-window bwin) | |
6238 | (pop-to-buffer buffer) | |
6239 | (setq bwin (get-buffer-window buffer))) | |
6240 | (if (eq (preceding-char) ?/) | |
6241 | (insert keyword) | |
6242 | (unless (save-excursion | |
6243 | (re-search-backward | |
6244 | "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" | |
6245 | (min (- (point) 100) (point-min)) t)) | |
6246 | (insert ", ")) | |
6247 | (if shift (insert "/")) | |
6248 | (insert keyword) | |
6249 | (if (and (not shift) | |
6250 | idlwave-keyword-completion-adds-equal) | |
6251 | (insert "="))))) | |
6252 | ||
6253 | (defun idlwave-list-buffer-load-path-shadows (&optional arg) | |
6254 | "List the load path shadows of all routines defined in current buffer." | |
6255 | (interactive "P") | |
6256 | (idlwave-routines) | |
6257 | (if (eq major-mode 'idlwave-mode) | |
6258 | (idlwave-list-load-path-shadows | |
6259 | nil (idlwave-update-current-buffer-info 'save-buffer) | |
6260 | "in current buffer") | |
6261 | (error "Current buffer is not in idlwave-mode"))) | |
6262 | ||
6263 | (defun idlwave-list-shell-load-path-shadows (&optional arg) | |
6264 | "List the load path shadows of all routines compiled under the shell. | |
6265 | This is very useful for checking an IDL application. Just compile the | |
6266 | application, do RESOLVE_ALL, and `C-c C-i' to compile all referenced | |
6267 | routines and update IDLWAVE internal info. Then check for shadowing | |
6268 | with this command." | |
6269 | (interactive "P") | |
6270 | (cond | |
6271 | ((or (not (fboundp 'idlwave-shell-is-running)) | |
6272 | (not (idlwave-shell-is-running))) | |
6273 | (error "Shell is not running")) | |
6274 | ((null idlwave-compiled-routines) | |
6275 | (error "No compiled routines. Maybe you need to update with `C-c C-i'.")) | |
6276 | (t | |
6277 | (idlwave-list-load-path-shadows nil idlwave-compiled-routines | |
6278 | "in the shell")))) | |
6279 | ||
6280 | (defun idlwave-list-all-load-path-shadows (&optional arg) | |
6281 | "List the load path shadows of all routines known to IDLWAVE." | |
6282 | (interactive "P") | |
6283 | (idlwave-list-load-path-shadows nil nil "globally")) | |
6284 | ||
6285 | (defun idlwave-list-load-path-shadows (arg &optional special-routines loc) | |
6286 | "List the routines which are defined multiple times. | |
6287 | Search the information IDLWAVE has about IDL routines for multiple | |
6288 | definitions. | |
6289 | When SPECIAL-ROUTINES in non-nil, only look for shadows of these routines. | |
6290 | ||
6291 | When IDL hits a routine call which is not defined, it will search on | |
6292 | the load path in order to find a definition. The output of this | |
6293 | command can be used to detect possible name clashes during this process." | |
6294 | (idlwave-routines) ; Make sure everything is loaded. | |
6295 | (unless idlwave-library-routines | |
6296 | (or (y-or-n-p | |
6297 | "You don't have a library catalog. Continue anyway? ") | |
6298 | (error "Abort"))) | |
6299 | (let* ((routines (append idlwave-system-routines | |
6300 | idlwave-compiled-routines | |
6301 | idlwave-library-routines | |
6302 | idlwave-buffer-routines | |
6303 | nil)) | |
6304 | (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) | |
6305 | (keymap (make-sparse-keymap)) | |
6306 | (props (list 'mouse-face 'highlight | |
6307 | km-prop keymap | |
6308 | 'help-echo "Mouse2: Find source")) | |
6309 | (nroutines (length (or special-routines routines))) | |
6310 | (step (/ nroutines 99)) | |
6311 | (n 0) | |
6312 | (next-perc 1) | |
6313 | (cnt 0) | |
6314 | (idlwave-sort-prefer-buffer-info nil) | |
6315 | routine twins dtwins twin done props1 lroutines) | |
6316 | ||
6317 | (if special-routines | |
6318 | ;; Just looking for shadows of a few special routines | |
6319 | (setq lroutines routines | |
6320 | routines special-routines)) | |
6321 | ||
6322 | (message "Sorting routines...") | |
6323 | (setq routines (sort routines | |
6324 | (lambda (a b) | |
6325 | (string< (downcase (idlwave-make-full-name | |
6326 | (nth 2 a) (car a))) | |
6327 | (downcase (idlwave-make-full-name | |
6328 | (nth 2 b) (car b))))))) | |
6329 | (message "Sorting routines...done") | |
6330 | ||
6331 | (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) | |
6332 | (lambda (ev) | |
6333 | (interactive "e") | |
6334 | (mouse-set-point ev) | |
6335 | (apply 'idlwave-do-find-module | |
6336 | (get-text-property (point) 'find-args)))) | |
6337 | (define-key keymap [(return)] | |
6338 | (lambda () | |
6339 | (interactive) | |
6340 | (apply 'idlwave-do-find-module | |
6341 | (get-text-property (point) 'find-args)))) | |
6342 | (message "Compiling list...( 0%%)") | |
6343 | (save-excursion | |
6344 | (set-buffer (get-buffer-create "*Shadows*")) | |
6345 | (setq buffer-read-only nil) | |
6346 | (erase-buffer) | |
6347 | (while (setq routine (pop routines)) | |
6348 | (setq n (1+ n)) | |
6349 | (if (= (* next-perc step) n) | |
6350 | (progn | |
6351 | (message "Compiling list...(%2d%%)" next-perc) | |
6352 | (setq next-perc (1+ next-perc)))) | |
6353 | ;; Get a list of all twins | |
6354 | (setq twins (idlwave-routine-twins routine (or lroutines routines))) | |
6355 | (if (memq routine done) | |
6356 | (setq dtwins nil) | |
6357 | (setq dtwins (idlwave-study-twins twins))) | |
6358 | ;; Mark all twins as delt with | |
6359 | (setq done (append twins done)) | |
6360 | (when (or (> (length dtwins) 1) | |
6361 | (> (idlwave-count-eq 'lib (nth 2 (car dtwins))) 1) | |
6362 | (> (idlwave-count-eq 'buffer (nth 2 (car dtwins))) 1)) | |
6363 | (incf cnt) | |
6364 | (insert (format "\n%s%s" | |
6365 | (idlwave-make-full-name (nth 2 routine) (car routine)) | |
6366 | (if (eq (nth 1 routine) 'fun) "()" ""))) | |
6367 | (while (setq twin (pop dtwins)) | |
6368 | (setq props1 (append (list 'find-args | |
6369 | (list (nth 0 routine) | |
6370 | (nth 1 routine) | |
6371 | (nth 2 routine) | |
6372 | (cons 'lib (nth 1 twin)))) | |
6373 | props)) | |
6374 | (idlwave-insert-source-location "\n - " twin props1)))) | |
6375 | (goto-char (point-min)) | |
6376 | (setq buffer-read-only t)) | |
6377 | (setq loc (or loc "")) | |
6378 | (if (> cnt 0) | |
6379 | (progn | |
6380 | (display-buffer (get-buffer "*Shadows*")) | |
6381 | (message "%d case%s of shadowing found %s" | |
6382 | cnt (if (= cnt 1) "" "s") loc)) | |
6383 | (message "No shadowing conflicts found %s" loc)))) | |
6384 | ||
6385 | (defun idlwave-print-source (routine) | |
6386 | (let* ((source (nth 3 routine)) | |
6387 | (stype (car source)) | |
6388 | (sfile (cdr source))) | |
6389 | (if (and (eq stype 'lib) sfile) | |
6390 | (progn | |
6391 | (setq sfile (idlwave-expand-lib-file-name sfile)) | |
6392 | (if (idlwave-syslib-p sfile) (setq stype 'syslib)))) | |
6393 | (if (and (eq stype 'compiled) | |
6394 | (or (not (stringp sfile)) | |
6395 | (not (string-match "\\S-" sfile)))) | |
6396 | (setq stype 'unresolved)) | |
6397 | (princ (format " %-10s %s\n" | |
6398 | stype | |
6399 | (if sfile sfile "No source code available"))))) | |
6400 | ||
6401 | (defun idlwave-routine-twins (entry &optional list) | |
6402 | "Return all twin entries of ENTRY in LIST. | |
6403 | LIST defaults to `idlwave-routines'. | |
6404 | Twin entries are those which have the same name, type, and class. | |
6405 | ENTRY will also be returned, as the first item of this list." | |
6406 | (let* ((name (car entry)) | |
6407 | (type (nth 1 entry)) | |
6408 | (class (nth 2 entry)) | |
6409 | (candidates (idlwave-all-assq name (or list (idlwave-routines)))) | |
6410 | twins candidate) | |
6411 | (while (setq candidate (pop candidates)) | |
6412 | (if (and (not (eq candidate entry)) | |
6413 | (eq type (nth 1 candidate)) | |
6414 | (eq class (nth 2 candidate))) | |
6415 | (push candidate twins))) | |
6416 | (if (setq candidate (idlwave-rinfo-assq name type class | |
6417 | idlwave-unresolved-routines)) | |
6418 | (push candidate twins)) | |
6419 | (cons entry (nreverse twins)))) | |
6420 | ||
6421 | (defun idlwave-study-twins (entries) | |
6422 | "Return dangerous twins of first entry in TWINS. | |
6423 | Dangerous twins are routines with same name, but in different files | |
6424 | on the load path. | |
6425 | If a file is in the system library and has an entry in the | |
6426 | `idlwave-system-routines' list, we omit the latter because many IDL | |
6427 | routines are implemented as library routines." | |
6428 | (let* ((entry (car entries)) | |
6429 | (name (car entry)) ; | |
6430 | (type (nth 1 entry)) ; Must be bound for | |
6431 | (class (nth 2 entry)) ; idlwave-routine-twin-compare | |
6432 | (cnt 0) | |
6433 | source type file thefile alist syslibp key) | |
6434 | (while (setq entry (pop entries)) | |
6435 | (incf cnt) | |
6436 | (setq source (nth 3 entry) | |
6437 | type (car source) | |
6438 | file (cdr source)) | |
6439 | (if (eq type 'lib) | |
6440 | (setq file (idlwave-expand-lib-file-name file))) | |
6441 | ;; Make KEY to index entry properly | |
6442 | (setq key (cond ((eq type 'system) type) | |
6443 | (file (file-truename file)) | |
6444 | (t 'unresolved))) | |
6445 | (if (and file | |
6446 | (not syslibp) | |
6447 | (idlwave-syslib-p file)) | |
6448 | ;; We do have an entry in the system library | |
6449 | (setq syslibp t)) | |
6450 | ||
6451 | (setq thefile (or thefile file)) | |
6452 | (if (setq entry (assoc key alist)) | |
6453 | (push type (nth 2 entry)) | |
6454 | (push (list key file (list type)) alist))) | |
6455 | ||
6456 | (setq alist (nreverse alist)) | |
6457 | ||
6458 | (when syslibp | |
6459 | ;; File is system *library* - remove any system entry | |
6460 | (setq alist (delq (assoc 'system alist) alist))) | |
6461 | ||
6462 | (when (and (idlwave-syslib-scanned-p) | |
6463 | (setq entry (assoc 'system alist))) | |
6464 | (setcar entry 'builtin)) | |
6465 | (sort alist 'idlwave-routine-twin-compare))) | |
6466 | ||
6467 | (defvar name) | |
6468 | (defvar type) | |
6469 | (defvar class) | |
6470 | (defvar idlwave-sort-prefer-buffer-info t | |
6471 | "Internal variable used to influence `idlwave-routine-twin-compare'.") | |
6472 | ||
6473 | (defmacro idlwave-xor (a b) | |
6474 | `(and (or ,a ,b) | |
6475 | (not (and ,a ,b)))) | |
6476 | ||
6477 | (defun idlwave-routine-entry-compare (a b) | |
6478 | "Compare two routine info entries for sortiung. This is the general case. | |
6479 | It first compates class, names, and type. If it turns out that A and B | |
6480 | are twins (same name, class, and type), calls another routine which | |
6481 | compares twins on the basis of their file names and path locations." | |
6482 | (let ((name (car a)) (type (nth 1 a)) (class (nth 2 a))) | |
6483 | (cond | |
6484 | ((not (equal (idlwave-downcase-safe class) | |
6485 | (idlwave-downcase-safe (nth 2 b)))) | |
6486 | ;; Class decides | |
6487 | (cond ((null (nth 2 b)) nil) | |
6488 | ((null class) t) | |
6489 | (t (string< (downcase class) (downcase (nth 2 b)))))) | |
6490 | ((not (equal (downcase name) (downcase (car b)))) | |
6491 | ;; Name decides | |
6492 | (string< (downcase name) (downcase (car b)))) | |
6493 | ((not (eq type (nth 1 b))) | |
6494 | ;; Type decides | |
6495 | (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) | |
6496 | (t | |
6497 | ;; A and B are twins - so the decision is more complicated. | |
6498 | ;; Call twin-compare with the proper arguments. | |
6499 | (idlwave-routine-entry-compare-twins a b))))) | |
6500 | ||
6501 | (defun idlwave-routine-entry-compare-twins (a b) | |
6502 | "Compare two routine entries, under the assumption that they are twins. | |
6503 | This basically calles `idlwave-routine-twin-compare' with the correct args." | |
6504 | (let ((name (car a)) (type (nth 1 a)) (class (nth 2 a)) ; needed outside | |
6505 | (atype (car (nth 3 a))) | |
6506 | (btype (car (nth 3 b))) | |
6507 | (afile (cdr (nth 3 a))) | |
6508 | (bfile (cdr (nth 3 b)))) | |
6509 | (if (eq atype 'lib) | |
6510 | (setq afile (idlwave-expand-lib-file-name afile))) | |
6511 | (if (eq btype 'lib) | |
6512 | (setq bfile (idlwave-expand-lib-file-name bfile))) | |
6513 | (idlwave-routine-twin-compare | |
6514 | (if (stringp afile) | |
6515 | (list (file-truename afile) afile (list atype)) | |
6516 | (list atype afile (list atype))) | |
6517 | (if (stringp bfile) | |
6518 | (list (file-truename bfile) bfile (list btype)) | |
6519 | (list btype bfile (list btype)))) | |
6520 | )) | |
6521 | ||
6522 | (defun idlwave-routine-twin-compare (a b) | |
6523 | "Compare two routine twin entries for sorting. | |
6524 | In here, A and B are not normal routine info entries, but special | |
6525 | lists (KEY FILENAME (TYPES...)). | |
6526 | This expects NAME TYPE CLASS to be bound to the right values." | |
6527 | (let* (;; Dis-assemble entries | |
6528 | (akey (car a)) (bkey (car b)) | |
6529 | (afile (nth 1 a)) (bfile (nth 1 b)) | |
6530 | (atypes (nth 2 a)) (btypes (nth 2 b)) | |
6531 | ;; System routines? | |
6532 | (asysp (memq akey '(builtin system))) | |
6533 | (bsysp (memq bkey '(builtin system))) | |
6534 | ;; Compiled routines? | |
6535 | (acompp (memq 'compiled atypes)) | |
6536 | (bcompp (memq 'compiled btypes)) | |
6537 | ;; Unresolved? | |
6538 | (aunresp (or (eq akey 'unresolved) | |
6539 | (and acompp (not afile)))) | |
6540 | (bunresp (or (eq bkey 'unresolved) | |
6541 | (and bcompp (not bfile)))) | |
6542 | ;; Buffer info available? | |
6543 | (abufp (memq 'buffer atypes)) | |
6544 | (bbufp (memq 'buffer btypes)) | |
6545 | ;; On search path? | |
6546 | (tpath-alist (idlwave-true-path-alist)) | |
6547 | (apathp (assoc akey tpath-alist)) | |
6548 | (bpathp (assoc bkey tpath-alist)) | |
6549 | ;; How early on search path? High number means early since we | |
6550 | ;; measure the tail of the path list | |
6551 | (anpath (length (memq apathp tpath-alist))) | |
6552 | (bnpath (length (memq bpathp tpath-alist))) | |
6553 | ;; Look at file names | |
6554 | (aname (if (stringp afile) (downcase (file-name-nondirectory afile)) "")) | |
6555 | (bname (if (stringp bfile) (downcase (file-name-nondirectory bfile)) "")) | |
6556 | (fname-re (if class (format "\\`%s__\\(%s\\|define\\)\\.pro\\'" | |
6557 | (regexp-quote (downcase class)) | |
6558 | (regexp-quote (downcase name))) | |
6559 | (format "\\`%s\\.pro" (regexp-quote (downcase name))))) | |
6560 | ;; Is file name derived from the routine name? | |
6561 | ;; Method file or class definition file? | |
6562 | (anamep (string-match fname-re aname)) | |
6563 | (adefp (and class anamep (string= "define" (match-string 1 aname)))) | |
6564 | (bnamep (string-match fname-re bname)) | |
6565 | (bdefp (and class bnamep (string= "define" (match-string 1 bname))))) | |
6566 | ||
6567 | ;; Now: follow JD's ideas about sorting. Looks really simple now, | |
6568 | ;; doesn't it? The difficult stuff is hidden above... | |
6569 | (cond | |
6570 | ((idlwave-xor asysp bsysp) asysp) ; System entries first | |
6571 | ((idlwave-xor aunresp bunresp) bunresp) ; Unresolved last | |
6572 | ((and idlwave-sort-prefer-buffer-info | |
6573 | (idlwave-xor abufp bbufp)) abufp) ; Buffers before non-buffers | |
6574 | ((idlwave-xor acompp bcompp) acompp) ; Compiled entries | |
6575 | ((idlwave-xor apathp bpathp) apathp) ; Library before non-library | |
6576 | ((idlwave-xor anamep bnamep) anamep) ; Correct file names first | |
6577 | ((and class anamep bnamep ; both file names match -> | |
6578 | (idlwave-xor adefp bdefp)) bdefp) ; __define after __method | |
6579 | ((> anpath bnpath) t) ; Who is first on path? | |
6580 | (t nil)))) ; Default | |
6581 | ||
6582 | (defun idlwave-downcase-safe (string) | |
6583 | "Donwcase if string, else return unchanged." | |
6584 | (if (stringp string) | |
6585 | (downcase string) | |
6586 | string)) | |
6587 | ||
6588 | (defun idlwave-count-eq (elt list) | |
6589 | "How often is ELT in LIST?" | |
6590 | (length (delq nil (mapcar (lambda (x) (eq x elt)) list)))) | |
6591 | ||
6592 | (defun idlwave-syslib-p (file) | |
6593 | "Non-nil of FILE is in the system library." | |
6594 | (let* ((true-syslib (file-name-as-directory | |
6595 | (file-truename | |
6596 | (expand-file-name "lib" (idlwave-sys-dir))))) | |
6597 | (true-file (file-truename file))) | |
6598 | (string-match (concat "^" (regexp-quote true-syslib)) true-file))) | |
6599 | ||
6600 | (defun idlwave-lib-p (file) | |
6601 | "Non-nil if file is in the library" | |
6602 | (let ((true-dir (file-name-directory (file-truename file)))) | |
6603 | (assoc true-dir (idlwave-true-path-alist)))) | |
6604 | ||
6605 | (defun idlwave-true-path-alist () | |
6606 | "Return `idlwave-path-alist' alist with true-names. | |
6607 | Info is cached, but relies on the functons setting `idlwave-path-alist' | |
6608 | to reset the variable `idlwave-true-path-alist' to nil." | |
6609 | (or idlwave-true-path-alist | |
6610 | (setq idlwave-true-path-alist | |
6611 | (mapcar (lambda(x) (cons | |
6612 | (file-name-as-directory | |
6613 | (file-truename | |
6614 | (directory-file-name | |
6615 | (car x)))) | |
6616 | (cdr x))) | |
6617 | idlwave-path-alist)))) | |
6618 | ||
6619 | (defun idlwave-syslib-scanned-p () | |
6620 | "Non-nil if the system lib file !DIR/lib has been scanned." | |
6621 | (let* ((true-syslib (file-name-as-directory | |
6622 | (file-truename | |
6623 | (expand-file-name "lib" (idlwave-sys-dir)))))) | |
6624 | (cdr (assoc true-syslib (idlwave-true-path-alist))))) | |
6625 | ||
6626 | ;; ---------------------------------------------------------------------------- | |
6627 | ;; | |
6628 | ;; Online Help display | |
6629 | ||
f32b3b91 CD |
6630 | |
6631 | ;; ---------------------------------------------------------------------------- | |
6632 | ;; | |
6633 | ;; Additions for use with imenu.el and func-menu.el | |
6634 | ;; (pop-up a list of IDL units in the current file). | |
6635 | ;; | |
6636 | ||
6637 | (defun idlwave-prev-index-position () | |
6638 | "Search for the previous procedure or function. | |
6639 | Return nil if not found. For use with imenu.el." | |
6640 | (save-match-data | |
6641 | (cond | |
6642 | ((idlwave-find-key "\\<\\(pro\\|function\\)\\>" -1 'nomark)) | |
6643 | ;; ((idlwave-find-key idlwave-begin-unit-reg 1 'nomark) | |
6644 | (t nil)))) | |
6645 | ||
6646 | (defun idlwave-unit-name () | |
6647 | "Return the unit name. | |
6648 | Assumes that point is at the beginning of the unit as found by | |
6649 | `idlwave-prev-index-position'." | |
6650 | (forward-sexp 2) | |
6651 | (forward-sexp -1) | |
6652 | (let ((begin (point))) | |
6653 | (re-search-forward "[a-zA-Z][a-zA-Z0-9$_]+\\(::[a-zA-Z][a-zA-Z0-9$_]+\\)?") | |
6654 | (if (fboundp 'buffer-substring-no-properties) | |
6655 | (buffer-substring-no-properties begin (point)) | |
6656 | (buffer-substring begin (point))))) | |
6657 | ||
6658 | (defun idlwave-function-menu () | |
6659 | "Use `imenu' or `function-menu' to jump to a procedure or function." | |
6660 | (interactive) | |
6661 | (if (string-match "XEmacs" emacs-version) | |
6662 | (progn | |
6663 | (require 'func-menu) | |
6664 | (function-menu)) | |
6665 | (require 'imenu) | |
6666 | (imenu (imenu-choose-buffer-index)))) | |
6667 | ||
6668 | ;; Here we kack func-menu.el in order to support this new mode. | |
6669 | ;; The latest versions of func-menu.el already have this stuff in, so | |
6670 | ;; we hack only if it is not already there. | |
6671 | (when (fboundp 'eval-after-load) | |
6672 | (eval-after-load "func-menu" | |
6673 | '(progn | |
6674 | (or (assq 'idlwave-mode fume-function-name-regexp-alist) | |
6675 | (not (boundp 'fume-function-name-regexp-idl)) ; avoid problems | |
6676 | (setq fume-function-name-regexp-alist | |
6677 | (cons '(idlwave-mode . fume-function-name-regexp-idl) | |
6678 | fume-function-name-regexp-alist))) | |
6679 | (or (assq 'idlwave-mode fume-find-function-name-method-alist) | |
6680 | (not (fboundp 'fume-find-next-idl-function-name)) ; avoid problems | |
6681 | (setq fume-find-function-name-method-alist | |
6682 | (cons '(idlwave-mode . fume-find-next-idl-function-name) | |
6683 | fume-find-function-name-method-alist)))))) | |
6684 | ||
6685 | (defun idlwave-edit-in-idlde () | |
6686 | "Edit the current file in IDL Development environment." | |
6687 | (interactive) | |
6688 | (start-process "idldeclient" nil | |
6689 | idlwave-shell-explicit-file-name "-c" "-e" | |
6690 | (buffer-file-name) "&")) | |
6691 | ||
6692 | (defun idlwave-launch-idlhelp () | |
6693 | "Start the IDLhelp application." | |
6694 | (interactive) | |
6695 | (start-process "idlhelp" nil idlwave-help-application)) | |
6696 | ||
6697 | ;; Menus - using easymenu.el | |
6698 | (defvar idlwave-mode-menu-def | |
6699 | `("IDLWAVE" | |
6700 | ["PRO/FUNC menu" idlwave-function-menu t] | |
6701 | ("Motion" | |
6702 | ["Subprogram Start" idlwave-beginning-of-subprogram t] | |
6703 | ["Subprogram End" idlwave-end-of-subprogram t] | |
6704 | ["Block Start" idlwave-beginning-of-block t] | |
6705 | ["Block End" idlwave-end-of-block t] | |
6706 | ["Up Block" idlwave-backward-up-block t] | |
6707 | ["Down Block" idlwave-down-block t] | |
6708 | ["Skip Block Backward" idlwave-backward-block t] | |
6709 | ["Skip Block Forward" idlwave-forward-block t]) | |
6710 | ("Mark" | |
6711 | ["Subprogram" idlwave-mark-subprogram t] | |
6712 | ["Block" idlwave-mark-block t] | |
6713 | ["Header" idlwave-mark-doclib t]) | |
6714 | ("Format" | |
6715 | ["Indent Subprogram" idlwave-indent-subprogram t] | |
6716 | ["(Un)Comment Region" idlwave-toggle-comment-region "C-c ;"] | |
6717 | ["Continue/Split line" idlwave-split-line t] | |
6718 | "--" | |
6719 | ["Toggle Auto Fill" idlwave-auto-fill-mode :style toggle | |
6720 | :selected (symbol-value idlwave-fill-function)]) | |
6721 | ("Templates" | |
6722 | ["Procedure" idlwave-procedure t] | |
6723 | ["Function" idlwave-function t] | |
6724 | ["Doc Header" idlwave-doc-header t] | |
6725 | ["Log" idlwave-doc-modification t] | |
6726 | "--" | |
6727 | ["Case" idlwave-case t] | |
6728 | ["For" idlwave-for t] | |
6729 | ["Repeat" idlwave-repeat t] | |
6730 | ["While" idlwave-while t] | |
6731 | "--" | |
6732 | ["Close Block" idlwave-close-block t]) | |
15e42531 | 6733 | ("Completion" |
f32b3b91 CD |
6734 | ["Complete" idlwave-complete t] |
6735 | ("Complete Special" | |
6736 | ["1 Procedure Name" (idlwave-complete 'procedure) t] | |
6737 | ["2 Procedure Keyword" (idlwave-complete 'procedure-keyword) t] | |
6738 | "--" | |
6739 | ["3 Function Name" (idlwave-complete 'function) t] | |
6740 | ["4 Function Keyword" (idlwave-complete 'function-keyword) t] | |
6741 | "--" | |
6742 | ["5 Procedure Method Name" (idlwave-complete 'procedure-method) t] | |
6743 | ["6 Procedure Method Keyword" (idlwave-complete 'procedure-method-keyword) t] | |
6744 | "--" | |
6745 | ["7 Function Method Name" (idlwave-complete 'function-method) t] | |
6746 | ["8 Function Method Keyword" (idlwave-complete 'function-method-keyword) t] | |
6747 | "--" | |
15e42531 CD |
6748 | ["9 Class Name" idlwave-complete-class t])) |
6749 | ("Routine Info" | |
f32b3b91 | 6750 | ["Show Routine Info" idlwave-routine-info t] |
15e42531 | 6751 | ["Online Context Help" idlwave-context-help (idlwave-help-directory)] |
f32b3b91 CD |
6752 | "--" |
6753 | ["Find Routine Source" idlwave-find-module t] | |
15e42531 | 6754 | ["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)] |
f32b3b91 CD |
6755 | "--" |
6756 | ["Update Routine Info" idlwave-update-routine-info t] | |
6757 | "--" | |
15e42531 CD |
6758 | "IDL Library Catalog" |
6759 | ["Select Catalog Directories" idlwave-create-libinfo-file t] | |
6760 | ["Scan Directories" (idlwave-update-routine-info '(16)) | |
6761 | idlwave-path-alist] | |
6762 | "--" | |
6763 | "Routine Shadows" | |
6764 | ["Check Current Buffer" idlwave-list-buffer-load-path-shadows t] | |
6765 | ["Check Compiled Routines" idlwave-list-shell-load-path-shadows t] | |
6766 | ["Check Everything" idlwave-list-all-load-path-shadows t]) | |
6767 | ("Misc" | |
6768 | ["Kill auto-created buffers" idlwave-kill-autoloaded-buffers t] | |
6769 | "--" | |
6770 | ["Insert TAB character" idlwave-hard-tab t]) | |
f32b3b91 CD |
6771 | "--" |
6772 | ("External" | |
6773 | ["Generate IDL tags" idlwave-make-tags t] | |
6774 | ["Start IDL shell" idlwave-shell t] | |
6775 | ["Edit file in IDLDE" idlwave-edit-in-idlde t] | |
6776 | ["Launch IDL Help" idlwave-launch-idlhelp t]) | |
6777 | "--" | |
6778 | ("Customize" | |
6779 | ["Browse IDLWAVE Group" idlwave-customize t] | |
6780 | "--" | |
6781 | ["Build Full Customize Menu" idlwave-create-customize-menu | |
6782 | (fboundp 'customize-menu-create)]) | |
6783 | ("Documentation" | |
6784 | ["Describe Mode" describe-mode t] | |
6785 | ["Abbreviation List" idlwave-list-abbrevs t] | |
6786 | "--" | |
6787 | ["Commentary in idlwave.el" idlwave-show-commentary t] | |
595ab50b | 6788 | ["Commentary in idlw-shell.el" idlwave-shell-show-commentary t] |
f32b3b91 CD |
6789 | "--" |
6790 | ["Info" idlwave-info t] | |
6791 | "--" | |
6792 | ["Launch IDL Help" idlwave-launch-idlhelp t]))) | |
6793 | ||
6794 | (defvar idlwave-mode-debug-menu-def | |
6795 | '("Debug" | |
6796 | ["Start IDL shell" idlwave-shell t] | |
6797 | ["Save and .RUN buffer" idlwave-shell-save-and-run | |
6798 | (and (boundp 'idlwave-shell-automatic-start) | |
6799 | idlwave-shell-automatic-start)])) | |
6800 | ||
6801 | (if (or (featurep 'easymenu) (load "easymenu" t)) | |
6802 | (progn | |
6803 | (easy-menu-define idlwave-mode-menu idlwave-mode-map | |
6804 | "IDL and WAVE CL editing menu" | |
6805 | idlwave-mode-menu-def) | |
6806 | (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map | |
6807 | "IDL and WAVE CL editing menu" | |
6808 | idlwave-mode-debug-menu-def))) | |
6809 | ||
6810 | (defun idlwave-customize () | |
6811 | "Call the customize function with idlwave as argument." | |
6812 | (interactive) | |
6813 | ;; Try to load the code for the shell, so that we can customize it | |
6814 | ;; as well. | |
22d5821d CD |
6815 | (or (featurep 'idlw-shell) |
6816 | (load "idlw-shell" t)) | |
f32b3b91 CD |
6817 | (customize-browse 'idlwave)) |
6818 | ||
6819 | (defun idlwave-create-customize-menu () | |
6820 | "Create a full customization menu for IDLWAVE, insert it into the menu." | |
6821 | (interactive) | |
6822 | (if (fboundp 'customize-menu-create) | |
6823 | (progn | |
6824 | ;; Try to load the code for the shell, so that we can customize it | |
6825 | ;; as well. | |
22d5821d CD |
6826 | (or (featurep 'idlw-shell) |
6827 | (load "idlw-shell" t)) | |
f32b3b91 CD |
6828 | (easy-menu-change |
6829 | '("IDLWAVE") "Customize" | |
6830 | `(["Browse IDLWAVE group" idlwave-customize t] | |
6831 | "--" | |
6832 | ,(customize-menu-create 'idlwave) | |
6833 | ["Set" Custom-set t] | |
6834 | ["Save" Custom-save t] | |
6835 | ["Reset to Current" Custom-reset-current t] | |
6836 | ["Reset to Saved" Custom-reset-saved t] | |
6837 | ["Reset to Standard Settings" Custom-reset-standard t])) | |
6838 | (message "\"IDLWAVE\"-menu now contains full customization menu")) | |
6839 | (error "Cannot expand menu (outdated version of cus-edit.el)"))) | |
6840 | ||
6841 | (defun idlwave-show-commentary () | |
6842 | "Use the finder to view the file documentation from `idlwave.el'." | |
6843 | (interactive) | |
6844 | (require 'finder) | |
6845 | (finder-commentary "idlwave.el")) | |
6846 | ||
6847 | (defun idlwave-shell-show-commentary () | |
595ab50b | 6848 | "Use the finder to view the file documentation from `idlw-shell.el'." |
f32b3b91 CD |
6849 | (interactive) |
6850 | (require 'finder) | |
595ab50b | 6851 | (finder-commentary "idlw-shell.el")) |
f32b3b91 CD |
6852 | |
6853 | (defun idlwave-info () | |
6854 | "Read documentation for IDLWAVE in the info system." | |
6855 | (interactive) | |
6856 | (require 'info) | |
6857 | (Info-goto-node "(idlwave)")) | |
6858 | ||
6859 | (defun idlwave-list-abbrevs (arg) | |
6860 | "Show the code abbreviations define in IDLWAVE mode. | |
6861 | This lists all abbrevs where the replacement text differs from the input text. | |
6862 | These are the ones the users want to learn to speed up their writing. | |
6863 | ||
6864 | The function does *not* list abbrevs which replace a word with itself | |
6865 | to call a hook. These hooks are used to change the case of words or | |
6866 | to blink the matching `begin', and the user does not need to know them. | |
6867 | ||
6868 | With arg, list all abbrevs with the corresponding hook. | |
6869 | ||
6870 | This function was written since `list-abbrevs' looks terrible for IDLWAVE mode." | |
6871 | ||
6872 | (interactive "P") | |
6873 | (let ((table (symbol-value 'idlwave-mode-abbrev-table)) | |
6874 | abbrevs | |
6875 | str rpl func fmt (len-str 0) (len-rpl 0)) | |
6876 | (mapatoms | |
6877 | (lambda (sym) | |
6878 | (if (symbol-value sym) | |
6879 | (progn | |
6880 | (setq str (symbol-name sym) | |
6881 | rpl (symbol-value sym) | |
6882 | func (symbol-function sym)) | |
6883 | (if arg | |
6884 | (setq func (prin1-to-string func)) | |
6885 | (if (and (listp func) (stringp (nth 2 func))) | |
6886 | (setq rpl (concat "EVAL: " (nth 2 func)) | |
6887 | func "") | |
6888 | (setq func ""))) | |
6889 | (if (or arg (not (string= rpl str))) | |
6890 | (progn | |
6891 | (setq len-str (max len-str (length str))) | |
6892 | (setq len-rpl (max len-rpl (length rpl))) | |
6893 | (setq abbrevs (cons (list str rpl func) abbrevs))))))) | |
6894 | table) | |
6895 | ;; sort the list | |
6896 | (setq abbrevs (sort abbrevs (lambda (a b) (string< (car a) (car b))))) | |
6897 | ;; Make the format | |
6898 | (setq fmt (format "%%-%ds %%-%ds %%s\n" len-str len-rpl)) | |
6899 | (with-output-to-temp-buffer "*Help*" | |
6900 | (if arg | |
6901 | (progn | |
6902 | (princ "Abbreviations and Actions in IDLWAVE-Mode\n") | |
6903 | (princ "=========================================\n\n") | |
6904 | (princ (format fmt "KEY" "REPLACE" "HOOK")) | |
6905 | (princ (format fmt "---" "-------" "----"))) | |
6906 | (princ "Code Abbreviations and Templates in IDLWAVE-Mode\n") | |
6907 | (princ "================================================\n\n") | |
6908 | (princ (format fmt "KEY" "ACTION" "")) | |
6909 | (princ (format fmt "---" "------" ""))) | |
6910 | (mapcar | |
6911 | (lambda (list) | |
6912 | (setq str (car list) | |
6913 | rpl (nth 1 list) | |
6914 | func (nth 2 list)) | |
6915 | (princ (format fmt str rpl func))) | |
6916 | abbrevs))) | |
6917 | ;; Make sure each abbreviation uses only one display line | |
6918 | (save-excursion | |
6919 | (set-buffer "*Help*") | |
6920 | (setq truncate-lines t))) | |
6921 | ||
15e42531 CD |
6922 | ;; Try to load online help, but catch any errors. |
6923 | (condition-case nil | |
6924 | (idlwave-require-online-help) | |
6925 | (error nil)) | |
6926 | ||
6927 | ;; Run the hook | |
f32b3b91 CD |
6928 | (run-hooks 'idlwave-load-hook) |
6929 | ||
6930 | (provide 'idlwave) | |
6931 | ||
6932 | ;;; idlwave.el ends here | |
6933 |