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