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