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