Files re-installed, because changes are too massive to document them here.
[bpt/emacs.git] / lisp / progmodes / idlwave.el
CommitLineData
f32b3b91
CD
1;;; idlwave.el --- IDL and WAVE CL editing mode for GNU Emacs
2;; Copyright (c) 1994-1997 Chris Chase
3;; Copyright (c) 1999 Carsten Dominik
15e42531 4;; Copyright (c) 1999, 2000 Free Software Foundation
f32b3b91
CD
5
6;; Author: Chris Chase <chase@att.com>
7;; Maintainer: Carsten Dominik <dominik@strw.leidenuniv.nl>
15e42531
CD
8;; Version: 4.2
9;; Date: $Date: 2000/06/15 17:58:23 $
f32b3b91
CD
10;; Keywords: languages
11
12;; This file is part of the GNU Emacs.
13
14;; GNU Emacs is free software; you can redistribute it and/or modify
15;; it under the terms of the GNU General Public License as published by
16;; the Free Software Foundation; either version 2, or (at your option)
17;; any later version.
18
19;; GNU Emacs is distributed in the hope that it will be useful,
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22;; GNU General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
25;; along with GNU Emacs; see the file COPYING. If not, write to the
26;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27;; Boston, MA 02111-1307, USA.
28
29;;; Commentary:
30
31;; In distant past, based on pascal.el. Though bears little
32;; resemblance to that now.
33;;
34;; Incorporates many ideas, such as abbrevs, action routines, and
35;; continuation line indenting, from wave.el.
36;; wave.el original written by Lubos Pochman, Precision Visuals, Boulder.
37;;
38;; See the mode description ("C-h m" in idlwave-mode or "C-h f idlwave-mode")
39;; for features, key bindings, and info.
40;; Also, Info format documentation is available with `M-x idlwave-info'
41;;
42;;
43;; INSTALLATION
44;; ============
45;;
46;; Follow the instructions in the INSTALL file of the distribution.
47;; In short, put this file on your load path and add the following
48;; lines to your .emacs file:
49;;
50;; (autoload 'idlwave-mode "idlwave" "IDLWAVE Mode" t)
8c7b4ec8 51;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t)
f32b3b91
CD
52;; (setq auto-mode-alist (cons '("\\.pro\\'" . idlwave-mode) auto-mode-alist))
53;;
54;;
55;; SOURCE
56;; ======
57;;
58;; The newest version of this file is available from the maintainers
59;; Webpage.
60;;
61;; http://www.strw.leidenuniv.el/~dominik/Tools/idlwave
62;;
63;; DOCUMENTATION
64;; =============
65;;
66;; IDLWAVE is documented online in info format.
67;; A printable version of the documentation is available from the
68;; maintainers webpage (see under SOURCE)
69;;
70;;
71;; ACKNOWLEDGMENTS
72;; ===============
73;;
74;; Thanks to the following people for their contributions and comments:
75;;
76;; Ulrik Dickow <dickow@nbi.dk>
77;; Eric E. Dors <edors@lanl.gov>
78;; Stein Vidar H. Haugan <s.v.h.haugan@astro.uio.no>
79;; David Huenemoerder <dph@space.mit.edu>
80;; Kevin Ivory <Kevin.Ivory@linmpi.mpg.de>
81;; Xuyong Liu <liu@stsci.edu>
82;; Simon Marshall <Simon.Marshall@esrin.esa.it>
83;; Laurent Mugnier <mugnier@onera.fr>
84;; Lubos Pochman <lubos@rsinc.com>
85;; Patrick M. Ryan <pat@jaameri.gsfc.nasa.gov>
86;; Marty Ryba <ryba@ll.mit.edu>
87;; Phil Williams <williams@irc.chmcc.org>
88;; J.D. Smith <jdsmith@astrosun.tn.cornell.edu>
89;; Phil Sterne <sterne@dublin.llnl.gov>
90;;
91;; CUSTOMIZATION:
92;; =============
93;;
94;; IDLWAVE has customize support - so if you want to learn about the
95;; variables which control the behavior of the mode, use
96;; `M-x idlwave-customize'.
97;;
98;; You can set your own preferred values with Customize, or with Lisp
99;; code in .emacs. For an example of what to put into .emacs, check
100;; the TexInfo documentation.
101;;
102;; KNOWN PROBLEMS:
103;; ==============
104;;
105;; Moving the point backwards in conjunction with abbrev expansion
106;; does not work as I would like it, but this is a problem with
107;; emacs abbrev expansion done by the self-insert-command. It ends
108;; up inserting the character that expanded the abbrev after moving
109;; point backward, e.g., "\cl" expanded with a space becomes
110;; "LONG( )" with point before the close paren. This is solved by
111;; using a temporary function in `post-command-hook' - not pretty,
595ab50b 112;; but it works.
f32b3b91
CD
113;;
114;; Tabs and spaces are treated equally as whitespace when filling a
115;; comment paragraph. To accomplish this, tabs are permanently
116;; replaced by spaces in the text surrounding the paragraph, which
117;; may be an undesirable side-effect. Replacing tabs with spaces is
118;; limited to comments only and occurs only when a comment
119;; paragraph is filled via `idlwave-fill-paragraph'.
120;;
121;; "&" is ignored when parsing statements.
122;; Avoid muti-statement lines (using "&") on block begin and end
123;; lines. Multi-statement lines can mess up the formatting, for
124;; example, multiple end statements on a line: endif & endif.
125;; Using "&" outside of block begin/end lines should be okay.
126;;
127;; It is possible that the parser which decides what to complete has
128;; problems with pointer dereferencing statements. I don't use
129;; pointers often enough to find out - please report any problems.
130;;
f32b3b91
CD
131;; Completion and Routine Info do not know about inheritance. Thus,
132;; Keywords inherited from superclasses are not displayed and cannot
133;; completed.
134;;
135;; When forcing completion of method keywords, the initial
136;; query for a method has multiple entries for some methods. Would
595ab50b 137;; be too difficult to fix this hardly used case.
f32b3b91
CD
138;;
139\f
140;;; Code:
141
142(eval-when-compile (require 'cl))
143
144(eval-and-compile
145 ;; Kludge to allow `defcustom' for Emacs 19.
146 (condition-case () (require 'custom) (error nil))
147 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
148 nil ;; We've got what we needed
149 ;; We have the old or no custom-library, hack around it!
150 (defmacro defgroup (&rest args) nil)
151 (defmacro defcustom (var value doc &rest args)
152 (` (defvar (, var) (, value) (, doc))))))
153
154(defgroup idlwave nil
155 "Major mode for editing IDL/WAVE CL .pro files"
156 :tag "IDLWAVE"
157 :link '(url-link :tag "Home Page"
158 "http://strw.leidenuniv.nl/~dominik/Tools/idlwave")
595ab50b
CD
159 :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el"
160 "idlw-shell.el")
f32b3b91
CD
161 :link '(emacs-commentary-link :tag "Commentary in idlwave.el" "idlwave.el")
162 :link '(custom-manual "(idlwave)Top")
163 :prefix "idlwave"
164 :group 'languages)
165
166;;; Variables for indentation behavior ---------------------------------------
167
168(defgroup idlwave-code-formatting nil
169 "Indentation and formatting options for IDLWAVE mode."
170 :group 'idlwave)
171
172(defcustom idlwave-main-block-indent 0
173 "*Extra indentation for the main block of code.
174That is the block between the FUNCTION/PRO statement and the END
175statement 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.
181If 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.
187A value equal to negative `idlwave-block-indent' will make END lines
188line 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.
194This extra offset applies to the first of a set of continuation lines.
195The following lines receive the same indentation as the first.
196Also, the value of this variable applies to continuation lines inside
197parenthesis. When the current line contains an open unmatched ([{,
198the 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
204hanging indent given by `idlwave-hang-indent-regexp' match in the first line
205of 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
211in the first line of a comment paragraph. The size of the indent
212extends 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.
228When the line end falls within a string, string concatenation with the
229'+' operator will be used to distribute a long string over lines.
230If nil and a string is split then a terminal beep and warning are issued.
231
232This variable is ignored when `idlwave-fill-comment-line-only' is
233non-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 `+'.
239When the splitting point of a line falls inside a string, split the string
240using the `+' string concatenation operator. If nil and a string is
241split 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
247expression will not be changed. Note that the indentation of a comment
248at 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.
254A comment matching this regular expression will not have its
255indentation changed. If nil the default is \"^;\", i.e., any line
256beginning with a \";\". Expressions for comments at the beginning of
257the 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
264itself is indented as if it is a part of IDL code. As a result if
265the comment is not preceded by whitespace it is unchanged."
266 :group 'idlwave-code-formatting
267 :type 'regexp)
268
269;; Comments not matching any of the above will be indented as a
270;; right-margin comment, i.e., to a minimum of `comment-column'.
271
272
273;;; Routine Info and Completion ---------------------------------------
274
15e42531
CD
275(defgroup idlwave-routine-info nil
276 "Routine Info options for IDLWAVE mode."
f32b3b91
CD
277 :group 'idlwave)
278
279(defcustom idlwave-scan-all-buffers-for-routine-info t
15e42531
CD
280 "*Non-nil means, scan buffers for IDL programs when updating info.
281The scanning is done by the command `idlwave-update-routine-info'.
282The following values are allowed:
283
284nil Don't scan any buffers.
285t Scan all idlwave-mode buffers in the current editing session.
286current Scan only the current buffer, but no other buffers."
287 :group 'idlwave-routine-info
288 :type '(choice
289 (const :tag "No buffer" nil)
290 (const :tag "All buffers" t)
291 (const :tag "Current buffer only" 'current)))
f32b3b91
CD
292
293(defcustom idlwave-query-shell-for-routine-info t
294 "*Non-nil means query the shell for info about compiled routines.
295Querying the shell is useful to get information about compiled modules,
296and it is turned on by default. However, when you have a complete library
297scan, this is not necessary."
15e42531 298 :group 'idlwave-routine-info
f32b3b91
CD
299 :type 'boolean)
300
15e42531
CD
301(defcustom idlwave-auto-routine-info-updates
302 '(find-file save-buffer kill-buffer compile-buffer)
303 "*Controls under what circumstances routine info is updated automatically.
304Possible values:
305nil Never
306t 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.
324When an integer, it is the maximum number of source files displayed.
325t means to show all source files."
326 :group 'idlwave-routine-info
327 :type 'integer)
328
f32b3b91
CD
329(defcustom idlwave-library-path nil
330 "Library path for Windows and MacOS. Not needed under Unix.
331When selecting the directories to scan for IDL library routine info,
332IDLWAVE can under UNIX query the shell for the exact search path.
333However, under Windows and MacOS, the IDLWAVE shell does not work. In this
334case, this variable specifies the path where IDLWAVE can find library files.
335The shell will only be asked when this variable is nil.
336The value is a list of directories. A directory preceeded by a `+' will
595ab50b 337be searched recursively. If you set this variable on a UNIX system, the shell
15e42531
CD
338will not be asked.
339See also `idlwave-system-directory'."
340 :group 'idlwave-routine-info
f32b3b91
CD
341 :type '(repeat (directory)))
342
15e42531
CD
343(defcustom idlwave-system-directory ""
344 "The IDL system directory for Windows and MacOS. Not needed under UNIX.
345Set this to the value of the `!DIR' system variable in IDL. IDLWAVE uses
346this to find out which of the library routines belong to the official system
347library. All files inside the `lib' subdirectory are considered system
348library files - so don't install private stuff in this directory.
349On UNIX systems, IDLWAVE queries the shell for the value of `!DIR'.
350See also `idlwave-library-path'."
351 :group 'idlwave-routine-info
352 :type 'directory)
353
354(defcustom idlwave-libinfo-file "~/.idlcat.el"
f32b3b91
CD
355 "*File for routine information of the IDL library.
356When this points to a file, the file will be loaded when IDLWAVE first
357accesses routine info (or does completion).
358When you scan the library with `idlwave-create-libinfo-file', this file
359will be used to store the result."
15e42531 360 :group 'idlwave-routine-info
f32b3b91
CD
361 :type 'file)
362
15e42531
CD
363(defcustom idlwave-special-lib-alist nil
364 "Alist of regular expressions matching special library directories.
365When listing routine source locations, IDLWAVE gives a short hint where
366the file defining the routine is located. By default it lists `SystemLib'
367for routines in the system library `!DIR/lib' and `Library' for anything
368else. This variable can define additional types. The car of each entry
369is a regular expression matching the file name (they normally will match
370on the path). The cdr is the string to be used as identifier. Max 10
371chars 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.
393See also `idlwave-help-use-dedicated-frame'.
394If 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.
402Currently 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.
408Online help works only for system routines which are described in the
409IDL manuals. A function may be specified to access help from other sources.
410
411The function must accept four arguments: NAME, TYPE, CLASS, KEYWORD.
412The Help buffer is current when this function is called, and the help
413text should be loaded into this buffer. If help is found, the function
414should return the buffer position which should be used as `window-start'
415in the help window. Also, the variable `idlwave-help-mode-line-indicator'
416should be set to a useful string, which will be displayed in the mode line
417of the help window. If should also set the variable `idlwave-min-frame-width'
418to a positive integer. IDLWAVE will ensure that the help frame is at
419least that many columns wide.
420Failure to find help should be indicated by throwing an error.
421
422When this variable is non-nil, IDLWAVE will allow the mouse-3 help click
423for every routine and keyword, even though the item may not be highlighted
424in blue (indicating the availability of system documentation).
425
426The default value for this function is `idlwave-help-with-source' which
427loads the routine source file into the help buffer. If you try to write
428a different function which accesses a special help file or so, it is
429probably 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.
440Routines which are not documented in the system manual use their source as
441help text. When this variable is non-nil, we try to find a description of
442the help item in the first routine doclib header above the routine definition.
443If the variable is nil, or if we cannot find/parse the header, the routine
444definition is displayed instead."
445 :group 'idlwave-online-help
446 :type 'boolean)
447
448(defface idlwave-help-link-face
449 '((((class color)) (:foreground "Blue"))
450 (t (:bold t)))
451 "Face for highlighting links into IDLWAVE online help."
452 :group 'idlwave-online-help)
453
454(defgroup idlwave-completion nil
455 "Completion options for IDLWAVE mode."
456 :prefix "idlwave"
457 :group 'idlwave)
458
f32b3b91
CD
459(eval-and-compile
460 (defconst idlwave-tmp
461 '(choice :tag "by applying the function"
462 (const upcase)
463 (const downcase)
464 (const capitalize)
465 (const preserve)
466 (symbol :tag "Other"))))
467
f32b3b91
CD
468(defcustom idlwave-completion-case '((routine . upcase)
469 (keyword . upcase)
470 (class . preserve)
471 (method . preserve))
472 "Association list setting the case of completed words.
473
474This variable determines the case (UPPER/lower/Capitalized...) of
475words inserted into the buffer by completion. The preferred case can
476be specified separately for routine names, keywords, classes and
477methods.
478This alist should therefore have entries for `routine' (normal
479functions and procedures, i.e. non-methods), `keyword', `class', and
480`method'. Plausible values are
481
482upcase upcase whole word, like `BOX_CURSOR'
483downcase downcase whole word, like `read_ppm'
484capitalize capitalize each part, like `Widget_Control'
485preserve preserve case as is, like `IDLgrView'
486
487The value can also be any Emacs Lisp function which transforms the
488case of characters in a string.
489
490A value of `preserve' means that the case of the completed word is
491identical to the way it was written in the definition statement of the
492routine. This was implemented to allow for mixed-case completion, in
493particular of object classes and methods.
494If a completable word is defined in multiple locations, the meaning of
495`preserve' is not unique since the different definitions might be
496cased differently. Therefore IDLWAVE always takes the case of the
497*first* definition it encounters during routine info collection and
498uses the case derived from it consistently.
499
500Note that a lowercase-only string in the buffer will always be completed in
501lower case (but see the variable `idlwave-completion-force-default-case').
502
503After changing this variable, you need to either restart Emacs or press
504`C-u C-c C-i' to update the internal lists."
15e42531 505 :group 'idlwave-completion
f32b3b91
CD
506 :type `(repeat
507 (cons (symbol :tag "Derive completion case for")
508 ,idlwave-tmp)))
509
510(defcustom idlwave-completion-force-default-case nil
511 "*Non-nil means, completion will always honor `idlwave-completion-case'.
512When nil, only the completion of a mixed case or upper case string
513will honor the default settings in `idlwave-completion-case', while
514the completion of lower case strings will be completed entirely in
515lower case."
15e42531 516 :group 'idlwave-completion
f32b3b91
CD
517 :type 'boolean)
518
519(defcustom idlwave-complete-empty-string-as-lower-case nil
520 "*Non-nil means, the empty string is considered downcase for completion.
521The case of what is already in the buffer determines the case of completions.
522When this variable is non-nil, the empty string is considered to be downcase.
523Completing on the empty string then offers downcase versions of the possible
524completions."
15e42531 525 :group 'idlwave-completion
f32b3b91
CD
526 :type 'boolean)
527
528(defvar idlwave-default-completion-case-is-down nil
529 "Obsolete variable. See `idlwave-complete-empty-string-as-lower-case' and
530`idlwave-completion-case'.")
531
532(defcustom idlwave-buffer-case-takes-precedence nil
533 "*Non-nil means, the case of tokens in buffers dominates over system stuff.
534To make this possible, we need to re-case everything each time we update
535the routine info from the buffers. This is slow.
536The default is to consider the case given in the system and library files
537first which makes updating much faster."
15e42531
CD
538 :group 'idlwave-completion
539 :type 'boolean)
540
541(defcustom idlwave-highlight-help-links-in-completion t
542 "*Non-nil means, highlight completions for which system help is available.
543Help can then be accessed with mouse-3.
544This option is only effective when the online help system is installed."
545 :group 'idlwave-completion
f32b3b91
CD
546 :type 'boolean)
547
548(defcustom idlwave-completion-show-classes 1
549 "*Number of classes to show when completing object methods and keywords.
550When completing methods or keywords for an object with unknown class,
551the *Completions* buffer will show the legal classes for each completion
552like this:
553
554MyMethod <Class1,Class2,Class3>
555
556The value of this variable may be nil to inhibit display, or an integer to
557indicate the maximum number of classes to display.
558
559On XEmacs, a full list of classes will also be placed into a `help-echo'
560property on the competion items, so that the list of classes for the current
561item is displayed in the echo area. If the value of this variable is a
562negative integer, the `help-echo' property will be suppressed."
15e42531 563 :group 'idlwave-completion
f32b3b91
CD
564 :type '(choice (const :tag "Don't show" nil)
565 (integer :tag "Number of classes shown" 1)))
566
567(defcustom idlwave-completion-fontify-classes t
568 "*Non-nil means, fontify the classes in completions buffer.
569This makes it easier to distinguish the completion items from the extra
570class info listed. See `idlwave-completion-show-classes'."
15e42531 571 :group 'idlwave-completion
f32b3b91
CD
572 :type 'boolean)
573
574(defcustom idlwave-query-class '((method-default . nil)
575 (keyword-default . nil))
576 "Association list governing specification of object classes for completion.
577
578When IDLWAVE is trying to complete items which belong to the object
579oriented part of IDL, it usually cannot determine the class of a given
580object from context. In order to provide the user with a correct list
581of methods or keywords, it would have to determine the appropriate
582class. IDLWAVE has two ways to deal with this problem.
583
5841. 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
5942. 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
603This variable allows to configure IDLWAVE's behavior during
604completion. Its value is an alist, which should contain at least two
605elements: (method-default . VALUE) and (keyword-default . VALUE),
606where VALUE is either t or nil. These specify if the class should be
607determined during method and keyword completion, respectively.
608
609The alist may have additional entries specifying exceptions from the
610keyword completion rule for specific methods, like INIT or
611GETPROPERTY. In order to turn on class specification for the INIT
612method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS."
15e42531 613 :group 'idlwave-completion
f32b3b91
CD
614 :type '(list
615 (cons (const method-default)
616 (boolean :tag "Determine class when completing METHODS "))
617 (cons (const keyword-default)
618 (boolean :tag "Determine class when completing KEYWORDS "))
619 (repeat
620 :tag "Exceptions to defaults"
621 :inline t
622 (cons (string :tag "MODULE" :value "")
623 (boolean :tag "Determine class for this method")))))
624
625(defcustom idlwave-store-inquired-class nil
626 "*Non-nil means, store class of a method call as text property on `->'.
627IDLWAVE sometimes has to ask the user for the class associated with a
628particular object method call. This happens during the commands
629`idlwave-routine-info' and `idlwave-complete', depending upon the
630value of the variable `idlwave-query-class'.
631
632When you specify a class, this information can be stored as a text
633property on the `->' arrow in the source code, so that during the same
634editing session, IDLWAVE will not have to ask again. When this
635variable is non-nil, IDLWAVE will store and reuse the class information.
636The class stored can be checked and removed with `\\[idlwave-routine-info]'
637on the arrow.
638
639The default of this variable is nil, since the result of commands then
640is more predictable. However, if you know what you are doing, it can
641be nice to turn this on.
642
643An arrow which knows the class will be highlighted with
644`idlwave-class-arrow-face'. The command \\[idlwave-routine-info]
645displays (with prefix arg: deletes) the class stored on the arrow
646at point."
15e42531 647 :group 'idlwave-completion
f32b3b91
CD
648 :type 'boolean)
649
650(defcustom idlwave-class-arrow-face 'bold
651 "*Face to highlight object operator arrows `->' which carry a class property.
652When IDLWAVE stores a class name as text property on an object arrow
653(see variable `idlwave-store-inquired-class', it highlights the arrow
654with this font in order to remind the user that this arrow is special."
15e42531 655 :group 'idlwave-completion
f32b3b91
CD
656 :type 'symbol)
657
658(defcustom idlwave-resize-routine-help-window t
659 "*Non-nil means, resize the Routine-info *Help* window to fit the content."
15e42531 660 :group 'idlwave-completion
f32b3b91
CD
661 :type 'boolean)
662
663(defcustom idlwave-keyword-completion-adds-equal t
664 "*Non-nil means, completion automatically adds `=' after completed keywords."
15e42531 665 :group 'idlwave-completion
f32b3b91
CD
666 :type 'boolean)
667
668(defcustom idlwave-function-completion-adds-paren t
669 "*Non-nil means, completion automatically adds `(' after completed function.
670Nil means, don't add anything.
671A value of `2' means, also add the closing parenthesis and position cursor
672between the two."
15e42531 673 :group 'idlwave-completion
f32b3b91
CD
674 :type '(choice (const :tag "Nothing" nil)
675 (const :tag "(" t)
676 (const :tag "()" 2)))
677
678(defcustom idlwave-completion-restore-window-configuration t
679 "*Non-nil means, try to restore the window configuration after completion.
680When completion is not unique, Emacs displays a list of completions.
681This messes up your window configuration. With this variable set, IDLWAVE
682restores the old configuration after successful completion."
15e42531 683 :group 'idlwave-completion
f32b3b91
CD
684 :type 'boolean)
685
686;;; Variables for abbrev and action behavior -----------------------------
687
688(defgroup idlwave-abbrev-and-indent-action nil
689 "IDLWAVE performs actions when expanding abbreviations or indenting lines.
690The variables in this group govern this."
691 :group 'idlwave)
692
693(defcustom idlwave-do-actions nil
694 "*Non-nil means performs actions when indenting.
695The 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.
701Possible characters to chose from: ~`\%
702or even '?'. '.' is not a good choice because it can make structure
703field names act like abbrevs in certain circumstances.
704
705Changes to this in `idlwave-mode-hook' will have no effect. Instead a user
706must set it directly using `setq' in the .emacs file before idlwave.el
707is loaded."
708 :group 'idlwave-abbrev-and-indent-action
709 :type 'string)
710
711(defcustom idlwave-surround-by-blank nil
712 "*Non-nil means, enable `idlwave-surround'.
595ab50b 713If non-nil, `=',`<',`>',`&',`,', `->' are surrounded with spaces by
f32b3b91
CD
714`idlwave-surround'.
715See help for `idlwave-indent-action-table' for symbols using `idlwave-surround'.
716
717Also see the default key bindings for keys using `idlwave-surround'.
718Keys are bound and made into actions calling `idlwave-surround' with
719`idlwave-action-and-binding'.
720See help for `idlwave-action-and-binding' for examples.
721
722Also 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.
728Whenever `idlwave-surround' is non-nil then this affects how '=' is padded
15e42531
CD
729for keywords. If t, it is padded the same as for assignments.
730If nil then spaces are removed. With any other value, spaces are left
731unchanged."
f32b3b91 732 :group 'idlwave-abbrev-and-indent-action
15e42531
CD
733 :type '(choice
734 (const :tag "Pad like assignments" t)
735 (const :tag "Remove space near `='" nil)
736 (const :tag "Keep space near `='" 'keep)))
f32b3b91
CD
737
738(defcustom idlwave-show-block t
739 "*Non-nil means point blinks to block beginning for `idlwave-show-begin'."
740 :group 'idlwave-abbrev-and-indent-action
741 :type 'boolean)
742
743(defcustom idlwave-expand-generic-end nil
744 "*Non-nil means expand generic END to ENDIF/ENDELSE/ENDWHILE etc."
745 :group 'idlwave-abbrev-and-indent-action
746 :type 'boolean)
747
15e42531
CD
748(defcustom idlwave-reindent-end t
749 "*Non-nil means re-indent line after END was typed."
750 :group 'idlwave-abbrev-and-indent-action
751 :type 'boolean)
752
f32b3b91
CD
753(defcustom idlwave-abbrev-move t
754 "*Non-nil means the abbrev hook can move point.
755Set to nil by `idlwave-expand-region-abbrevs'. To see the abbrev
756definitions, use the command `list-abbrevs', for abbrevs that move
757point. Moving point is useful, for example, to place point between
758parentheses of expanded functions.
759
760See `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.
766If the value t, all expanded abbrevs will be upper case.
767If the value is 'down then abbrevs will be forced to lower case.
768If nil, the case will not change.
769If `idlwave-reserved-word-upcase' is non-nil, reserved words will always be
770upper 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.
776If nil case of reserved words is controlled by `idlwave-abbrev-change-case'.
777Has 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),
813and function as a cdr. This table is used by `idlwave-indent-line'.
814See documentation for `idlwave-do-action' for a complete description of
815the action lists.
816
817Additions to the table are made with `idlwave-action-and-binding' when a
818binding is not requested.
819See 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),
823and 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
827Additions to the table are made with `idlwave-action-and-binding' when a
828binding is requested.
829See 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
902summarizing a file. If PATHNAME is non-nil then this file will be included.
903Otherwise STRING is used. If NIL, the file summary will be omitted.
904For example you might set PATHNAME to the path for the
905lib_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.
914A ':' is added to the keyword end.
915Inserted by doc-header and used to position logs by doc-modification.
916If nil it will not be inserted."
917 :group 'idlwave-documentation
918 :type 'string)
919
920(defcustom idlwave-doclib-start "^;+\\+"
921 "*Regexp matching the start of a document library header."
922 :group 'idlwave-documentation
923 :type 'regexp)
924
925(defcustom idlwave-doclib-end "^;+-"
926 "*Regexp matching the end of a document library header."
927 :group 'idlwave-documentation
928 :type 'regexp)
929
930;;; External Programs -------------------------------------------------------
931
932(defgroup idlwave-external-programs nil
933 "Miscellaneous options for IDLWAVE mode."
934 :group 'idlwave)
935
936;; WARNING: The following variable has recently been moved from
595ab50b 937;; idlw-shell.el to this file. I hope this does not break
f32b3b91
CD
938;; anything.
939
940(defcustom idlwave-shell-explicit-file-name "idl"
941 "*If non-nil, is the command to run IDL.
942Should be an absolute file path or path relative to the current environment
943execution 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.
973IDLWAVE defines 3 levels of fontification. Level 1 is very little, level 3
974is everything and level 2 is specified by this list.
975This variable must be set before IDLWAVE gets loaded. It is
976a list of symbols, the following symbols are allowed.
977
978pros-and-functions Procedure and Function definitions
979batch-files Batch Files
980idl-keywords IDL Keywords
981label Statement Labels
982goto Goto Statements
983common-blocks Common Blocks
984keyword-parameters Keyword Parameters in routine definitions and calls
985system-variables System Variables
986fixme FIXME: Warning in comments (on XEmacs only v. 21.0 and up)
987class-arrows Object Arrows with class property"
988 :group 'idlwave-misc
989 :type '(set
990 :inline t :greedy t
991 (const :tag "Procedure and Function definitions" pros-and-functions)
992 (const :tag "Batch Files" batch-files)
993 (const :tag "IDL Keywords (reserved words)" idl-keywords)
994 (const :tag "Statement Labels" label)
995 (const :tag "Goto Statements" goto)
996 (const :tag "Common Blocks" common-blocks)
997 (const :tag "Keyword Parameters" keyword-parameters)
998 (const :tag "System Variables" system-variables)
999 (const :tag "FIXME: Warning" fixme)
1000 (const :tag "Object Arrows with class property " class-arrows)))
1001
1002(defcustom idlwave-mode-hook nil
1003 "Normal hook. Executed when a buffer is put into `idlwave-mode'."
1004 :group 'idlwave-misc
1005 :type 'hook)
1006
1007(defcustom idlwave-load-hook nil
1008 "Normal hook. Executed when idlwave.el is loaded."
1009 :group 'idlwave-misc
1010 :type 'hook)
1011
15e42531
CD
1012(defvar idlwave-experimental nil
1013 "Non-nil means turn on a few experimental features.
1014This variable is only for the maintainer, to test difficult stuff,
1015while still distributing stable releases.
1016As a user, you should not set this to t.")
1017
f32b3b91
CD
1018;;;
1019;;; End customization variables section
1020;;;
1021
1022;;; Non customization variables
1023
1024;;; font-lock mode - Additions by Phil Williams, Ulrik Dickow and
1025;;; Simon Marshall <simon@gnu.ai.mit.edu>
1026;;; and Carsten Dominik...
1027
1028(defconst idlwave-font-lock-keywords-1 nil
1029 "Subdued level highlighting for IDLWAVE mode.")
1030
1031(defconst idlwave-font-lock-keywords-2 nil
1032 "Medium level highlighting for IDLWAVE mode.")
1033
1034(defconst idlwave-font-lock-keywords-3 nil
1035 "Gaudy level highlighting for IDLWAVE mode.")
1036
1037(let* ((oldp (or (string-match "Lucid" emacs-version)
1038 (not (boundp 'emacs-minor-version))
1039 (and (<= emacs-major-version 19)
1040 (<= emacs-minor-version 29))))
1041
1042 ;; The following are the reserved words in IDL. Maybe we should
1043 ;; highlight some more stuff as well?
1044 (idl-keywords
595ab50b
CD
1045 ;; To update this regexp, update the list of keywords and
1046 ;; evaluate the form.
1047; (insert
1048; (concat
1049; "\"\\\\<"
1050; (regexp-opt
1051; '("and" "or" "xor" "not"
1052; "eq" "ge" "gt" "le" "lt" "ne"
1053; "for" "do" "endfor"
1054; "if" "then" "endif" "else" "endelse"
1055; "case" "of" "endcase"
1056; "begin" "end"
1057; "repeat" "until" "endrep"
1058; "while" "endwhile"
1059; "goto" "return"
1060; "inherits" "mod"
1061; "on_error" "on_ioerror")) ; on_error is not officially reserved
1062; "\\\\>\""))
f32b3b91
CD
1063 (concat "\\<\\("
1064 "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\(case\\|else\\|"
1065 "for\\|if\\|rep\\|while\\)?\\|q\\)\\|for\\|g\\(oto\\|[et]\\)"
1066 "\\|i\\(f\\|nherits\\)\\|l[et]\\|mod\\|n\\(e\\|ot\\)\\|"
1067 "o\\(n_ioerror\\|[fr]\\)\\|re\\(peat\\|turn\\)\\|then\\|"
1068 "until\\|while\\|xor"
1069 "\\)\\>"))
1070
1071 ;; Procedure declarations. Fontify keyword plus procedure name.
1072 ;; Function declarations. Fontify keyword plus function name.
1073 (pros-and-functions
1074 '("\\<\\(function\\|pro\\)\\>[ \t]+\\(\\sw+\\(::\\sw+\\)?\\)"
1075 (1 font-lock-keyword-face)
1076 (2 font-lock-function-name-face nil t)))
1077
1078 ;; Common blocks
1079 (common-blocks
1080 '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?"
1081 (1 font-lock-keyword-face) ; "common"
1082 (2 font-lock-reference-face nil t) ; block name
1083 (font-lock-match-c++-style-declaration-item-and-skip-to-next
1084 ;; Start with point after block name and comma
1085 (goto-char (match-end 0)) ; needed for XEmacs, could be nil
1086 nil
1087 (1 font-lock-variable-name-face) ; variable names
1088 )))
1089
1090 ;; Batch files
1091 (batch-files
1092 '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face)))
1093
1094 ;; FIXME warning.
1095 (fixme
1096 '("\\<FIXME:" (0 font-lock-warning-face t)))
1097
1098 ;; Labels
1099 (label
1100 '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-reference-face)))
1101
1102 ;; The goto statement and its label
1103 (goto
1104 '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)"
1105 (1 font-lock-keyword-face)
1106 (2 font-lock-reference-face)))
1107
1108 ;; Named parameters, like /xlog or ,xrange=[]
1109 ;; This is anchored to the comma preceeding the keyword.
595ab50b
CD
1110 ;; Treats continuation lines, works only during whole buffer
1111 ;; fontification. Slow, use it only in fancy fontification.
f32b3b91 1112 (keyword-parameters
15e42531
CD
1113 '("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\\(\n[ \t]*;.*\\)*\n[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)"
1114 (5 font-lock-reference-face)))
f32b3b91 1115
595ab50b 1116 ;; System variables start with a bang.
f32b3b91 1117 (system-variables
15e42531 1118 '("\\(![a-zA-Z_0-9]+\\(\\.\\sw+\\)?\\)"
f32b3b91
CD
1119 (1 font-lock-variable-name-face)))
1120
1121 ;; Special and unusual operators (not used because too noisy)
1122 (special-operators
1123 '("[<>#]" (0 font-lock-keyword-face)))
1124
1125 ;; All operators (not used because too noisy)
1126 (all-operators
1127 '("[-*^#+<>/]" (0 font-lock-keyword-face)))
1128
1129 ;; Arrows with text property `idlwave-class'
1130 (class-arrows
1131 (list 'idlwave-match-class-arrows
1132 (list 0 (if (featurep 'xemacs)
1133 idlwave-class-arrow-face
1134 'idlwave-class-arrow-face))))
1135
1136 )
1137
1138 ;; The following lines are just a dummy to make the compiler shut up
1139 ;; about variables bound but not used.
1140 (setq oldp oldp
1141 idl-keywords idl-keywords
1142 pros-and-functions pros-and-functions
1143 common-blocks common-blocks
1144 batch-files batch-files
1145 fixme fixme
1146 label label
1147 goto goto
1148 keyword-parameters keyword-parameters
1149 system-variables system-variables
1150 special-operators special-operators
1151 all-operators all-operators
1152 class-arrows class-arrows)
1153
1154 (setq idlwave-font-lock-keywords-1
1155 (list pros-and-functions
1156 batch-files
1157 ))
1158
1159 (setq idlwave-font-lock-keywords-2
1160 (mapcar 'symbol-value idlwave-default-font-lock-items))
1161
1162 (setq idlwave-font-lock-keywords-3
1163 (list pros-and-functions
1164 batch-files
1165 idl-keywords
1166 label goto
1167 common-blocks
1168 keyword-parameters
1169 system-variables
1170 class-arrows
1171 ))
1172 )
1173
1174(defun idlwave-match-class-arrows (limit)
1175 ;; Match an object arrow with class property
1176 (and idlwave-store-inquired-class
1177 (re-search-forward "->" limit 'limit)
1178 (get-text-property (match-beginning 0) 'idlwave-class)))
1179
1180(defvar idlwave-font-lock-keywords idlwave-font-lock-keywords-2
1181 "Default expressions to highlight in IDLWAVE mode.")
1182
1183(defvar idlwave-font-lock-defaults
1184 '((idlwave-font-lock-keywords
1185 idlwave-font-lock-keywords-1
1186 idlwave-font-lock-keywords-2
1187 idlwave-font-lock-keywords-3)
1188 nil t
1189 ((?$ . "w") (?_ . "w") (?. . "w"))
1190 beginning-of-line))
1191
1192(put 'idlwave-mode 'font-lock-defaults
1193 idlwave-font-lock-defaults) ; XEmacs
1194
1195(defconst idlwave-comment-line-start-skip "^[ \t]*;"
1196 "Regexp to match the start of a full-line comment.
1197That is the _beginning_ of a line containing a comment delimiter `;' preceded
1198only 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
1202not 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
1206not matter.")
1207
1208(defconst idlwave-end-unit-reg "\\<\\(pro\\|function\\)\\>\\|\\'"
1209 "Regular expression to find the line that indicates the end of unit.
1210This line is the end of buffer or the start of another unit. The case does
1211not 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
1219not 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.
1231The cars are the reserved words starting a block. If the block really
1232begins with BEGIN, the cars are the reserved words before the begin
1233which can be used to identify the block type.
1234This is used to check for the correct END type, to close blocks and
1235to 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
1240blocks starting with a BEGIN statement. The matches must have associations
1241`idlwave-block-matches'")
1242
1243(defconst idlwave-identifier "[a-zA-Z][a-zA-Z0-9$_]*"
1244 "Regular expression matching an IDL identifier.")
1245
1246(defconst idlwave-sysvar (concat "!" idlwave-identifier)
1247 "Regular expression matching IDL system variables.")
1248
1249(defconst idlwave-variable (concat idlwave-identifier "\\|" idlwave-sysvar)
1250 "Regular expression matching IDL variable names.")
1251
1252(defconst idlwave-label (concat idlwave-identifier ":")
1253 "Regular expression matching IDL labels.")
1254
1255(defconst idlwave-statement-match
1256 (list
1257 ;; "endif else" is the the only possible "end" that can be
1258 ;; followed by a statement on the same line.
1259 '(endelse . ("end\\(\\|if\\)\\s +else" "end\\(\\|if\\)\\s +else"))
1260 ;; all other "end"s can not be followed by a statement.
1261 (cons 'end (list idlwave-end-block-reg nil))
1262 '(if . ("if\\>" "then"))
1263 '(for . ("for\\>" "do"))
1264 '(begin . ("begin\\>" nil))
1265 '(pdef . ("pro\\>\\|function\\>" nil))
1266 '(while . ("while\\>" "do"))
1267 '(repeat . ("repeat\\>" "repeat"))
1268 '(goto . ("goto\\>" nil))
1269 '(case . ("case\\>" nil))
1270 (cons 'call (list (concat idlwave-identifier "\\(\\s *$\\|\\s *,\\)") nil))
595ab50b 1271 '(assign . ("[^=>\n]*=" nil)))
f32b3b91
CD
1272
1273 "Associated list of statement matching regular expressions.
1274Each regular expression matches the start of an IDL statement. The
1275first element of each association is a symbol giving the statement
1276type. The associated value is a list. The first element of this list
1277is a regular expression matching the start of an IDL statement for
1278identifying the statement type. The second element of this list is a
1279regular expression for finding a substatement for the type. The
1280substatement starts after the end of the found match modulo
1281whitespace. If it is nil then the statement has no substatement. The
1282list order matters since matching an assignment statement exactly is
1283not possible without parsing. Thus assignment statement become just
15e42531 1284the leftover unidentified statements containing an equal sign." )
f32b3b91
CD
1285
1286(defvar idlwave-fill-function 'auto-fill-function
1287 "IDL mode auto fill function.")
1288
1289(defvar idlwave-comment-indent-function 'comment-indent-function
1290 "IDL mode comment indent function.")
1291
1292;; Note that this is documented in the v18 manuals as being a string
1293;; of length one rather than a single character.
1294;; The code in this file accepts either format for compatibility.
1295(defvar idlwave-comment-indent-char ?\
1296 "Character to be inserted for IDL comment indentation.
1297Normally a space.")
1298
1299(defconst idlwave-continuation-char ?$
1300 "Character which is inserted as a last character on previous line by
1301 \\[idlwave-split-line] to begin a continuation line. Normally $.")
1302
15e42531 1303(defconst idlwave-mode-version " 4.2")
f32b3b91
CD
1304
1305(defmacro idlwave-keyword-abbrev (&rest args)
1306 "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args."
1307 (` (quote (lambda ()
1308 (, (append '(idlwave-check-abbrev) args))))))
1309
1310;; If I take the time I can replace idlwave-keyword-abbrev with
1311;; idlwave-code-abbrev and remove the quoted abbrev check from
1312;; idlwave-check-abbrev. Then, e.g, (idlwave-keyword-abbrev 0 t) becomes
1313;; (idlwave-code-abbrev idlwave-check-abbrev 0 t). In fact I should change
1314;; the name of idlwave-check-abbrev to something like idlwave-modify-abbrev.
1315
1316(defmacro idlwave-code-abbrev (&rest args)
1317 "Creates a function for abbrev hooks that ensures abbrevs are not quoted.
1318Specifically, if the abbrev is in a comment or string it is unexpanded.
1319Otherwise ARGS forms a list that is evaluated."
1320 (` (quote (lambda ()
1321 (, (prin1-to-string args)) ;; Puts the code in the doc string
15e42531
CD
1322 (if (idlwave-quoted)
1323 (progn (unexpand-abbrev) nil)
f32b3b91
CD
1324 (, (append args)))))))
1325
1326(defvar idlwave-mode-map (make-sparse-keymap)
1327 "Keymap used in IDL mode.")
1328
1329(defvar idlwave-mode-syntax-table (make-syntax-table)
1330 "Syntax table in use in `idlwave-mode' buffers.")
1331
1332(modify-syntax-entry ?+ "." idlwave-mode-syntax-table)
1333(modify-syntax-entry ?- "." idlwave-mode-syntax-table)
1334(modify-syntax-entry ?* "." idlwave-mode-syntax-table)
1335(modify-syntax-entry ?/ "." idlwave-mode-syntax-table)
1336(modify-syntax-entry ?^ "." idlwave-mode-syntax-table)
1337(modify-syntax-entry ?# "." idlwave-mode-syntax-table)
1338(modify-syntax-entry ?= "." idlwave-mode-syntax-table)
1339(modify-syntax-entry ?% "." idlwave-mode-syntax-table)
1340(modify-syntax-entry ?< "." idlwave-mode-syntax-table)
1341(modify-syntax-entry ?> "." idlwave-mode-syntax-table)
1342(modify-syntax-entry ?\' "\"" idlwave-mode-syntax-table)
1343(modify-syntax-entry ?\" "\"" idlwave-mode-syntax-table)
1344(modify-syntax-entry ?\\ "." idlwave-mode-syntax-table)
1345(modify-syntax-entry ?_ "_" idlwave-mode-syntax-table)
1346(modify-syntax-entry ?{ "(}" idlwave-mode-syntax-table)
1347(modify-syntax-entry ?} "){" idlwave-mode-syntax-table)
1348(modify-syntax-entry ?$ "_" idlwave-mode-syntax-table)
1349(modify-syntax-entry ?. "." idlwave-mode-syntax-table)
1350(modify-syntax-entry ?\; "<" idlwave-mode-syntax-table)
1351(modify-syntax-entry ?\n ">" idlwave-mode-syntax-table)
1352(modify-syntax-entry ?\f ">" idlwave-mode-syntax-table)
1353
1354(defvar idlwave-find-symbol-syntax-table
1355 (copy-syntax-table idlwave-mode-syntax-table)
1356 "Syntax table that treats symbol characters as word characters.")
1357
1358(modify-syntax-entry ?$ "w" idlwave-find-symbol-syntax-table)
1359(modify-syntax-entry ?_ "w" idlwave-find-symbol-syntax-table)
1360
15e42531
CD
1361(defmacro idlwave-with-special-syntax (&rest body)
1362 "Execute BODY with a different systax table."
1363 `(let ((saved-syntax (syntax-table)))
1364 (unwind-protect
1365 (progn
1366 (set-syntax-table idlwave-find-symbol-syntax-table)
1367 ,@body)
1368 (set-syntax-table saved-syntax))))
1369
f32b3b91
CD
1370(defun idlwave-action-and-binding (key cmd &optional select)
1371 "KEY and CMD are made into a key binding and an indent action.
1372KEY is a string - same as for the `define-key' function. CMD is a
1373function of no arguments or a list to be evaluated. CMD is bound to
1374KEY in `idlwave-mode-map' by defining an anonymous function calling
1375`self-insert-command' followed by CMD. If KEY contains more than one
1376character a binding will only be set if SELECT is 'both.
1377
1378(KEY . CMD\ is also placed in the `idlwave-indent-expand-table',
1379replacing any previous value for KEY. If a binding is not set then it
1380will instead be placed in `idlwave-indent-action-table'.
1381
1382If the optional argument SELECT is nil then an action and binding are
1383created. If SELECT is 'noaction, then a binding is always set and no
1384action is created. If SELECT is 'both then an action and binding
1385will both be created even if KEY contains more than one character.
1386Otherwise, if SELECT is non-nil then only an action is created.
1387
1388Some examples:
1389No spaces before and 1 after a comma
1390 (idlwave-action-and-binding \",\" '(idlwave-surround 0 1))
1391A minimum of 1 space before and after `=' (see `idlwave-expand-equal').
1392 (idlwave-action-and-binding \"=\" '(idlwave-expand-equal -1 -1))
1393Capitalize system variables - action only
1394 (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t)"
1395 (if (not (equal select 'noaction))
1396 ;; Add action
1397 (let* ((table (if select 'idlwave-indent-action-table
1398 'idlwave-indent-expand-table))
1399 (cell (assoc key (eval table))))
1400 (if cell
1401 ;; Replace action command
1402 (setcdr cell cmd)
1403 ;; New action
1404 (set table (append (eval table) (list (cons key cmd)))))))
1405 ;; Make key binding for action
1406 (if (or (and (null select) (= (length key) 1))
1407 (equal select 'noaction)
1408 (equal select 'both))
1409 (define-key idlwave-mode-map key
1410 (append '(lambda ()
1411 (interactive)
1412 (self-insert-command 1))
1413 (list (if (listp cmd)
1414 cmd
1415 (list cmd)))))))
1416
1417(fset 'idlwave-debug-map (make-sparse-keymap))
1418
595ab50b 1419(define-key idlwave-mode-map "\C-c " 'idlwave-hard-tab)
15e42531 1420(define-key idlwave-mode-map [(control tab)] 'idlwave-hard-tab)
595ab50b 1421;(define-key idlwave-mode-map "\C-c\C- " 'idlwave-hard-tab)
f32b3b91
CD
1422(define-key idlwave-mode-map "'" 'idlwave-show-matching-quote)
1423(define-key idlwave-mode-map "\"" 'idlwave-show-matching-quote)
1424(define-key idlwave-mode-map "\C-c;" 'idlwave-toggle-comment-region)
1425(define-key idlwave-mode-map "\C-\M-a" 'idlwave-beginning-of-subprogram)
1426(define-key idlwave-mode-map "\C-\M-e" 'idlwave-end-of-subprogram)
1427(define-key idlwave-mode-map "\C-c{" 'idlwave-beginning-of-block)
1428(define-key idlwave-mode-map "\C-c}" 'idlwave-end-of-block)
1429(define-key idlwave-mode-map "\C-c]" 'idlwave-close-block)
1430(define-key idlwave-mode-map "\M-\C-h" 'idlwave-mark-subprogram)
1431(define-key idlwave-mode-map "\M-\C-n" 'idlwave-forward-block)
1432(define-key idlwave-mode-map "\M-\C-p" 'idlwave-backward-block)
1433(define-key idlwave-mode-map "\M-\C-d" 'idlwave-down-block)
1434(define-key idlwave-mode-map "\M-\C-u" 'idlwave-backward-up-block)
1435(define-key idlwave-mode-map "\M-\r" 'idlwave-split-line)
1436(define-key idlwave-mode-map "\M-\C-q" 'idlwave-indent-subprogram)
1437(define-key idlwave-mode-map "\C-c\C-p" 'idlwave-previous-statement)
1438(define-key idlwave-mode-map "\C-c\C-n" 'idlwave-next-statement)
1439;; (define-key idlwave-mode-map "\r" 'idlwave-newline)
1440;; (define-key idlwave-mode-map "\t" 'idlwave-indent-line)
1441(define-key idlwave-mode-map "\C-c\C-a" 'idlwave-auto-fill-mode)
1442(define-key idlwave-mode-map "\M-q" 'idlwave-fill-paragraph)
1443(define-key idlwave-mode-map "\M-s" 'idlwave-edit-in-idlde)
1444(define-key idlwave-mode-map "\C-c\C-h" 'idlwave-doc-header)
1445(define-key idlwave-mode-map "\C-c\C-m" 'idlwave-doc-modification)
1446(define-key idlwave-mode-map "\C-c\C-c" 'idlwave-case)
1447(define-key idlwave-mode-map "\C-c\C-d" 'idlwave-debug-map)
1448(define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run)
15e42531 1449(define-key idlwave-mode-map "\C-c\C-d\C-b" 'idlwave-shell-break-here)
f32b3b91
CD
1450(define-key idlwave-mode-map "\C-c\C-f" 'idlwave-for)
1451;; (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-function)
1452;; (define-key idlwave-mode-map "\C-c\C-p" 'idlwave-procedure)
1453(define-key idlwave-mode-map "\C-c\C-r" 'idlwave-repeat)
1454(define-key idlwave-mode-map "\C-c\C-w" 'idlwave-while)
15e42531 1455(define-key idlwave-mode-map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers)
f32b3b91
CD
1456(define-key idlwave-mode-map "\C-c\C-s" 'idlwave-shell)
1457(define-key idlwave-mode-map "\C-c\C-l" 'idlwave-shell-recenter-shell-window)
15e42531 1458(define-key idlwave-mode-map "\C-c\C-b" 'idlwave-list-buffer-load-path-shadows)
22d5821d
CD
1459(autoload 'idlwave-shell "idlw-shell"
1460 "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'." t)
8c7b4ec8
EZ
1461(autoload 'idlwave-shell-send-command "idlw-shell")
1462(autoload 'idlwave-shell-recenter-shell-window "idlw-shell"
f32b3b91 1463 "Run `idlwave-shell' and switch back to current window" t)
8c7b4ec8 1464(autoload 'idlwave-shell-save-and-run "idlw-shell"
f32b3b91 1465 "Save and run buffer under the shell." t)
15e42531
CD
1466(autoload 'idlwave-shell-break-here "idlw-shell"
1467 "Set breakpoint in current line." t)
f32b3b91
CD
1468(define-key idlwave-mode-map "\C-c\C-v" 'idlwave-find-module)
1469(define-key idlwave-mode-map "\C-c?" 'idlwave-routine-info)
15e42531 1470(define-key idlwave-mode-map "\M-?" 'idlwave-context-help)
f32b3b91
CD
1471(define-key idlwave-mode-map [(meta tab)] 'idlwave-complete)
1472(define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info)
1473(define-key idlwave-mode-map "\C-c=" 'idlwave-resolve)
15e42531
CD
1474(define-key idlwave-mode-map
1475 (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])
1476 'idlwave-mouse-context-help)
f32b3b91
CD
1477
1478;; Set action and key bindings.
1479;; See description of the function `idlwave-action-and-binding'.
1480;; Automatically add spaces for the following characters
1481(idlwave-action-and-binding "&" '(idlwave-surround -1 -1))
1482(idlwave-action-and-binding "<" '(idlwave-surround -1 -1))
1483(idlwave-action-and-binding ">" '(idlwave-surround -1 -1 '(?-)))
595ab50b 1484(idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2))
f32b3b91
CD
1485(idlwave-action-and-binding "," '(idlwave-surround 0 -1))
1486;; Automatically add spaces to equal sign if not keyword
1487(idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1))
1488
1489;;;
1490;;; Abbrev Section
1491;;;
1492;;; When expanding abbrevs and the abbrev hook moves backward, an extra
1493;;; space is inserted (this is the space typed by the user to expanded
1494;;; the abbrev).
1495;;;
1496
1497(condition-case nil
1498 (modify-syntax-entry (string-to-char idlwave-abbrev-start-char)
1499 "w" idlwave-mode-syntax-table)
1500 (error nil))
1501
1502(defvar idlwave-mode-abbrev-table nil
1503 "Abbreviation table used for IDLWAVE mode")
1504(define-abbrev-table 'idlwave-mode-abbrev-table ())
1505(let ((abbrevs-changed nil) ;; mask the current value to avoid save
1506 (tb idlwave-mode-abbrev-table)
1507 (c idlwave-abbrev-start-char))
1508 ;;
1509 ;; Templates
1510 ;;
1511 (define-abbrev tb (concat c "c") "" (idlwave-code-abbrev idlwave-case))
1512 (define-abbrev tb (concat c "f") "" (idlwave-code-abbrev idlwave-for))
1513 (define-abbrev tb (concat c "fu") "" (idlwave-code-abbrev idlwave-function))
1514 (define-abbrev tb (concat c "pr") "" (idlwave-code-abbrev idlwave-procedure))
1515 (define-abbrev tb (concat c "r") "" (idlwave-code-abbrev idlwave-repeat))
1516 (define-abbrev tb (concat c "w") "" (idlwave-code-abbrev idlwave-while))
1517 (define-abbrev tb (concat c "i") "" (idlwave-code-abbrev idlwave-if))
1518 (define-abbrev tb (concat c "elif") "" (idlwave-code-abbrev idlwave-elif))
1519 ;;
1520 ;; Keywords, system functions, conversion routines
1521 ;;
1522 (define-abbrev tb (concat c "b") "begin" (idlwave-keyword-abbrev 0 t))
1523 (define-abbrev tb (concat c "co") "common" (idlwave-keyword-abbrev 0 t))
1524 (define-abbrev tb (concat c "cb") "byte()" (idlwave-keyword-abbrev 1))
1525 (define-abbrev tb (concat c "cx") "fix()" (idlwave-keyword-abbrev 1))
1526 (define-abbrev tb (concat c "cl") "long()" (idlwave-keyword-abbrev 1))
1527 (define-abbrev tb (concat c "cf") "float()" (idlwave-keyword-abbrev 1))
1528 (define-abbrev tb (concat c "cs") "string()" (idlwave-keyword-abbrev 1))
1529 (define-abbrev tb (concat c "cc") "complex()" (idlwave-keyword-abbrev 1))
1530 (define-abbrev tb (concat c "cd") "double()" (idlwave-keyword-abbrev 1))
1531 (define-abbrev tb (concat c "e") "else" (idlwave-keyword-abbrev 0 t))
1532 (define-abbrev tb (concat c "ec") "endcase" 'idlwave-show-begin)
1533 (define-abbrev tb (concat c "ee") "endelse" 'idlwave-show-begin)
1534 (define-abbrev tb (concat c "ef") "endfor" 'idlwave-show-begin)
1535 (define-abbrev tb (concat c "ei") "endif else if" 'idlwave-show-begin)
1536 (define-abbrev tb (concat c "el") "endif else" 'idlwave-show-begin)
1537 (define-abbrev tb (concat c "en") "endif" 'idlwave-show-begin)
1538 (define-abbrev tb (concat c "er") "endrep" 'idlwave-show-begin)
1539 (define-abbrev tb (concat c "ew") "endwhile" 'idlwave-show-begin)
1540 (define-abbrev tb (concat c "g") "goto," (idlwave-keyword-abbrev 0 t))
1541 (define-abbrev tb (concat c "h") "help," (idlwave-keyword-abbrev 0))
1542 (define-abbrev tb (concat c "k") "keyword_set()" (idlwave-keyword-abbrev 1))
1543 (define-abbrev tb (concat c "n") "n_elements()" (idlwave-keyword-abbrev 1))
1544 (define-abbrev tb (concat c "on") "on_error," (idlwave-keyword-abbrev 0))
1545 (define-abbrev tb (concat c "oi") "on_ioerror," (idlwave-keyword-abbrev 0 1))
1546 (define-abbrev tb (concat c "ow") "openw," (idlwave-keyword-abbrev 0))
1547 (define-abbrev tb (concat c "or") "openr," (idlwave-keyword-abbrev 0))
1548 (define-abbrev tb (concat c "ou") "openu," (idlwave-keyword-abbrev 0))
1549 (define-abbrev tb (concat c "p") "print," (idlwave-keyword-abbrev 0))
1550 (define-abbrev tb (concat c "pt") "plot," (idlwave-keyword-abbrev 0))
1551 (define-abbrev tb (concat c "re") "read," (idlwave-keyword-abbrev 0))
1552 (define-abbrev tb (concat c "rf") "readf," (idlwave-keyword-abbrev 0))
1553 (define-abbrev tb (concat c "ru") "readu," (idlwave-keyword-abbrev 0))
1554 (define-abbrev tb (concat c "rt") "return" (idlwave-keyword-abbrev 0))
1555 (define-abbrev tb (concat c "sc") "strcompress()" (idlwave-keyword-abbrev 1))
1556 (define-abbrev tb (concat c "sn") "strlen()" (idlwave-keyword-abbrev 1))
1557 (define-abbrev tb (concat c "sl") "strlowcase()" (idlwave-keyword-abbrev 1))
1558 (define-abbrev tb (concat c "su") "strupcase()" (idlwave-keyword-abbrev 1))
1559 (define-abbrev tb (concat c "sm") "strmid()" (idlwave-keyword-abbrev 1))
1560 (define-abbrev tb (concat c "sp") "strpos()" (idlwave-keyword-abbrev 1))
1561 (define-abbrev tb (concat c "st") "strput()" (idlwave-keyword-abbrev 1))
1562 (define-abbrev tb (concat c "sr") "strtrim()" (idlwave-keyword-abbrev 1))
1563 (define-abbrev tb (concat c "t") "then" (idlwave-keyword-abbrev 0 t))
1564 (define-abbrev tb (concat c "u") "until" (idlwave-keyword-abbrev 0 t))
1565 (define-abbrev tb (concat c "wu") "writeu," (idlwave-keyword-abbrev 0))
1566 (define-abbrev tb (concat c "ine") "if n_elements() eq 0 then"
1567 (idlwave-keyword-abbrev 11))
1568 (define-abbrev tb (concat c "inn") "if n_elements() ne 0 then"
1569 (idlwave-keyword-abbrev 11))
1570 (define-abbrev tb (concat c "np") "n_params()" (idlwave-keyword-abbrev 0))
1571 (define-abbrev tb (concat c "s") "size()" (idlwave-keyword-abbrev 1))
1572 (define-abbrev tb (concat c "wi") "widget_info()" (idlwave-keyword-abbrev 1))
1573 (define-abbrev tb (concat c "wc") "widget_control," (idlwave-keyword-abbrev 0))
1574
1575 ;; This section is reserved words only. (From IDL user manual)
1576 ;;
1577 (define-abbrev tb "and" "and" (idlwave-keyword-abbrev 0 t))
1578 (define-abbrev tb "begin" "begin" (idlwave-keyword-abbrev 0 t))
1579 (define-abbrev tb "case" "case" (idlwave-keyword-abbrev 0 t))
1580 (define-abbrev tb "common" "common" (idlwave-keyword-abbrev 0 t))
1581 (define-abbrev tb "do" "do" (idlwave-keyword-abbrev 0 t))
1582 (define-abbrev tb "else" "else" (idlwave-keyword-abbrev 0 t))
1583 (define-abbrev tb "end" "end" 'idlwave-show-begin-check)
1584 (define-abbrev tb "endcase" "endcase" 'idlwave-show-begin-check)
1585 (define-abbrev tb "endelse" "endelse" 'idlwave-show-begin-check)
1586 (define-abbrev tb "endfor" "endfor" 'idlwave-show-begin-check)
1587 (define-abbrev tb "endif" "endif" 'idlwave-show-begin-check)
1588 (define-abbrev tb "endrep" "endrep" 'idlwave-show-begin-check)
1589 (define-abbrev tb "endwhi" "endwhi" 'idlwave-show-begin-check)
1590 (define-abbrev tb "endwhile" "endwhile" 'idlwave-show-begin-check)
1591 (define-abbrev tb "eq" "eq" (idlwave-keyword-abbrev 0 t))
1592 (define-abbrev tb "for" "for" (idlwave-keyword-abbrev 0 t))
1593 (define-abbrev tb "function" "function" (idlwave-keyword-abbrev 0 t))
1594 (define-abbrev tb "ge" "ge" (idlwave-keyword-abbrev 0 t))
1595 (define-abbrev tb "goto" "goto" (idlwave-keyword-abbrev 0 t))
1596 (define-abbrev tb "gt" "gt" (idlwave-keyword-abbrev 0 t))
1597 (define-abbrev tb "if" "if" (idlwave-keyword-abbrev 0 t))
1598 (define-abbrev tb "le" "le" (idlwave-keyword-abbrev 0 t))
1599 (define-abbrev tb "lt" "lt" (idlwave-keyword-abbrev 0 t))
1600 (define-abbrev tb "mod" "mod" (idlwave-keyword-abbrev 0 t))
1601 (define-abbrev tb "ne" "ne" (idlwave-keyword-abbrev 0 t))
1602 (define-abbrev tb "not" "not" (idlwave-keyword-abbrev 0 t))
1603 (define-abbrev tb "of" "of" (idlwave-keyword-abbrev 0 t))
1604 (define-abbrev tb "on_ioerror" "on_ioerror" (idlwave-keyword-abbrev 0 t))
1605 (define-abbrev tb "or" "or" (idlwave-keyword-abbrev 0 t))
1606 (define-abbrev tb "pro" "pro" (idlwave-keyword-abbrev 0 t))
1607 (define-abbrev tb "repeat" "repeat" (idlwave-keyword-abbrev 0 t))
1608 (define-abbrev tb "then" "then" (idlwave-keyword-abbrev 0 t))
1609 (define-abbrev tb "until" "until" (idlwave-keyword-abbrev 0 t))
1610 (define-abbrev tb "while" "while" (idlwave-keyword-abbrev 0 t))
1611 (define-abbrev tb "xor" "xor" (idlwave-keyword-abbrev 0 t)))
1612
1613(defvar imenu-create-index-function)
1614(defvar extract-index-name-function)
1615(defvar prev-index-position-function)
1616(defvar imenu-extract-index-name-function)
1617(defvar imenu-prev-index-position-function)
1618;; defined later - so just make the compiler shut up
1619(defvar idlwave-mode-menu)
1620(defvar idlwave-mode-debug-menu)
1621
1622;;;###autoload
1623(defun idlwave-mode ()
1624 "Major mode for editing IDL and WAVE CL .pro files.
1625
1626The main features of this mode are
1627
16281. 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
16562. Routine Info
1657 ------------
1658 IDLWAVE displays information about the calling sequence and the accepted
1659 keyword parameters of a procedure or function with \\[idlwave-routine-info].
1660 \\[idlwave-find-module] jumps to the source file of a module.
1661 These commands know about system routines, all routines in idlwave-mode
1662 buffers and (when the idlwave-shell is active) about all modules
1663 currently compiled under this shell. Use \\[idlwave-update-routine-info] to update this
15e42531
CD
1664 information, which is also used for completion (see item 4).
1665
16663. Online IDL Help
1667 ---------------
1668 \\[idlwave-context-help] displays the IDL documentation relevant
1669 for the system variable, keyword, or routine at point. A single key
1670 stroke gets you directly to the right place in the docs. Two additional
1671 files (an ASCII version of the IDL documentation and a topics file) must
1672 be installed for this - check the IDLWAVE webpage for these files.
f32b3b91 1673
15e42531 16744. Completion
f32b3b91 1675 ----------
15e42531
CD
1676 \\[idlwave-complete] completes the names of procedures, functions
1677 class names and keyword parameters. It is context sensitive and
1678 figures out what is expected at point (procedure/function/keyword).
1679 Lower case strings are completed in lower case, other strings in
1680 mixed or upper case.
f32b3b91 1681
15e42531 16825. Code Templates and Abbreviations
f32b3b91
CD
1683 --------------------------------
1684 Many Abbreviations are predefined to expand to code fragments and templates.
1685 The abbreviations start generally with a `\\`. Some examples
1686
1687 \\pr PROCEDURE template
1688 \\fu FUNCTION template
1689 \\c CASE statement template
1690 \\f FOR loop template
1691 \\r REPEAT Loop template
1692 \\w WHILE loop template
1693 \\i IF statement template
1694 \\elif IF-ELSE statement template
1695 \\b BEGIN
1696
1697 For a full list, use \\[idlwave-list-abbrevs]. Some templates also have
1698 direct keybindings - see the list of keybindings below.
1699
1700 \\[idlwave-doc-header] inserts a documentation header at the beginning of the
1701 current program unit (pro, function or main). Change log entries
1702 can be added to the current program unit with \\[idlwave-doc-modification].
1703
15e42531 17046. Automatic Case Conversion
f32b3b91
CD
1705 -------------------------
1706 The case of reserved words and some abbrevs is controlled by
1707 `idlwave-reserved-word-upcase' and `idlwave-abbrev-change-case'.
1708
15e42531 17097. Automatic END completion
f32b3b91
CD
1710 ------------------------
1711 If the variable `idlwave-expand-generic-end' is non-nil, each END typed
1712 will be converted to the specific version, like ENDIF, ENDFOR, etc.
1713
15e42531 17148. Hooks
f32b3b91
CD
1715 -----
1716 Loading idlwave.el runs `idlwave-load-hook'.
1717 Turning on `idlwave-mode' runs `idlwave-mode-hook'.
1718
15e42531 17199. Documentation and Customization
f32b3b91
CD
1720 -------------------------------
1721 Info documentation for this package is available. Use \\[idlwave-info]
1722 to display (complain to your sysadmin if that does not work).
1723 For Postscript and HTML versions of the documentation, check IDLWAVE's
1724 homepage at `http://www.strw.leidenuniv.nl/~dominik/Tools/idlwave'.
1725 IDLWAVE has customize support - see the group `idlwave'.
1726
15e42531 172710.Keybindings
f32b3b91
CD
1728 -----------
1729 Here is a list of all keybindings of this mode.
1730 If some of the key bindings below show with ??, use \\[describe-key]
1731 followed by the key sequence to see what the key sequence does.
1732
1733\\{idlwave-mode-map}"
1734
1735 (interactive)
1736 (kill-all-local-variables)
1737
1738 (if idlwave-startup-message
1739 (message "Emacs IDLWAVE mode version %s." idlwave-mode-version))
1740 (setq idlwave-startup-message nil)
1741
1742 (setq local-abbrev-table idlwave-mode-abbrev-table)
1743 (set-syntax-table idlwave-mode-syntax-table)
1744
1745 (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action)
1746
1747 (make-local-variable idlwave-comment-indent-function)
1748 (set idlwave-comment-indent-function 'idlwave-comment-hook)
1749
1750 (set (make-local-variable 'comment-start-skip) ";+[ \t]*")
1751 (set (make-local-variable 'comment-start) ";")
1752 (set (make-local-variable 'require-final-newline) t)
1753 (set (make-local-variable 'abbrev-all-caps) t)
1754 (set (make-local-variable 'indent-tabs-mode) nil)
1755 (set (make-local-variable 'completion-ignore-case) t)
1756
1757 (use-local-map idlwave-mode-map)
1758
1759 (when (featurep 'easymenu)
1760 (easy-menu-add idlwave-mode-menu idlwave-mode-map)
1761 (easy-menu-add idlwave-mode-debug-menu idlwave-mode-map))
1762
1763 (setq mode-name "IDLWAVE")
1764 (setq major-mode 'idlwave-mode)
1765 (setq abbrev-mode t)
1766
1767 (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill)
1768 (setq comment-end "")
1769 (set (make-local-variable 'comment-multi-line) nil)
1770 (set (make-local-variable 'paragraph-separate) "[ \t\f]*$\\|[ \t]*;+[ \t]*$")
1771 (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]")
1772 (set (make-local-variable 'paragraph-ignore-fill-prefix) nil)
1773 (set (make-local-variable 'parse-sexp-ignore-comments) nil)
1774
1775 ;; Set tag table list to use IDLTAGS as file name.
1776 (if (boundp 'tag-table-alist)
1777 (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS")))
1778
1779 ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow
1780 ;; Following line is for Emacs - XEmacs uses the corresponding porperty
1781 ;; on the `idlwave-mode' symbol.
1782 (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults)
1783
1784 ;; Imenu setup
1785 (set (make-local-variable 'imenu-create-index-function)
1786 'imenu-default-create-index-function)
1787 (set (make-local-variable 'imenu-extract-index-name-function)
1788 'idlwave-unit-name)
1789 (set (make-local-variable 'imenu-prev-index-position-function)
1790 'idlwave-prev-index-position)
1791
1792 ;; Make a local post-command-hook and add our hook to it
1793 (make-local-hook 'post-command-hook)
15e42531
CD
1794 (add-hook 'post-command-hook 'idlwave-command-hook nil 'local)
1795
1796 ;; Make local hooks for buffer updates
1797 (make-local-hook 'kill-buffer-hook)
1798 (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local)
1799 (make-local-hook 'after-save-hook)
1800 (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local)
1801 (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local)
1802
1803 ;; Update the routine info with info about current buffer?
1804 (idlwave-new-buffer-update)
f32b3b91
CD
1805
1806 ;; Run the mode hook
1807 (run-hooks 'idlwave-mode-hook))
1808
1809;;
1810;; Done with start up and initialization code.
1811;; The remaining routines are the code formatting functions.
1812;;
1813
1814(defun idlwave-push-mark (&rest rest)
1815 "Push mark for compatibility with Emacs 18/19."
1816 (if (fboundp 'iconify-frame)
1817 (apply 'push-mark rest)
1818 (push-mark)))
1819
1820(defun idlwave-hard-tab ()
1821 "Inserts TAB in buffer in current position."
1822 (interactive)
1823 (insert "\t"))
1824
1825;;; This stuff is experimental
1826
1827(defvar idlwave-command-hook nil
1828 "If non-nil, a list that can be evaluated using `eval'.
1829It is evaluated in the lisp function `idlwave-command-hook' which is
1830placed in `post-command-hook'.")
1831
1832(defun idlwave-command-hook ()
1833 "Command run after every command.
1834Evaluates a non-nil value of the *variable* `idlwave-command-hook' and
1835sets 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.
1850Argument ARG is the number of characters to move point
1851backward if `idlwave-abbrev-move' is non-nil.
1852If optional argument RESERVED is non-nil then the expansion
1853consists of reserved words, which will be capitalized if
1854`idlwave-reserved-word-upcase' is non-nil.
1855Otherwise, the abbrev will be capitalized if `idlwave-abbrev-change-case'
1856is non-nil, unless its value is \`down in which case the abbrev will be
1857made into all lowercase.
1858Returns 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.
1883Moves to end of line if there is no comment delimiter.
1884Ignores comment delimiters in strings.
1885Returns 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'.
1917An 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.
1927Also checks if the correct end statement has been used."
15e42531
CD
1928 ;; Re-indent end line
1929 (if idlwave-reindent-end
1930 (idlwave-indent-line))
f32b3b91
CD
1931 ;; All end statements are reserved words
1932 (let* ((pos (point))
1933 end end1)
1934 (when (and (idlwave-check-abbrev 0 t)
1935 idlwave-show-block)
1936 (save-excursion
1937 ;; Move inside current block
1938 (setq end (buffer-substring
1939 (save-excursion (skip-chars-backward "a-zA-Z")
1940 (point))
1941 (point)))
1942 (idlwave-beginning-of-statement)
1943 (idlwave-block-jump-out -1 'nomark)
1944 (when (setq end1 (cdr (idlwave-block-master)))
1945 (cond
1946 ((null end1)) ; no-opeartion
1947 ((string= (downcase end) (downcase end1))
1948 (sit-for 1))
1949 ((string= (downcase end) "end")
1950 ;; A generic end
1951 (if idlwave-expand-generic-end
1952 (save-excursion
1953 (goto-char pos)
1954 (backward-char 3)
1955 (insert (if (string= end "END") (upcase end1) end1))
1956 (delete-char 3)))
1957 (sit-for 1))
1958 (t
1959 (beep)
1960 (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?"
1961 end1 end)
1962 (sit-for 1))))))))
1963
1964(defun idlwave-block-master ()
1965 (let ((case-fold-search t))
1966 (save-excursion
1967 (cond
1968 ((looking-at "pro\\|case\\|function\\>")
1969 (assoc (downcase (match-string 0)) idlwave-block-matches))
1970 ((looking-at "begin\\>")
1971 (let ((limit (save-excursion
1972 (idlwave-beginning-of-statement)
1973 (point))))
1974 (cond
1975 ((re-search-backward idlwave-block-match-regexp limit t)
1976 (assoc (downcase (match-string 1))
1977 idlwave-block-matches))
1978 ;;((re-search-backward ":[ \t]*\\=" limit t)
1979 ;; ;; seems to be a case thing
1980 ;; '("begin" . "end"))
1981 (t
1982 ;; Just a nromal block
1983 '("begin" . "end")))))
1984 (t nil)))))
1985
1986(defun idlwave-close-block ()
1987 "Terminate the current block with the correct END statement."
1988 (interactive)
1989
1990 ;; Start new line if we are not in a new line
1991 (unless (save-excursion
1992 (skip-chars-backward " \t")
1993 (bolp))
1994 (let ((idlwave-show-block nil))
1995 (newline-and-indent)))
1996
1997 ;; Check which end is needed and insert it.
1998 (let ((case-fold-search t) end)
1999 (save-excursion
2000 (idlwave-beginning-of-statement)
2001 (idlwave-block-jump-out -1 'nomark)
2002 (if (setq end (idlwave-block-master))
2003 (setq end (cdr end))
2004 (error "Cannot close block")))
2005 (insert end)
2006 (idlwave-newline)))
2007
595ab50b
CD
2008(defun idlwave-surround (&optional before after escape-chars length)
2009 "Surround the LENGTH characters before point with blanks.
2010LENGTH defaults to 1.
f32b3b91 2011Optional arguments BEFORE and AFTER affect the behavior before and
595ab50b
CD
2012after the characters (see also description of `idlwave-make-space'):
2013
2014nil do nothing
20150 force no spaces
2016integer > 0 force exactly n spaces
2017integer < 0 at least |n| spaces
f32b3b91
CD
2018
2019The function does nothing if any of the following conditions is true:
2020- `idlwave-surround-by-blank' is nil
2021- the character before point is inside a string or comment
595ab50b
CD
2022- the char preceeding the string to be surrounded is a member of ESCAPE-CHARS.
2023 This hack is used to avoid padding of `>' when it is part of
2024 the '->' operator. In this case, ESCAPE-CHARS would be '(?-)."
2025
2026 (setq length (or length 1)) ; establish a default for LENGTH
2027
2028 (when (and idlwave-surround-by-blank
2029 (not (idlwave-quoted))
2030 (not (memq (char-after (- (point) (1+ length))) escape-chars)))
2031 (backward-char length)
2032 (save-restriction
2033 (let ((here (point)))
2034 (skip-chars-backward " \t")
2035 (if (bolp)
2036 ;; avoid clobbering indent
2037 (progn
2038 (move-to-column (idlwave-calculate-indent))
2039 (if (<= (point) here)
2040 (narrow-to-region (point) here))
2041 (goto-char here)))
2042 (idlwave-make-space before))
2043 (skip-chars-forward " \t"))
2044 (forward-char length)
2045 (idlwave-make-space after)
2046 ;; Check to see if the line should auto wrap
15e42531 2047 (if (and (equal (char-after (1- (point))) ?\ )
595ab50b
CD
2048 (> (current-column) fill-column))
2049 (funcall auto-fill-function))))
f32b3b91
CD
2050
2051(defun idlwave-make-space (n)
2052 "Make space at point.
2053The space affected is all the spaces and tabs around point.
2054If n is non-nil then point is left abs(n) spaces from the beginning of
2055the contiguous space.
2056The amount of space at point is determined by N.
2057If the value of N is:
2058nil - do nothing.
595ab50b
CD
2059> 0 - exactly N spaces.
2060< 0 - a minimum of -N spaces, i.e., do not change if there are
2061 already -N spaces.
20620 - no spaces (i.e. remove any existing space)."
f32b3b91
CD
2063 (if (integerp n)
2064 (let
2065 ((start-col (progn (skip-chars-backward " \t") (current-column)))
2066 (left (point))
2067 (end-col (progn (skip-chars-forward " \t") (current-column))))
2068 (delete-horizontal-space)
2069 (cond
2070 ((> n 0)
2071 (idlwave-indent-to (+ start-col n))
2072 (goto-char (+ left n)))
2073 ((< n 0)
2074 (idlwave-indent-to end-col (- n))
2075 (goto-char (- left n)))
2076 ;; n = 0, done
2077 ))))
2078
2079(defun idlwave-newline ()
2080 "Inserts a newline and indents the current and previous line."
2081 (interactive)
2082 ;;
2083 ;; Handle unterminated single and double quotes
2084 ;; If not in a comment and in a string then insertion of a newline
2085 ;; will mean unbalanced quotes.
2086 ;;
2087 (if (and (not (idlwave-in-comment)) (idlwave-in-quote))
2088 (progn (beep)
2089 (message "Warning: unbalanced quotes?")))
2090 (newline)
2091 ;;
2092 ;; The current line is being split, the cursor should be at the
2093 ;; beginning of the new line skipping the leading indentation.
2094 ;;
2095 ;; The reason we insert the new line before indenting is that the
2096 ;; indenting could be confused by keywords (e.g. END) on the line
2097 ;; after the split point. This prevents us from just using
2098 ;; `indent-for-tab-command' followed by `newline-and-indent'.
2099 ;;
2100 (beginning-of-line 0)
2101 (idlwave-indent-line)
2102 (forward-line)
2103 (idlwave-indent-line))
2104
2105;;
2106;; Use global variable 'comment-column' to set parallel comment
2107;;
2108;; Modeled on lisp.el
2109;; Emacs Lisp and IDL (Wave CL) have identical comment syntax
2110(defun idlwave-comment-hook ()
2111 "Compute indent for the beginning of the IDL comment delimiter."
2112 (if (or (looking-at idlwave-no-change-comment)
2113 (if idlwave-begin-line-comment
2114 (looking-at idlwave-begin-line-comment)
2115 (looking-at "^;")))
2116 (current-column)
2117 (if (looking-at idlwave-code-comment)
2118 (if (save-excursion (skip-chars-backward " \t") (bolp))
2119 ;; On line by itself, indent as code
2120 (let ((tem (idlwave-calculate-indent)))
2121 (if (listp tem) (car tem) tem))
2122 ;; after code - do not change
2123 (current-column))
2124 (skip-chars-backward " \t")
2125 (max (if (bolp) 0 (1+ (current-column)))
2126 comment-column))))
2127
2128(defun idlwave-split-line ()
2129 "Continue line by breaking line at point and indent the lines.
2130For a code line insert continuation marker. If the line is a line comment
2131then the new line will contain a comment with the same indentation.
2132Splits strings with the IDL operator `+' if `idlwave-split-line-string' is
2133non-nil."
2134 (interactive)
15e42531
CD
2135 ;; Expand abbreviation, just like normal RET would.
2136 (and abbrev-mode (expand-abbrev))
f32b3b91
CD
2137 (let (beg)
2138 (if (not (idlwave-in-comment))
2139 ;; For code line add continuation.
2140 ;; Check if splitting a string.
2141 (progn
2142 (if (setq beg (idlwave-in-quote))
2143 (if idlwave-split-line-string
2144 ;; Split the string.
2145 (progn (insert (setq beg (char-after beg)) " + "
2146 idlwave-continuation-char beg)
2147 (backward-char 1))
2148 ;; Do not split the string.
2149 (beep)
2150 (message "Warning: continuation inside string!!")
2151 (insert " " idlwave-continuation-char))
2152 ;; Not splitting a string.
15e42531
CD
2153 (if (not (member (char-before) '(?\ ?\t)))
2154 (insert " "))
2155 (insert idlwave-continuation-char))
f32b3b91
CD
2156 (newline-and-indent))
2157 (indent-new-comment-line))
2158 ;; Indent previous line
2159 (setq beg (- (point-max) (point)))
2160 (forward-line -1)
2161 (idlwave-indent-line)
2162 (goto-char (- (point-max) beg))
2163 ;; Reindent new line
2164 (idlwave-indent-line)))
2165
2166(defun idlwave-beginning-of-subprogram ()
2167 "Moves point to the beginning of the current program unit."
2168 (interactive)
2169 (idlwave-find-key idlwave-begin-unit-reg -1))
2170
2171(defun idlwave-end-of-subprogram ()
2172 "Moves point to the start of the next program unit."
2173 (interactive)
2174 (idlwave-end-of-statement)
2175 (idlwave-find-key idlwave-end-unit-reg 1))
2176
2177(defun idlwave-mark-statement ()
2178 "Mark current IDL statement."
2179 (interactive)
2180 (idlwave-end-of-statement)
2181 (let ((end (point)))
2182 (idlwave-beginning-of-statement)
2183 (idlwave-push-mark end nil t)))
2184
2185(defun idlwave-mark-block ()
2186 "Mark containing block."
2187 (interactive)
2188 (idlwave-end-of-statement)
2189 (idlwave-backward-up-block -1)
2190 (idlwave-end-of-statement)
2191 (let ((end (point)))
2192 (idlwave-backward-block)
2193 (idlwave-beginning-of-statement)
2194 (idlwave-push-mark end nil t)))
2195
2196
2197(defun idlwave-mark-subprogram ()
2198 "Put mark at beginning of program, point at end.
2199The 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.
2210If 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.
2240With ARG: ARG >= 0 go forwards, ARG < 0 go backwards.
2241Returns 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.
2265The marks are pushed."
2266 (interactive)
2267 (let (beg
2268 (here (point)))
2269 (goto-char (point-max))
2270 (if (re-search-backward idlwave-doclib-start nil t)
2271 (progn
2272 (setq beg (progn (beginning-of-line) (point)))
2273 (if (re-search-forward idlwave-doclib-end nil t)
2274 (progn
2275 (forward-line 1)
2276 (idlwave-push-mark beg nil t)
2277 (message "Could not find end of doc library header.")))
2278 (message "Could not find doc library header start.")
2279 (goto-char here)))))
2280
15e42531
CD
2281
2282(defun idlwave-current-routine ()
2283 "Return (NAME TYPE CLASS) of current routine."
2284 (idlwave-routines)
2285 (save-excursion
2286 (idlwave-beginning-of-subprogram)
2287 (if (looking-at "[ \t]*\\<\\(pro\\|function\\)\\>\\s-+\\(\\([a-zA-Z0-9$_]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)")
2288 (let* ((type (if (string= (downcase (match-string 1)) "pro")
2289 'pro 'function))
2290 (class (idlwave-sintern-class (match-string 3)))
2291 (name (idlwave-sintern-routine-or-method (match-string 4) class)))
2292 (list name type class)))))
2293
f32b3b91
CD
2294(defvar idlwave-shell-prompt-pattern)
2295(defun idlwave-beginning-of-statement ()
2296 "Move to beginning of the current statement.
2297Skips back past statement continuations.
2298Point is placed at the beginning of the line whether or not this is an
2299actual 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.
2312Returns t if the current line before moving is the beginning of
2313the 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.
2343If not in a statement just moves to end of line. Returns position."
2344 (interactive)
2345 (while (and (idlwave-is-continuation-line)
2346 (= (forward-line 1) 0)))
2347 (end-of-line)
2348 (point))
2349
2350(defun idlwave-next-statement ()
2351 "Moves point to beginning of the next IDL statement.
2352 Returns t if that statement is the last
2353 non-comment IDL statement in the file, and nil otherwise."
2354 (interactive)
2355 (let (last-statement)
2356 (idlwave-end-of-statement)
2357 ;; skip blank lines, label lines, include lines and line comments
2358 (while (and (= (forward-line 1) 0)
2359 ;; The current statement is the last statement until
2360 ;; we reach a new statement.
2361 (setq last-statement
2362 (or
2363 (looking-at idlwave-comment-line-start-skip)
2364 (looking-at "[ \t]*$")
2365 (looking-at (concat "[ \t]*" idlwave-label "[ \t]*$"))
2366 (looking-at "^@")))))
2367 last-statement))
2368
15e42531 2369(defun idlwave-skip-label-or-case ()
f32b3b91
CD
2370 "Skip label or case statement element.
2371Returns position after label.
2372If there is no label point is not moved and nil is returned."
15e42531
CD
2373 ;; Case expressions and labels are terminated by a colon.
2374 ;; So we find the first colon in the line and make sure
2375 ;; - no `?' is before it (might be a ? b : c)
2376 ;; - it is not in a comment
2377 ;; - not in a string constant
2378 ;; - not in parenthesis (like a[0:3])
2379 ;; As many in this mode, this function is heuristic and not an exact
2380 ;; parser.
f32b3b91
CD
2381 (let ((start (point))
2382 (end (idlwave-find-key ":" 1 'nomark
2383 (save-excursion
2384 (idlwave-end-of-statement) (point)))))
2385 (if (and end
15e42531
CD
2386 (= (nth 0 (parse-partial-sexp start end)) 0)
2387 (not (string-match "\\?" (buffer-substring start end))))
f32b3b91
CD
2388 (progn
2389 (forward-char)
2390 (point))
2391 (goto-char start)
2392 nil)))
2393
2394(defun idlwave-start-of-substatement (&optional pre)
2395 "Move to start of next IDL substatement after point.
2396Uses the type of the current IDL statement to determine if the next
2397statement is on a new line or is a subpart of the current statement.
2398Returns point at start of substatement modulo whitespace.
2399If optional argument is non-nil move to beginning of current
15e42531 2400substatement."
f32b3b91
CD
2401 (let ((orig (point))
2402 (eos (idlwave-end-of-statement))
2403 (ifnest 0)
2404 st nst last)
2405 (idlwave-beginning-of-statement)
15e42531 2406 (idlwave-skip-label-or-case)
f32b3b91
CD
2407 (setq last (point))
2408 ;; Continue looking for substatements until we are past orig
2409 (while (and (<= (point) orig) (not (eobp)))
2410 (setq last (point))
2411 (setq nst (nth 1 (cdr (setq st (car (idlwave-statement-type))))))
2412 (if (equal (car st) 'if) (setq ifnest (1+ ifnest)))
2413 (cond ((and nst
2414 (idlwave-find-key nst 1 'nomark eos))
2415 (goto-char (match-end 0)))
2416 ((and (> ifnest 0) (idlwave-find-key "\\<else\\>" 1 'nomark eos))
2417 (setq ifnest (1- ifnest))
2418 (goto-char (match-end 0)))
2419 (t (setq ifnest 0)
2420 (idlwave-next-statement))))
2421 (if pre (goto-char last))
15e42531
CD
2422 ;; If a continuation line starts here, move to next line
2423 (if (looking-at "[ \t]*\\$\\([ \t]*\\(;\\|$\\)\\)")
2424 (beginning-of-line 2))
f32b3b91
CD
2425 (point)))
2426
2427(defun idlwave-statement-type ()
2428 "Return the type of the current IDL statement.
2429Uses `idlwave-statement-match' to return a cons of (type . point) with
2430point the ending position where the type was determined. Type is the
2431association from `idlwave-statement-match', i.e. the cons cell from the
2432list not just the type symbol. Returns nil if not an identifiable
2433statement."
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.
2448Two cases: Assignment statement, and keyword assignment.
2449The case is determined using `idlwave-start-of-substatement' and
2450`idlwave-statement-type'.
2451The equal sign will be surrounded by BEFORE and AFTER blanks.
15e42531
CD
2452If `idlwave-pad-keyword' is t then keyword assignment is treated just
2453like assignment statements. When nil, spaces are removed for keyword
2454assignment. Any other value keeps the current space around the `='.
f32b3b91
CD
2455Limits in for loops are treated as keyword assignment.
2456See `idlwave-surround'. "
2457 ;; Even though idlwave-surround checks `idlwave-surround-by-blank' this
2458 ;; check saves the time of finding the statement type.
2459 (if idlwave-surround-by-blank
2460 (let ((st (save-excursion
2461 (idlwave-start-of-substatement t)
2462 (idlwave-statement-type))))
15e42531
CD
2463
2464 (cond ((or (and (equal (car (car st)) 'assign)
2465 (equal (cdr st) (point)))
2466 (eq t idlwave-pad-keyword))
2467 ;; An assignment statement or keywor and we need padding
2468 (idlwave-surround before after))
2469 ((null idlwave-pad-keyword)
2470 ;; Spaces should be removed at a keyword
2471 (idlwave-surround 0 0))
2472 (t)))))
f32b3b91
CD
2473
2474(defun idlwave-indent-and-action ()
2475 "Call `idlwave-indent-line' and do expand actions."
2476 (interactive)
2477 (idlwave-indent-line t)
2478 )
2479
2480(defun idlwave-indent-line (&optional expand)
2481 "Indents current IDL line as code or as a comment.
2482The actions in `idlwave-indent-action-table' are performed.
2483If 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.
2536ACTION is a list (REG . FUNC). REG is a regular expression. FUNC is
2537either a function name to be called with `funcall' or a list to be
2538evaluated with `eval'. The action performed by FUNC should leave point
2539after 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.
2550Inserts space before markers at point."
2551 (if (not min) (setq min 0))
2552 (insert-before-markers
15e42531 2553 (make-string (max min (- col (current-column))) ?\ )))
f32b3b91
CD
2554
2555(defun idlwave-indent-left-margin (col)
2556 "Indent the current line to column COL.
2557Indents such that first non-whitespace character is at column COL
2558Inserts 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.
2623Note that here previous statement means the beginning of the current
2624statement if this statement is a continuation of the previous line.
2625Intervening comments or comments within the previous statement can
2626screw things up if the comments contain parentheses characters."
2627 (save-excursion
2628 (let* (open
2629 (case-fold-search t)
2630 (end-reg (progn (beginning-of-line) (point)))
2631 (close-exp (progn (skip-chars-forward " \t") (looking-at "\\s)")))
2632 (beg-reg (progn (idlwave-previous-statement) (point))))
2633 ;;
2634 ;; If PRO or FUNCTION declaration indent after name, and first comma.
2635 ;;
2636 (if (idlwave-look-at "\\<\\(pro\\|function\\)\\>")
2637 (progn
2638 (forward-sexp 1)
2639 (if (looking-at "[ \t]*,[ \t]*")
2640 (goto-char (match-end 0)))
2641 (current-column))
2642 ;;
2643 ;; Not a PRO or FUNCTION
2644 ;;
2645 ;; Look for innermost unmatched open paren
2646 ;;
2647 (if (setq open (car (cdr (parse-partial-sexp beg-reg end-reg))))
2648 ;; Found innermost open paren.
2649 (progn
2650 (goto-char open)
2651 ;; Line up with next word unless this is a closing paren.
2652 (cond
2653 ;; This is a closed paren - line up under open paren.
2654 (close-exp
2655 (current-column))
2656 ;; Empty - just add regular indent. Take into account
2657 ;; the forward-char
2658 ((progn
2659 ;; Skip paren
2660 (forward-char 1)
2661 (looking-at "[ \t$]*$"))
2662 (+ (current-column) idlwave-continuation-indent -1))
2663 ;; Line up with first word
2664 ((progn
2665 (skip-chars-forward " \t")
2666 (current-column)))))
2667 ;; No unmatched open paren. Just a simple continuation.
2668 (goto-char beg-reg)
2669 (+ (idlwave-current-indent)
2670 ;; Make adjustments based on current line
2671 (cond
2672 ;; Else statement
2673 ((progn
2674 (goto-char end-reg)
2675 (skip-chars-forward " \t")
2676 (looking-at "else"))
2677 0)
2678 ;; Ordinary continuation
2679 (idlwave-continuation-indent))))))))
2680
15e42531 2681(defun idlwave-find-key-old (key-reg &optional dir nomark limit)
f32b3b91
CD
2682 "Move in direction of the optional second argument DIR to the
2683next keyword not contained in a comment or string and occurring before
2684optional fourth argument LIMIT. DIR defaults to forward direction. If
2685DIR is negative the search is backwards, otherwise, it is
2686forward. LIMIT defaults to the beginning or end of the buffer
2687according to the direction of the search. The keyword is given by the
2688regular expression argument KEY-REG. The search is case insensitive.
2689Returns position if successful and nil otherwise. If found
2690`push-mark' is executed unless the optional third argument NOMARK is
2691non-nil. If found, the point is left at the keyword beginning."
2692 (or dir (setq dir 0))
2693 (or limit (setq limit (cond ((>= dir 0) (point-max)) ((point-min)))))
2694 (let (found
f32b3b91 2695 (case-fold-search t))
15e42531
CD
2696 (idlwave-with-special-syntax
2697 (save-excursion
2698 (if (>= dir 0)
2699 (while (and (setq found (and
2700 (re-search-forward key-reg limit t)
2701 (match-beginning 0)))
2702 (idlwave-quoted)
2703 (not (eobp))))
2704 (while (and (setq found (and
2705 (re-search-backward key-reg limit t)
2706 (match-beginning 0)))
2707 (idlwave-quoted)
2708 (not (bobp)))))))
f32b3b91
CD
2709 (if found (progn
2710 (if (not nomark) (push-mark))
2711 (goto-char found)))))
2712
15e42531
CD
2713;; FIXME: The following is an experimental re-write of the previous
2714;; function. Still needs to be tested.
2715(defun idlwave-find-key (key-re &optional dir nomark limit)
2716 "Move to next match of the regular expression KEY-RE.
2717Matches inside comments or string constants will be ignored.
2718If DIR is negative, the search will be backwards.
2719At a successful match, the mark is pushed unless NOMARK is non-nil.
2720Searches are limited to LIMIT.
2721Searches are case-insensitive and use a special syntax table which
2722treats `$' and `_' as word characters.
2723Return value is the beginning of the match or (in case of failure) nil."
2724 (setq dir (or dir 0))
2725 (let ((case-fold-search t)
2726 (search-func (if (> dir 0) 're-search-forward 're-search-backward))
2727 found)
2728 (idlwave-with-special-syntax
2729 (save-excursion
2730 (catch 'exit
2731 (while (funcall search-func key-re limit t)
2732 (if (not (idlwave-quoted))
2733 (throw 'exit (setq found (match-beginning 0))))))))
2734 (if found
2735 (progn
2736 (if (not nomark) (push-mark))
2737 (goto-char found)
2738 found)
2739 nil)))
2740
f32b3b91
CD
2741(defun idlwave-block-jump-out (&optional dir nomark)
2742 "When optional argument DIR is non-negative, move forward to end of
2743current block using the `idlwave-begin-block-reg' and `idlwave-end-block-reg'
2744regular expressions. When DIR is negative, move backwards to block beginning.
2745Recursively calls itself to skip over nested blocks. DIR defaults to
2746forward. Calls `push-mark' unless the optional argument NOMARK is
2747non-nil. Movement is limited by the start of program units because of
2748possibility 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.
2780If 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.
2786Skips any whitespace. Returns 0 if the end-of-line follows the whitespace."
2787 (save-excursion
2788 (beginning-of-line)
2789 (skip-chars-forward " \t")
2790 ;; if we are at the end of blank line return 0
2791 (cond ((eolp) 0)
2792 ((current-column)))))
2793
2794(defun idlwave-is-continuation-line ()
2795 "Tests if current line is continuation line."
2796 (save-excursion
2797 (idlwave-look-at "\\<\\$")))
2798
2799(defun idlwave-is-comment-line ()
2800 (save-excursion
2801 (beginning-of-line 1)
2802 (looking-at "[ \t]*;")))
2803
2804(defun idlwave-look-at (regexp &optional cont beg)
15e42531
CD
2805 "Searches current line from current point for REGEXP.
2806If optional argument CONT is non-nil, searches to the end of
2807the current statement.
2808If optional arg BEG is non-nil, search starts from the beginning of the
2809current statement.
2810Ignores matches that end in a comment or inside a string expression.
2811Returns point if successful, nil otherwise.
2812This function produces unexpected results if REGEXP contains quotes or
2813a comment delimiter. The search is case insensitive.
2814If successful leaves point after the match, otherwise, does not move point."
f32b3b91 2815 (let ((here (point))
f32b3b91 2816 (case-fold-search t)
15e42531
CD
2817 (eos (save-excursion
2818 (if cont (idlwave-end-of-statement) (end-of-line))
2819 (point)))
f32b3b91 2820 found)
15e42531
CD
2821 (idlwave-with-special-syntax
2822 (if beg (idlwave-beginning-of-statement))
2823 (while (and (setq found (re-search-forward regexp eos t))
2824 (idlwave-quoted))))
f32b3b91
CD
2825 (if (not found) (goto-char here))
2826 found))
2827
2828(defun idlwave-fill-paragraph (&optional nohang)
2829 "Fills paragraphs in comments.
2830A paragraph is made up of all contiguous lines having the same comment
2831leader (the leading whitespace before the comment delimiter and the
2832comment delimiter). In addition, paragraphs are separated by blank
2833line comments. The indentation is given by the hanging indent of the
2834first line, otherwise by the minimum indentation of the lines after
2835the first line. The indentation of the first line does not change.
2836Does not effect code lines. Does not fill comments on the same line
2837with code. The hanging indent is given by the end of the first match
2838matching `idlwave-hang-indent-regexp' on the paragraph's first line . If the
2839optional argument NOHANG is non-nil then the hanging indent is
2840ignored."
2841 (interactive "P")
2842 ;; check if this is a line comment
2843 (if (save-excursion
2844 (beginning-of-line)
2845 (skip-chars-forward " \t")
2846 (looking-at comment-start))
2847 (let
2848 ((indent 999)
2849 pre here diff fill-prefix-reg bcl first-indent
2850 hang start end)
2851 ;; Change tabs to spaces in the surrounding paragraph.
2852 ;; The surrounding paragraph will be the largest containing block of
2853 ;; contiguous line comments. Thus, we may be changing tabs in
2854 ;; a much larger area than is needed, but this is the easiest
2855 ;; brute force way to do it.
2856 ;;
2857 ;; This has the undesirable side effect of replacing the tabs
2858 ;; permanently without the user's request or knowledge.
2859 (save-excursion
2860 (backward-paragraph)
2861 (setq start (point)))
2862 (save-excursion
2863 (forward-paragraph)
2864 (setq end (point)))
2865 (untabify start end)
2866 ;;
2867 (setq here (point))
2868 (beginning-of-line)
2869 (setq bcl (point))
2870 (re-search-forward
2871 (concat "^[ \t]*" comment-start "+")
2872 (save-excursion (end-of-line) (point))
2873 t)
2874 ;; Get the comment leader on the line and its length
2875 (setq pre (current-column))
2876 ;; the comment leader is the indentation plus exactly the
2877 ;; number of consecutive ";".
2878 (setq fill-prefix-reg
2879 (concat
2880 (setq fill-prefix
2881 (regexp-quote
2882 (buffer-substring (save-excursion
2883 (beginning-of-line) (point))
2884 (point))))
2885 "[^;]"))
2886
2887 ;; Mark the beginning and end of the paragraph
2888 (goto-char bcl)
2889 (while (and (looking-at fill-prefix-reg)
2890 (not (looking-at paragraph-separate))
2891 (not (bobp)))
2892 (forward-line -1))
2893 ;; Move to first line of paragraph
2894 (if (/= (point) bcl)
2895 (forward-line 1))
2896 (setq start (point))
2897 (goto-char bcl)
2898 (while (and (looking-at fill-prefix-reg)
2899 (not (looking-at paragraph-separate))
2900 (not (eobp)))
2901 (forward-line 1))
2902 (beginning-of-line)
2903 (if (or (not (looking-at fill-prefix-reg))
2904 (looking-at paragraph-separate))
2905 (forward-line -1))
2906 (end-of-line)
2907 ;; if at end of buffer add a newline (need this because
2908 ;; fill-region needs END to be at the beginning of line after
2909 ;; the paragraph or it will add a line).
2910 (if (eobp)
2911 (progn (insert ?\n) (backward-char 1)))
2912 ;; Set END to the beginning of line after the paragraph
2913 ;; END is calculated as distance from end of buffer
2914 (setq end (- (point-max) (point) 1))
2915 ;;
2916 ;; Calculate the indentation for the paragraph.
2917 ;;
2918 ;; In the following while statements, after one iteration
2919 ;; point will be at the beginning of a line in which case
2920 ;; the while will not be executed for the
2921 ;; the first paragraph line and thus will not affect the
2922 ;; indentation.
2923 ;;
2924 ;; First check to see if indentation is based on hanging indent.
2925 (if (and (not nohang) idlwave-hanging-indent
2926 (setq hang
2927 (save-excursion
2928 (goto-char start)
2929 (idlwave-calc-hanging-indent))))
2930 ;; Adjust lines of paragraph by inserting spaces so that
2931 ;; each line's indent is at least as great as the hanging
2932 ;; indent. This is needed for fill-paragraph to work with
2933 ;; a fill-prefix.
2934 (progn
2935 (setq indent hang)
2936 (beginning-of-line)
2937 (while (> (point) start)
2938 (re-search-forward comment-start-skip
2939 (save-excursion (end-of-line) (point))
2940 t)
2941 (if (> (setq diff (- indent (current-column))) 0)
2942 (progn
2943 (if (>= here (point))
2944 ;; adjust the original location for the
2945 ;; inserted text.
2946 (setq here (+ here diff)))
15e42531 2947 (insert (make-string diff ?\ ))))
f32b3b91
CD
2948 (forward-line -1))
2949 )
2950
2951 ;; No hang. Instead find minimum indentation of paragraph
2952 ;; after first line.
2953 ;; For the following while statement, since START is at the
2954 ;; beginning of line and END is at the the end of line
2955 ;; point is greater than START at least once (which would
2956 ;; be the case for a single line paragraph).
2957 (while (> (point) start)
2958 (beginning-of-line)
2959 (setq indent
2960 (min indent
2961 (progn
2962 (re-search-forward
2963 comment-start-skip
2964 (save-excursion (end-of-line) (point))
2965 t)
2966 (current-column))))
2967 (forward-line -1))
2968 )
2969 (setq fill-prefix (concat fill-prefix
2970 (make-string (- indent pre)
15e42531 2971 ?\ )))
f32b3b91
CD
2972 ;; first-line indent
2973 (setq first-indent
2974 (max
2975 (progn
2976 (re-search-forward
2977 comment-start-skip
2978 (save-excursion (end-of-line) (point))
2979 t)
2980 (current-column))
2981 indent))
2982
2983 ;; try to keep point at its original place
2984 (goto-char here)
2985
2986 ;; In place of the more modern fill-region-as-paragraph, a hack
2987 ;; to keep whitespace untouched on the first line within the
2988 ;; indent length and to preserve any indent on the first line
2989 ;; (first indent).
2990 (save-excursion
2991 (setq diff
2992 (buffer-substring start (+ start first-indent -1)))
15e42531 2993 (subst-char-in-region start (+ start first-indent -1) ?\ ?~ nil)
f32b3b91
CD
2994 (fill-region-as-paragraph
2995 start
2996 (- (point-max) end)
2997 (current-justification)
2998 nil)
2999 (delete-region start (+ start first-indent -1))
3000 (goto-char start)
3001 (insert diff))
3002 ;; When we want the point at the beginning of the comment
3003 ;; body fill-region will put it at the beginning of the line.
3004 (if (bolp) (skip-chars-forward (concat " \t" comment-start)))
3005 (setq fill-prefix nil))))
3006
3007(defun idlwave-calc-hanging-indent ()
3008 "Calculate the position of the hanging indent for the comment
3009paragraph. The hanging indent position is given by the first match
3010with the `idlwave-hang-indent-regexp'. If `idlwave-use-last-hang-indent' is
3011non-nil then use last occurrence matching `idlwave-hang-indent-regexp' on
3012the line.
3013If 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.
3032Only fills comment lines if `idlwave-fill-comment-line-only' is non-nil.
3033Places a continuation character at the end of the line
3034if 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.
3127With arg, turn auto-fill mode on if arg is positive.
3128In auto-fill mode, inserting a space at a column beyond `fill-column'
3129automatically 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.
3142Inserts the value of the variable idlwave-file-header. Sets mark before
3143moving to do insertion unless the optional prefix argument NOMARK
3144is 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.
3176Looks for an occurrence of the value of user variable
3177`idlwave-doc-modifications-keyword' if non-nil. Inserts time and user name
3178and places the point for the user to add a log. Before moving, saves
3179location 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.
3216Calling 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.
3226nil otherwise."
3227 (or (idlwave-in-comment) (idlwave-in-quote)))
3228
3229(defun idlwave-in-quote ()
3230 "Returns location of the opening quote
3231if point is in a IDL string constant, nil otherwise.
3232Ignores comment delimiters on the current line.
3233Properly handles nested quotation marks and octal
3234constants - 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
3291Opens a line if point is not followed by a newline modulo intervening
3292whitespace. S1 and S2 are strings. S1 is inserted at point followed
595ab50b
CD
3293by S2. Point is inserted between S1 and S2. The case of S1 and S2 is
3294adjusted according to `idlwave-abbrev-change-case'. If optional argument
f32b3b91
CD
3295PROMPT is a string then it is displayed as a message in the
3296minibuffer. The PROMPT serves as a reminder to the user of an
3297expression to enter.
3298
3299The lines containing S1 and S2 are reindented using `indent-region'
3300unless the optional second argument NOINDENT is non-nil."
15e42531
CD
3301 (if (eq major-mode 'idlwave-shell-mode)
3302 ;; This is a gross hack to avoit template abbrev expasion
3303 ;; in the shell. FIXME: This is a dirty hack.
3304 (if (and (eq this-command 'self-insert-command)
3305 (equal last-abbrev-location (point)))
3306 (insert last-abbrev-text)
3307 (error "No templates in idlwave-shell"))
3308 (cond ((eq idlwave-abbrev-change-case 'down)
3309 (setq s1 (downcase s1) s2 (downcase s2)))
3310 (idlwave-abbrev-change-case
3311 (setq s1 (upcase s1) s2 (upcase s2))))
3312 (let ((beg (save-excursion (beginning-of-line) (point)))
3313 end)
3314 (if (not (looking-at "\\s-*\n"))
3315 (open-line 1))
3316 (insert s1)
3317 (save-excursion
3318 (insert s2)
3319 (setq end (point)))
3320 (if (not noindent)
3321 (indent-region beg end nil))
3322 (if (stringp prompt)
3323 (message prompt)))))
3324
595ab50b
CD
3325(defun idlwave-rw-case (string)
3326 "Make STRING have the case required by `idlwave-reserved-word-upcase'."
3327 (if idlwave-reserved-word-upcase
3328 (upcase string)
3329 string))
3330
f32b3b91
CD
3331(defun idlwave-elif ()
3332 "Build skeleton IDL if-else block."
3333 (interactive)
595ab50b
CD
3334 (idlwave-template
3335 (idlwave-rw-case "if")
3336 (idlwave-rw-case " then begin\n\nendif else begin\n\nendelse")
3337 "Condition expression"))
f32b3b91
CD
3338
3339(defun idlwave-case ()
3340 "Build skeleton IDL case statement."
3341 (interactive)
595ab50b
CD
3342 (idlwave-template
3343 (idlwave-rw-case "case")
3344 (idlwave-rw-case " of\n\nendcase")
3345 "Selector expression"))
f32b3b91
CD
3346
3347(defun idlwave-for ()
3348 "Build skeleton for loop statment."
3349 (interactive)
595ab50b
CD
3350 (idlwave-template
3351 (idlwave-rw-case "for")
3352 (idlwave-rw-case " do begin\n\nendfor")
3353 "Loop expression"))
f32b3b91
CD
3354
3355(defun idlwave-if ()
3356 "Build skeleton for loop statment."
3357 (interactive)
595ab50b
CD
3358 (idlwave-template
3359 (idlwave-rw-case "if")
3360 (idlwave-rw-case " then begin\n\nendif")
3361 "Scalar logical expression"))
f32b3b91
CD
3362
3363(defun idlwave-procedure ()
3364 (interactive)
595ab50b
CD
3365 (idlwave-template
3366 (idlwave-rw-case "pro")
3367 (idlwave-rw-case "\n\nreturn\nend")
3368 "Procedure name"))
f32b3b91
CD
3369
3370(defun idlwave-function ()
3371 (interactive)
595ab50b
CD
3372 (idlwave-template
3373 (idlwave-rw-case "function")
3374 (idlwave-rw-case "\n\nreturn\nend")
3375 "Function name"))
f32b3b91
CD
3376
3377(defun idlwave-repeat ()
3378 (interactive)
595ab50b
CD
3379 (idlwave-template
3380 (idlwave-rw-case "repeat begin\n\nendrep until")
3381 (idlwave-rw-case "")
3382 "Exit condition"))
f32b3b91
CD
3383
3384(defun idlwave-while ()
3385 (interactive)
595ab50b
CD
3386 (idlwave-template
3387 (idlwave-rw-case "while")
3388 (idlwave-rw-case " do begin\n\nendwhile")
3389 "Entry condition"))
f32b3b91
CD
3390
3391(defun idlwave-split-string (string &optional pattern)
3392 "Return a list of substrings of STRING which are separated by PATTERN.
3393If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
3394 (or pattern
3395 (setq pattern "[ \f\t\n\r\v]+"))
3396 (let (parts (start 0))
3397 (while (string-match pattern string start)
3398 (setq parts (cons (substring string start (match-beginning 0)) parts)
3399 start (match-end 0)))
3400 (nreverse (cons (substring string start) parts))))
3401
3402(defun idlwave-replace-string (string replace_string replace_with)
3403 (let* ((start 0)
3404 (last (length string))
3405 (ret_string "")
3406 end)
3407 (while (setq end (string-match replace_string string start))
3408 (setq ret_string
3409 (concat ret_string (substring string start end) replace_with))
3410 (setq start (match-end 0)))
3411 (setq ret_string (concat ret_string (substring string start last)))))
3412
3413(defun idlwave-get-buffer-visiting (file)
3414 ;; Return the buffer currently visiting FILE
3415 (cond
3416 ((boundp 'find-file-compare-truenames) ; XEmacs
3417 (let ((find-file-compare-truenames t))
3418 (get-file-buffer file)))
3419 ((fboundp 'find-buffer-visiting) ; Emacs
3420 (find-buffer-visiting file))
3421 (t (error "This should not happen (idlwave-get-buffer-visiting)"))))
3422
15e42531
CD
3423(defvar idlwave-outlawed-buffers nil
3424 "List of buffer pulled up by idlwave for special reasons.
3425Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.")
3426
3427(defun idlwave-find-file-noselect (file &optional why)
f32b3b91
CD
3428 ;; Return a buffer visiting file.
3429 (or (idlwave-get-buffer-visiting file)
15e42531
CD
3430 (let ((buf (find-file-noselect file)))
3431 (if why (add-to-list 'idlwave-outlawed-buffers (cons buf why)))
3432 buf)))
3433
3434(defun idlwave-kill-autoloaded-buffers ()
3435 "Cleanup by killing buffers created automatically by IDLWAVE.
3436Function prompts for a letter to identify the buffers to kill.
3437Possible letters are:
3438
3439f Buffers created by the command \\[idlwave-find-module] or mouse
3440 clicks in the routine info window.
3441s Buffers created by the IDLWAVE Shell to display where execution
3442 stopped or an error was found.
3443a Both of the above.
3444
3445Buffer 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.
3488Killing would be done by `idlwave-do-kill-autoloaded-buffers'.
3489Intended for `after-save-hook'."
3490 (let* ((buf (current-buffer))
3491 (entry (assq buf idlwave-outlawed-buffers)))
3492 ;; Revoke license
3493 (if entry
3494 (setq idlwave-outlawed-buffers
3495 (delq entry idlwave-outlawed-buffers)))
3496 ;; Remove this function from the hook.
3497 (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local)))
3498
3499(defvar idlwave-path-alist)
3500(defun idlwave-locate-lib-file (file)
f32b3b91 3501 ;; Find FILE on the scanned lib path and return a buffer visiting it
15e42531 3502 (let* ((dirs idlwave-path-alist)
f32b3b91
CD
3503 dir efile)
3504 (catch 'exit
15e42531 3505 (while (setq dir (car (pop dirs)))
f32b3b91
CD
3506 (if (file-regular-p
3507 (setq efile (expand-file-name file dir)))
15e42531
CD
3508 (throw 'exit efile))))))
3509(defun idlwave-expand-lib-file-name (file)
3510 ;; Find FILE on the scanned lib path and return a buffer visiting it
3511 (cond
3512 ((null file) nil)
3513 ((string-match "\\`\\({\\([0-9]+\\)}/\\)\\(.*\\)" file)
3514 (expand-file-name (match-string 3 file)
3515 (car (nth (1- (string-to-int (match-string 2 file)))
3516 idlwave-path-alist))))
3517 ((file-name-absolute-p file) file)
3518 (t (idlwave-locate-lib-file file))))
f32b3b91
CD
3519
3520(defun idlwave-make-tags ()
3521 "Creates the IDL tags file IDLTAGS in the current directory from
3522the list of directories specified in the minibuffer. Directories may be
3523for example: . /usr/local/rsi/idl/lib. All the subdirectories of the
3524specified top directories are searched if the directory name is prefixed
3525by @. Specify @ directories with care, it may take a long, long time if
3526you 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
3608commented, and conversely, uncomment region. If optional prefix arg
3609N is non-nil, then for N positive, add N comment delimiters or for N
3610negative, remove N comment delimiters.
3611Uses `comment-region' which does not place comment delimiters on
3612blank 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:
3753also set new patterns. Probably this will always have to be t."
3754 (let (entry name type class kwds res source call olh new)
3755 (while list
3756 (setq entry (car list)
3757 list (cdr list)
3758 name (car entry)
3759 type (nth 1 entry)
3760 class (nth 2 entry)
3761 source (nth 3 entry)
3762 call (nth 4 entry)
3763 kwds (nth 5 entry)
3764 olh (nth 6 entry))
3765 (setq kwds (mapcar (lambda (x)
3766 (list (idlwave-sintern-keyword (car x) set)))
3767 kwds))
3768 (if class
3769 (progn
3770 (if (symbolp class) (setq class (symbol-name class)))
3771 (setq class (idlwave-sintern-class class set))
3772 (setq name (idlwave-sintern-method name set)))
3773 (setq name (idlwave-sintern-routine name set)))
3774 (if (stringp (cdr source))
3775 (setcdr source (idlwave-sintern-file (cdr source) t)))
3776 (setq new (if olh
3777 (list name type class source call kwds olh)
3778 (list name type class source call kwds)))
3779 (setq res (cons new res)))
3780 (nreverse res)))
3781
3782;;---------------------------------------------------------------------------
3783
3784
3785;; The variables which hold the information
15e42531 3786(defvar idlwave-system-routines nil
f32b3b91
CD
3787 "Holds the routine-info obtained by scanning buffers.")
3788(defvar idlwave-buffer-routines nil
3789 "Holds the routine-info obtained by scanning buffers.")
3790(defvar idlwave-compiled-routines nil
15e42531
CD
3791 "Holds the routine-info obtained by asking the shell.")
3792(defvar idlwave-unresolved-routines nil
3793 "Holds the unresolved routine-info obtained by asking the shell.")
f32b3b91
CD
3794(defvar idlwave-library-routines nil
3795 "Holds the procedure routine-info from the library scan.")
15e42531
CD
3796(defvar idlwave-path-alist nil
3797 "Alist with !PATH directories and a flag if the dir has been scanned.")
3798(defvar idlwave-true-path-alist nil
3799 "Like `idlwave-path-alist', but with true filenames.")
f32b3b91
CD
3800(defvar idlwave-routines nil
3801 "Holds the combinded procedure routine-info.")
3802(defvar idlwave-class-alist nil
3803 "Holds the class names known to IDLWAVE.")
3804(defvar idlwave-class-history nil
3805 "The history of classes selected with the minibuffer.")
3806(defvar idlwave-force-class-query nil)
3807(defvar idlwave-before-completion-wconf nil
3808 "The window configuration just before the completion buffer was displayed.")
15e42531
CD
3809(defvar idlwave-last-system-routine-info-cons-cell nil
3810 "The last cons cell in the system routine info.")
f32b3b91
CD
3811
3812;;
3813;; The code to get routine info from different sources.
3814
15e42531 3815(defvar idlwave-system-routines)
f32b3b91
CD
3816(defun idlwave-routines ()
3817 "Provide a list of IDL routines.
3818This routine loads the builtin routines on the first call. Later it
3819only 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.
3828These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info])
3829and by `idlwave-complete' (\\[idlwave-complete]) to provide information
3830about individual routines.
3831
3832The information can come from 4 sources:
38331. IDL programs in the current editing session
38342. Compiled modules in an IDL shell running as Emacs subprocess
38353. A list which covers the IDL system routines.
38364. A list which covers the prescanned library files.
3837
3838Scans all IDLWAVE-mode buffers of the current editing session (see
3839`idlwave-scan-all-buffers-for-routine-info').
3840When an IDL shell is running, this command also queries the IDL program
3841for currently compiled routines.
3842
3843With prefix ARG, also reload the system and library lists.
3844With two prefix ARG's, also rescans the library tree."
3845 (interactive "P")
3846 (if (equal arg '(16))
3847 (idlwave-create-libinfo-file t)
3848 (let* ((reload (or arg
3849 idlwave-buffer-case-takes-precedence
15e42531 3850 (null idlwave-system-routines))))
f32b3b91
CD
3851
3852 (setq idlwave-buffer-routines nil
15e42531
CD
3853 idlwave-compiled-routines nil
3854 idlwave-unresolved-routines nil)
f32b3b91
CD
3855 ;; Reset the appropriate hashes
3856 (idlwave-reset-sintern (cond (reload t)
15e42531 3857 ((null idlwave-system-routines) t)
f32b3b91
CD
3858 (t 'bufsh)))
3859
3860 (if idlwave-buffer-case-takes-precedence
3861 ;; We can safely scan the buffer stuff first
3862 (progn
3863 (idlwave-update-buffer-routine-info)
3864 (and reload (idlwave-load-system-rinfo)))
3865 ;; We first do the system info, and then the buffers
3866 (and reload (idlwave-load-system-rinfo))
3867 (idlwave-update-buffer-routine-info))
3868
3869 ;; Let's see if there is a shell
3870 (let* ((shell-is-running (and (fboundp 'idlwave-shell-is-running)
3871 (idlwave-shell-is-running)))
3872 (ask-shell (and shell-is-running
3873 idlwave-query-shell-for-routine-info)))
3874
3875 (if (or (not ask-shell)
3876 (not (interactive-p)))
3877 ;; 1. If we are not going to ask the shell, we need to do the
3878 ;; concatenation now.
3879 ;; 2. When this function is called non-interactively, it means
3880 ;; that someone needs routine info *now*. The shell update
3881 ;; causes the concatenation *delayed*, so not in time for
3882 ;; the current command. Therefore, we do a concatenation
3883 ;; now, even though the shell might do it again.
3884 (idlwave-concatenate-rinfo-lists))
3885
3886 (when ask-shell
3887 ;; Ask the shell about the routines it knows.
3888 (message "Querying the shell")
3889 (idlwave-shell-update-routine-info))))))
3890
3891(defun idlwave-load-system-rinfo ()
3892 ;; Load and case-treat the system and lib info files.
22d5821d 3893 (load "idlw-rinfo" t)
15e42531
CD
3894 (message "Normalizing idlwave-system-routines...")
3895 (setq idlwave-system-routines
3896 (idlwave-sintern-rinfo-list idlwave-system-routines 'sys))
3897 (message "Normalizing idlwave-system-routines...done")
3898 (setq idlwave-routines (copy-sequence idlwave-system-routines))
3899 (setq idlwave-last-system-routine-info-cons-cell
3900 (nthcdr (1- (length idlwave-routines)) idlwave-routines))
f32b3b91
CD
3901 (when (and (stringp idlwave-libinfo-file)
3902 (file-regular-p idlwave-libinfo-file))
3903 (condition-case nil
3904 (progn
3905 (load-file idlwave-libinfo-file)
15e42531 3906 (setq idlwave-true-path-alist nil)
f32b3b91
CD
3907 (message "Normalizing idlwave-library-routines...")
3908 (setq idlwave-library-routines (idlwave-sintern-rinfo-list
3909 idlwave-library-routines 'sys))
3910 (message "Normalizing idlwave-library-routines...done"))
3911 (error nil))))
3912
3913(defun idlwave-update-buffer-routine-info ()
3914 (let (res)
15e42531
CD
3915 (cond
3916 ((eq idlwave-scan-all-buffers-for-routine-info t)
3917 ;; Scan all buffers, current buffer last
3918 (message "Scanning all buffers...")
3919 (setq res (idlwave-get-routine-info-from-buffers
3920 (reverse (buffer-list)))))
3921 ((null idlwave-scan-all-buffers-for-routine-info)
3922 ;; Don't scan any buffers
3923 (setq res nil))
3924 (t
f32b3b91
CD
3925 ;; Just scan this buffer
3926 (if (eq major-mode 'idlwave-mode)
3927 (progn
3928 (message "Scanning current buffer...")
3929 (setq res (idlwave-get-routine-info-from-buffers
15e42531 3930 (list (current-buffer))))))))
f32b3b91
CD
3931 ;; Put the result into the correct variable
3932 (setq idlwave-buffer-routines
3933 (idlwave-sintern-rinfo-list res t))))
3934
15e42531 3935(defun idlwave-concatenate-rinfo-lists (&optional quiet)
f32b3b91
CD
3936 "Put the different sources for routine information together."
3937 ;; The sequence here is important because earlier definitions shadow
3938 ;; later ones. We assume that if things in the buffers are newer
3939 ;; then in the shell of the system, it is meant to be different.
15e42531
CD
3940
3941 (setcdr idlwave-last-system-routine-info-cons-cell
3942 (append idlwave-buffer-routines
3943 idlwave-compiled-routines
3944 idlwave-library-routines))
f32b3b91 3945 (setq idlwave-class-alist nil)
15e42531 3946
f32b3b91 3947 ;; Give a message with information about the number of routines we have.
15e42531
CD
3948 (unless quiet
3949 (message
3950 "Routine info updated: buffer(%d) compiled(%d) catalog(%d) system(%d)"
3951 (length idlwave-buffer-routines)
3952 (length idlwave-compiled-routines)
3953 (length idlwave-library-routines)
3954 (length idlwave-system-routines))))
3955
3956(defun idlwave-class-alist ()
3957 "Return the class alist - make it if necessary."
3958 (or idlwave-class-alist
3959 (let (class)
3960 (loop for x in idlwave-routines do
3961 (when (and (setq class (nth 2 x))
3962 (not (assq class idlwave-class-alist)))
3963 (push (list class) idlwave-class-alist)))
3964 idlwave-class-alist)))
3965
3966;; Three functions for the hooks
3967(defun idlwave-save-buffer-update ()
3968 (idlwave-update-current-buffer-info 'save-buffer))
3969(defun idlwave-kill-buffer-update ()
3970 (idlwave-update-current-buffer-info 'kill-buffer))
3971(defun idlwave-new-buffer-update ()
3972 (idlwave-update-current-buffer-info 'find-file))
3973
3974(defun idlwave-update-current-buffer-info (why)
3975 "Undate idlwave-routines for current buffer. Can run from after-save-hook."
3976 (when (and (eq major-mode 'idlwave-mode)
3977 (or (eq t idlwave-auto-routine-info-updates)
3978 (memq why idlwave-auto-routine-info-updates))
3979 idlwave-scan-all-buffers-for-routine-info
3980 idlwave-routines)
3981 (condition-case nil
3982 (let (routines)
3983 (idlwave-replace-buffer-routine-info
3984 (buffer-file-name)
3985 (if (eq why 'kill-buffer)
3986 nil
3987 (setq routines
3988 (idlwave-sintern-rinfo-list
3989 (idlwave-get-routine-info-from-buffers
3990 (list (current-buffer))) 'set))))
3991 (idlwave-concatenate-rinfo-lists 'quiet)
3992 routines)
3993 (error nil))))
3994
3995(defun idlwave-replace-buffer-routine-info (file new)
3996 "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW."
3997 (let ((list idlwave-buffer-routines)
3998 found)
3999 (while list
4000 ;; The following test uses eq to make sure it works correctly
4001 ;; when two buffers visit the same file. Then the file names
4002 ;; will be equal, but not eq.
4003 (if (eq (cdr (nth 3 (car list))) file)
4004 (progn
4005 (setcar list nil)
4006 (setq found t))
4007 (if found
4008 ;; End of that section reached. Jump.
4009 (setq list nil)))
4010 (setq list (cdr list)))
4011 (setq idlwave-buffer-routines
4012 (append new (delq nil idlwave-buffer-routines)))))
f32b3b91
CD
4013
4014;;----- Scanning buffers -------------------
4015
4016(defun idlwave-get-routine-info-from-buffers (buffers)
4017 "Call `idlwave-get-buffer-routine-info' on idlwave-mode buffers in BUFFERS."
4018 (let (buf routine-lists res)
4019 (save-excursion
4020 (while (setq buf (pop buffers))
4021 (set-buffer buf)
4022 (if (eq major-mode 'idlwave-mode)
4023 ;; yes, this buffer has the right mode.
4024 (progn (setq res (condition-case nil
4025 (idlwave-get-buffer-routine-info)
4026 (error nil)))
4027 (push res routine-lists)))))
4028 ;; Concatenate the individual lists and return the result
4029 (apply 'nconc routine-lists)))
4030
4031(defun idlwave-get-buffer-routine-info ()
4032 "Scan the current buffer for routine info. Return (PRO-LIST FUNC-LIST)."
4033 (let* ((case-fold-search t)
4034 routine-list string entry)
4035 (save-excursion
4036 (save-restriction
4037 (widen)
4038 (goto-char (point-min))
4039 (while (re-search-forward
15e42531 4040 "^[ \t]*\\(pro\\|function\\)[ \t]" nil t)
f32b3b91
CD
4041 (setq string (buffer-substring
4042 (match-beginning 0)
4043 (progn
4044 (idlwave-end-of-statement)
4045 (point))))
4046 (setq entry (idlwave-parse-definition string))
4047 (push entry routine-list))))
4048 routine-list))
4049
15e42531 4050(defvar idlwave-scanning-lib-dir)
f32b3b91
CD
4051(defun idlwave-parse-definition (string)
4052 "Parse a module definition."
4053 (let ((case-fold-search t)
4054 start name args type keywords class)
4055 ;; Remove comments
4056 (while (string-match ";.*" string)
4057 (setq string (replace-match "" t t string)))
4058 ;; Remove the continuation line stuff
4059 (while (string-match "\\([^a-zA-Z0-9$_]\\)\\$[ \t]*\n" string)
4060 (setq string (replace-match "\\1 " t nil string)))
4061 ;; Match the name and type.
4062 (when (string-match
4063 "\\<\\(pro\\|function\\)\\>\\s-+\\(\\([a-zA-Z0-9$_]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)" string)
4064 (setq start (match-end 0))
4065 (setq type (downcase (match-string 1 string)))
4066 (if (match-beginning 3)
4067 (setq class (match-string 3 string)))
4068 (setq name (match-string 4 string)))
4069 ;; Match normal args and keyword args
4070 (while (string-match
15e42531 4071 ",\\s-*\\([a-zA-Z][a-zA-Z0-9$_]*\\|\\(_ref\\)?_extra\\)\\s-*\\(=\\)?"
f32b3b91
CD
4072 string start)
4073 (setq start (match-end 0))
15e42531 4074 (if (match-beginning 3)
f32b3b91
CD
4075 (push (match-string 1 string) keywords)
4076 (push (match-string 1 string) args)))
4077 ;; Normalize and sort.
4078 (setq args (nreverse args))
4079 (setq keywords (sort keywords (lambda (a b)
4080 (string< (downcase a) (downcase b)))))
4081 ;; Make and return the entry
4082 ;; We don't know which argument are optional, so this information
4083 ;; will not be contained in the calling sequence.
4084 (list name
4085 (if (equal type "pro") 'pro 'fun)
4086 class
4087 (cond ((not (boundp 'idlwave-scanning-lib))
4088 (cons 'buffer (buffer-file-name)))
15e42531
CD
4089; ((string= (downcase
4090; (file-name-sans-extension
4091; (file-name-nondirectory (buffer-file-name))))
4092; (downcase name))
4093; (list 'lib))
4094; (t (cons 'lib (file-name-nondirectory (buffer-file-name))))
4095 (t (cons 'lib (concat idlwave-scanning-lib-dir
4096 (file-name-nondirectory (buffer-file-name))))))
f32b3b91
CD
4097 (concat
4098 (if (string= type "function") "Result = " "")
4099 (if class "Obj ->[%s::]" "")
4100 "%s"
4101 (if args
4102 (concat
4103 (if (string= type "function") "(" ", ")
4104 (mapconcat 'identity args ", ")
4105 (if (string= type "function") ")" ""))))
4106 (if keywords
4107 (mapcar 'list keywords)
4108 nil))))
4109
4110;;----- Scanning the library -------------------
4111
15e42531
CD
4112(defvar idlwave-sys-dir nil
4113 "Internal variable.")
4114
4115(defun idlwave-sys-dir ()
4116 "Return the syslib directory, or a dummy that never matches."
4117 (or idlwave-sys-dir
4118 "@@@@@@@@"))
4119
4120(defvar idlwave-shell-path-query)
f32b3b91
CD
4121(defun idlwave-create-libinfo-file (&optional arg)
4122 "Scan all files on selected dirs of IDL search path for routine information.
4123A widget checklist will allow you to choose the directories.
4124Write the result as a file `idlwave-libinfo-file'. When this file exists,
4125will be automatically loaded to give routine information about library
4126routines.
4127With ARG, just rescan the same directories as last time - so no widget
4128will pop up."
4129 (interactive "P")
4130 ;; Make sure the file is loaded if it exists.
4131 (if (and (stringp idlwave-libinfo-file)
4132 (file-regular-p idlwave-libinfo-file))
4133 (condition-case nil
4134 (load-file idlwave-libinfo-file)
4135 (error nil)))
4136 ;; Make sure the file name makes sense
4137 (unless (and (stringp idlwave-libinfo-file)
15e42531 4138 (> (length idlwave-libinfo-file) 0)
f32b3b91
CD
4139 (file-accessible-directory-p
4140 (file-name-directory idlwave-libinfo-file))
4141 (not (string= "" (file-name-nondirectory
4142 idlwave-libinfo-file))))
4143 (error "`idlwave-libinfo-file' does not point to file in accessible directory."))
4144
4145 (cond
15e42531
CD
4146 ((and arg idlwave-path-alist
4147 (consp (car idlwave-path-alist))
4148 idlwave-sys-dir)
f32b3b91 4149 ;; Rescan the known directories
15e42531
CD
4150 (idlwave-scan-lib-files
4151 idlwave-sys-dir
4152 idlwave-path-alist))
f32b3b91
CD
4153 (idlwave-library-path
4154 ;; Get the directories from that variable
4155 (idlwave-display-libinfo-widget
15e42531 4156 idlwave-system-directory
f32b3b91 4157 (idlwave-expand-path idlwave-library-path)
15e42531
CD
4158 (delq nil (mapcar (lambda (x) (if (consp x) (if (cdr x) (car x) nil) x))
4159 idlwave-path-alist))))
f32b3b91
CD
4160 (t
4161 ;; Ask the shell for the path and run the widget
4162 (message "Asking the shell for IDL path...")
15e42531
CD
4163 (require 'idlw-shell)
4164 (idlwave-shell-send-command idlwave-shell-path-query
4165 '(idlwave-libinfo-command-hook nil)
4166 'hide))))
f32b3b91
CD
4167
4168(defun idlwave-libinfo-command-hook (&optional arg)
4169 ;; Command hook used by `idlwave-create-libinfo-file'.
4170 (if arg
4171 ;; Scan immediately
15e42531
CD
4172 (idlwave-scan-lib-files
4173 idlwave-sys-dir
4174 idlwave-path-alist)
f32b3b91 4175 ;; Display the widget
15e42531
CD
4176 (let* ((rpl (idlwave-shell-path-filter))
4177 (sysdir (car rpl))
4178 (dirs (cdr rpl)))
4179 (idlwave-display-libinfo-widget
4180 sysdir dirs
4181 (delq nil (mapcar (lambda (x) (if (cdr x) (car x) nil))
4182 idlwave-path-alist))))))
f32b3b91
CD
4183
4184(defconst idlwave-libinfo-widget-help-string
15e42531 4185 "This is the front-end to the creation of IDLWAVE library catalog.
f32b3b91
CD
4186Please select below the directories on IDL's search path from which you
4187would like to extract routine information, which will be stored in the file
4188
4189 %s
4190
4191If this is not the correct file, first set variable `idlwave-libinfo-file'.
4192Then call this command again.
15e42531
CD
4193
4194For writing code, you need to include the directories which contain the
4195routines you use. If IDLWAVE should be able to analyse routine shadowing
4196it is best to scan all directories.
4197
f32b3b91
CD
4198After selecting the directories, choose [Scan & Save] to scan the library
4199directories and save the routine info.
4200\n")
4201
4202(defvar idlwave-widget)
4203(defvar widget-keymap)
15e42531 4204(defun idlwave-display-libinfo-widget (sysdir dirs selected-dirs)
f32b3b91
CD
4205 "Create the widget to select IDL search path directories for scanning."
4206 (interactive)
4207 (require 'widget)
4208 (require 'wid-edit)
4209 (unless dirs
4210 (error "Don't know IDL's search path"))
4211
4212 ;; Allow only those directories to be selected which are in the path.
4213 (setq selected-dirs (delq nil (mapcar (lambda (x)
4214 (if (member x dirs) x nil))
4215 selected-dirs)))
4216 (kill-buffer (get-buffer-create "*IDLWAVE Widget*"))
4217 (switch-to-buffer (get-buffer-create "*IDLWAVE Widget*"))
4218 (kill-all-local-variables)
4219 (make-local-variable 'idlwave-widget)
4220 (widget-insert (format idlwave-libinfo-widget-help-string
4221 idlwave-libinfo-file))
4222
4223 (widget-create 'push-button
4224 :notify 'idlwave-widget-scan-lib-files
f32b3b91
CD
4225 "Scan & Save")
4226 (widget-insert " ")
4227 (widget-create 'push-button
4228 :notify (lambda (&rest ignore)
4229 (kill-buffer (current-buffer)))
4230 "Quit")
4231 (widget-insert " ")
4232 (widget-create 'push-button
4233 :notify 'idlwave-delete-libinfo-file
4234 "Delete File")
4235 (widget-insert " ")
4236 (widget-create 'push-button
4237 :notify '(lambda (&rest ignore)
4238 (idlwave-display-libinfo-widget
15e42531 4239 (widget-get idlwave-widget :sysdir)
f32b3b91
CD
4240 (widget-get idlwave-widget :path-dirs)
4241 (widget-get idlwave-widget :path-dirs)))
4242 "Select All")
4243 (widget-insert " ")
4244 (widget-create 'push-button
4245 :notify '(lambda (&rest ignore)
4246 (idlwave-display-libinfo-widget
15e42531 4247 (widget-get idlwave-widget :sysdir)
f32b3b91
CD
4248 (widget-get idlwave-widget :path-dirs)
4249 nil))
4250 "Deselect All")
4251 (widget-insert "\n\n")
4252
4253 (widget-insert "Select Directories\n")
4254
4255 (setq idlwave-widget
4256 (apply 'widget-create
4257 'checklist
4258 :value selected-dirs
4259 :greedy t
4260 :tag "List of directories"
4261 (mapcar (lambda (x) (list 'item x)) dirs)))
4262 (widget-put idlwave-widget :path-dirs dirs)
15e42531 4263 (widget-put idlwave-widget :sysdir sysdir)
f32b3b91
CD
4264 (widget-insert "\n")
4265 (use-local-map widget-keymap)
4266 (widget-setup)
4267 (goto-char (point-min))
4268 (delete-other-windows))
4269
4270(defun idlwave-delete-libinfo-file (&rest ignore)
4271 (if (yes-or-no-p
4272 (format "Delete file %s " idlwave-libinfo-file))
4273 (progn
4274 (delete-file idlwave-libinfo-file)
4275 (message "%s has been deleted" idlwave-libinfo-file))))
4276
4277(defun idlwave-widget-scan-lib-files (&rest ignore)
4278 ;; Call `idlwave-scan-lib-files' with data taken from the widget.
4279 (let* ((widget idlwave-widget)
15e42531
CD
4280 (selected-dirs (widget-value widget))
4281 (sysdir (widget-get widget :sysdir))
4282 (path-dirs (widget-get widget :path-dirs))
4283 (path-dir-alist
4284 (mapcar (lambda (x) (cons x (if (member x selected-dirs) t nil)))
4285 path-dirs)))
4286 (idlwave-scan-lib-files sysdir path-dir-alist)))
f32b3b91
CD
4287
4288(defvar font-lock-mode)
15e42531
CD
4289(defun idlwave-scan-lib-files (sysdir path-alist)
4290 ;; Scan the files in PATH-ALIST and store the info in a file
f32b3b91 4291 (let* ((idlwave-scanning-lib t)
15e42531
CD
4292 (idlwave-scanning-lib-dir "")
4293 (dircnt (1+ (length path-alist)))
f32b3b91 4294 (idlwave-completion-case nil)
15e42531 4295 dirs-alist dir files file)
f32b3b91 4296 (setq idlwave-library-routines nil)
15e42531
CD
4297 (setq idlwave-path-alist path-alist)
4298 (setq idlwave-true-path-alist nil)
4299 (setq idlwave-sys-dir sysdir)
f32b3b91
CD
4300 (save-excursion
4301 (set-buffer (get-buffer-create "*idlwave-scan.pro*"))
4302 (idlwave-mode)
15e42531
CD
4303 (setq dirs-alist (reverse path-alist))
4304 (while (setq dir (pop dirs-alist))
4305 (decf dircnt)
4306 (when (cdr dir)
4307 ;; Has the flag of scanned directories
4308 (setq dir (car dir))
4309 (setq idlwave-scanning-lib-dir (format "{%d}/" dircnt))
4310 (when (file-directory-p dir)
4311 (setq files (directory-files dir 'full "\\.[pP][rR][oO]\\'"))
4312 (while (setq file (pop files))
4313 (when (file-regular-p file)
4314 (if (not (file-readable-p file))
4315 (message "Skipping %s (no read permission)" file)
4316 (message "Scanning %s..." file)
4317 (erase-buffer)
4318 (insert-file-contents file 'visit)
4319 (setq idlwave-library-routines
4320 (append (idlwave-get-routine-info-from-buffers
4321 (list (current-buffer)))
4322 idlwave-library-routines)))
4323 ))))))
4324 ;; Sorting is not necessary since we sort each time before a routine
4325 ;; is used. So we don't do it here - the catalog file looks nicer
4326 ;; when it is unsorted.
4327 ;;(message "Sorting...")
4328 ;;(setq idlwave-library-routines
4329 ;;(sort idlwave-library-routines 'idlwave-routine-entry-compare))
4330 ;;(message "Sorting...done")
4331 (message "Creating libinfo file...")
f32b3b91
CD
4332 (kill-buffer "*idlwave-scan.pro*")
4333 (kill-buffer (get-buffer-create "*IDLWAVE Widget*"))
15e42531
CD
4334 (let ((font-lock-maximum-size 0)
4335 (auto-mode-alist nil))
f32b3b91
CD
4336 (find-file idlwave-libinfo-file))
4337 (if (and (boundp 'font-lock-mode)
4338 font-lock-mode)
4339 (font-lock-mode 0))
4340 (erase-buffer)
4341 (insert ";; IDLWAVE libinfo file\n")
4342 (insert (format ";; Created %s\n\n" (current-time-string)))
4343
15e42531
CD
4344 ;; Define the variable which knows the value of "!DIR"
4345 (insert (format "\n(setq idlwave-sys-dir \"%s\")\n"
4346 idlwave-sys-dir))
4347
f32b3b91 4348 ;; Define the variable which contains a list of all scanned directories
15e42531 4349 (insert "\n(setq idlwave-path-alist\n '(")
f32b3b91 4350 (mapcar (lambda (x)
15e42531
CD
4351 (insert (format "\n (\"%s\" . %s)" (car x) (cdr x))))
4352 path-alist)
f32b3b91 4353 (insert "))\n")
15e42531 4354
f32b3b91
CD
4355 ;; Define the routine info list
4356 (insert "\n(setq idlwave-library-routines\n '(")
4357 (mapcar (lambda (x)
4358 (insert "\n ")
4359 (insert (with-output-to-string (prin1 x))))
4360 idlwave-library-routines)
4361 (insert (format "))\n\n;;; %s ends here\n"
4362 (file-name-nondirectory idlwave-libinfo-file)))
4363 (goto-char (point-min))
4364 ;; Save the buffer
4365 (save-buffer 0)
4366 (kill-buffer (current-buffer)))
15e42531 4367 (message "Creating libinfo file...done")
f32b3b91
CD
4368 (message "Info for %d routines saved in %s"
4369 (length idlwave-library-routines)
4370 idlwave-libinfo-file)
4371 (sit-for 2)
4372 (idlwave-update-routine-info t))
4373
4374(defun idlwave-expand-path (path &optional default-dir)
4375 ;; Expand parts of path starting with '+' recursively into directory list.
4376 ;; Relative recursive path elements are expanded relative to DEFAULT-DIR.
4377 (message "Expanding path...")
4378 (let (path1 dir recursive)
4379 (while (setq dir (pop path))
4380 (if (setq recursive (string= (substring dir 0 1) "+"))
4381 (setq dir (substring dir 1)))
4382 (if (and recursive
4383 (not (file-name-absolute-p dir)))
4384 (setq dir (expand-file-name dir default-dir)))
4385 (if recursive
4386 ;; Expand recursively
4387 (setq path1 (append (idlwave-recursive-directory-list dir) path1))
4388 ;; Keep unchanged
4389 (push dir path1)))
4390 (message "Expanding path...done")
4391 (nreverse path1)))
4392
4393(defun idlwave-recursive-directory-list (dir)
4394 ;; Return a list of all directories below DIR, including DIR itself
4395 (let ((path (list dir)) path1 file files)
4396 (while (setq dir (pop path))
4397 (when (file-directory-p dir)
4398 (setq files (nreverse (directory-files dir t "[^.]")))
4399 (while (setq file (pop files))
4400 (if (file-directory-p file)
4401 (push (file-name-as-directory file) path)))
4402 (push dir path1)))
4403 path1))
4404
4405;;----- Asking the shell -------------------
4406
4407;; First, here is the idl program which can be used to query IDL for
4408;; defined routines.
4409(defconst idlwave-routine-info.pro
4410 "
15e42531 4411pro idlwave_print_info_entry,name,func=func,separator=sep
f32b3b91 4412 ;; See if it's an object method
15e42531 4413 if name eq '' then return
f32b3b91
CD
4414 func = keyword_set(func)
4415 methsep = strpos(name,'::')
4416 meth = methsep ne -1
4417
4418 ;; Get routine info
4419 pars = routine_info(name,/parameters,functions=func)
4420 source = routine_info(name,/source,functions=func)
4421 nargs = pars.num_args
4422 nkw = pars.num_kw_args
4423 if nargs gt 0 then args = pars.args
4424 if nkw gt 0 then kwargs = pars.kw_args
4425
4426 ;; Trim the class, and make the name
4427 if meth then begin
4428 class = strmid(name,0,methsep)
4429 name = strmid(name,methsep+2,strlen(name)-1)
4430 if nargs gt 0 then begin
4431 ;; remove the self argument
4432 wh = where(args ne 'SELF',nargs)
4433 if nargs gt 0 then args = args(wh)
4434 endif
4435 endif else begin
4436 ;; No class, just a normal routine.
4437 class = \"\"
4438 endelse
4439
4440 ;; Calling sequence
4441 cs = \"\"
4442 if func then cs = 'Result = '
4443 if meth then cs = cs + 'Obj -> [' + '%s' + '::]'
4444 cs = cs + '%s'
4445 if func then cs = cs + '(' else if nargs gt 0 then cs = cs + ', '
4446 if nargs gt 0 then begin
4447 for j=0,nargs-1 do begin
4448 cs = cs + args(j)
4449 if j lt nargs-1 then cs = cs + ', '
4450 endfor
4451 end
4452 if func then cs = cs + ')'
4453 ;; Keyword arguments
4454 kwstring = ''
4455 if nkw gt 0 then begin
4456 for j=0,nkw-1 do begin
4457 kwstring = kwstring + ' ' + kwargs(j)
4458 endfor
4459 endif
4460
15e42531 4461 ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])(func)
f32b3b91 4462
15e42531 4463 print,ret + ': ' + name + sep + class + sep + source(0).path $
f32b3b91
CD
4464 + sep + cs + sep + kwstring
4465end
4466
4467pro idlwave_routine_info
4468 sep = '<@>'
4469 print,'>>>BEGIN OF IDLWAVE ROUTINE INFO (\"' + sep + '\" IS THE SEPARATOR)'
4470 all = routine_info()
4471 for i=0,n_elements(all)-1 do $
15e42531 4472 idlwave_print_info_entry,all(i),separator=sep
f32b3b91
CD
4473 all = routine_info(/functions)
4474 for i=0,n_elements(all)-1 do $
15e42531 4475 idlwave_print_info_entry,all(i),/func,separator=sep
f32b3b91
CD
4476 print,'>>>END OF IDLWAVE ROUTINE INFO'
4477end
4478"
4479 "The idl program to get the routine info stuff.
4480The output of this program is parsed by `idlwave-shell-routine-info-filter'.")
4481
15e42531
CD
4482(defvar idlwave-idlwave_routine_info-compiled nil
4483 "Remembers if the routine info procedure is already compiled.")
f32b3b91
CD
4484
4485(defvar idlwave-shell-temp-pro-file)
15e42531
CD
4486(defvar idlwave-shell-temp-rinfo-save-file)
4487(defun idlwave-shell-update-routine-info (&optional quiet)
f32b3b91 4488 "Query the shell for routine_info of compiled modules and update the lists."
15e42531
CD
4489 ;; Save and compile the procedure. The compiled procedure is then
4490 ;; saved into an IDL SAVE file, to allow for fast RESTORE.
4491 ;; We need to RESTORE the procedure each time we use it, since
4492 ;; the user may have killed or redefined it. In particluar,
4493 ;; .RESET_SESSION will kill all user procedures.
4494 (unless (and idlwave-idlwave_routine_info-compiled
4495 (file-readable-p idlwave-shell-temp-rinfo-save-file))
4496 (save-excursion
4497 (set-buffer (idlwave-find-file-noselect
4498 idlwave-shell-temp-pro-file))
4499 (erase-buffer)
4500 (insert idlwave-routine-info.pro)
4501 (save-buffer 0))
4502 (idlwave-shell-send-command
4503 (concat ".run " idlwave-shell-temp-pro-file)
4504 nil 'hide)
4505 (idlwave-shell-send-command
4506 (format "save,'idlwave_routine_info','idlwave_print_info_entry',FILE='%s',/ROUTINES"
4507 idlwave-shell-temp-rinfo-save-file)
4508 nil 'hide))
4509
4510 ;; Restore and execute the procedure, analyze the output
4511 (idlwave-shell-send-command
4512 (format "RESTORE, '%s' & idlwave_routine_info"
4513 idlwave-shell-temp-rinfo-save-file)
4514 `(progn
4515 (idlwave-shell-routine-info-filter)
4516 (idlwave-concatenate-rinfo-lists ,quiet))
4517 'hide))
f32b3b91
CD
4518
4519;; ---------------------------------------------------------------------------
4520;;
4521;; Completion and displaying routine calling sequences
4522
15e42531
CD
4523(defvar idlwave-completion-help-info nil)
4524(defvar idlwave-current-obj_new-class nil)
4525
f32b3b91
CD
4526(defun idlwave-complete (&optional arg module class)
4527 "Complete a function, procedure or keyword name at point.
4528This function is smart and figures out what can be legally completed
4529at 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
4536When several completions are possible, a list will be displayed in the
4537*Completions* buffer. If this list is too long to fit into the
4538window, scrolling can be achieved by repeatedly pressing \\[idlwave-complete].
4539
4540The function also knows about object methods. When it needs a class
4541name, the action depends upon `idlwave-query-class', which see. You
4542can force IDLWAVE to ask you for a class name with a \\[universal-argument] prefix
4543argument to this command.
4544
4545See also the variables `idlwave-keyword-completion-adds-equal' and
4546`idlwave-function-completion-adds-paren'.
4547
4548The optional ARG can be used to specify the completion type in order
4549to override IDLWAVE's idea of what should be completed at point.
4550Possible values are:
4551
45520 <=> query for the completion type
45531 <=> 'procedure
45542 <=> 'procedure-keyword
45553 <=> 'function
45564 <=> 'function-keyword
45575 <=> 'procedure-method
45586 <=> 'procedure-method-keyword
45597 <=> 'function-method
45608 <=> 'function-method-keyword
45619 <=> 'class
4562
4563For Lisp programmers only:
4564When we force a keyword, optional argument MODULE can contain the module name.
4565When we force a method or a method keyword, CLASS can specify the class."
4566 (interactive "P")
4567 (idlwave-routines)
4568 (let* ((where-list
4569 (if (and arg
4570 (or (integerp arg)
4571 (symbolp arg)))
4572 (idlwave-make-force-complete-where-list arg module class)
4573 (idlwave-where)))
4574 (what (nth 2 where-list))
595ab50b 4575 (idlwave-force-class-query (equal arg '(4))))
f32b3b91
CD
4576
4577 (if (and module (string-match "::" module))
4578 (setq class (substring module 0 (match-beginning 0))
4579 module (substring module (match-end 0))))
4580
4581 (cond
4582
4583 ((and (null arg)
4584 (eq (car-safe last-command) 'idlwave-display-completion-list)
595ab50b 4585 (get-buffer-window "*Completions*"))
f32b3b91
CD
4586 (setq this-command last-command)
4587 (idlwave-scroll-completions))
4588
4589 ((null what)
4590 (error "Nothing to complete here"))
4591
4592 ((eq what 'class)
15e42531 4593 (setq idlwave-completion-help-info '(class))
f32b3b91
CD
4594 (idlwave-complete-class))
4595
4596 ((eq what 'procedure)
4597 ;; Complete a procedure name
4598 (let* ((class-selector (idlwave-determine-class (nth 3 where-list) 'pro))
4599 (isa (concat "procedure" (if class-selector "-method" "")))
4600 (type-selector 'pro))
15e42531
CD
4601 (setq idlwave-completion-help-info
4602 (list 'routine nil type-selector class-selector))
f32b3b91
CD
4603 (idlwave-complete-in-buffer
4604 'procedure (if class-selector 'method 'routine)
4605 (idlwave-routines) 'idlwave-selector
4606 (format "Select a %s name%s"
4607 isa
4608 (if class-selector
4609 (format " (class is %s)" class-selector)
4610 ""))
4611 isa
4612 'idlwave-attach-method-classes)))
4613
4614 ((eq what 'function)
4615 ;; Complete a function name
4616 (let* ((class-selector (idlwave-determine-class (nth 3 where-list) 'fun))
4617 (isa (concat "function" (if class-selector "-method" "")))
4618 (type-selector 'fun))
15e42531
CD
4619 (setq idlwave-completion-help-info
4620 (list 'routine nil type-selector class-selector))
f32b3b91
CD
4621 (idlwave-complete-in-buffer
4622 'function (if class-selector 'method 'routine)
4623 (idlwave-routines) 'idlwave-selector
4624 (format "Select a %s name%s"
4625 isa
4626 (if class-selector
4627 (format " (class is %s)" class-selector)
4628 ""))
4629 isa
4630 'idlwave-attach-method-classes)))
4631
4632 ((eq what 'procedure-keyword)
4633 ;; Complete a procedure keyword
4634 (let* ((where (nth 3 where-list))
4635 (name (car where))
4636 (method-selector name)
4637 (type-selector 'pro)
4638 (class (idlwave-determine-class where 'pro))
4639 (class-selector class)
4640 (isa (format "procedure%s-keyword" (if class "-method" "")))
15e42531 4641 (entry (idlwave-best-rinfo-assq
f32b3b91
CD
4642 name 'pro class (idlwave-routines)))
4643 (list (nth 5 entry)))
4644 (unless (or entry (eq class t))
4645 (error "Nothing known about procedure %s"
4646 (idlwave-make-full-name class name)))
4647 (setq list (idlwave-fix-keywords name 'pro class list))
4648 (unless list (error (format "No keywords available for procedure %s"
4649 (idlwave-make-full-name class name))))
15e42531
CD
4650 (setq idlwave-completion-help-info
4651 (list 'keyword name type-selector class-selector))
f32b3b91
CD
4652 (idlwave-complete-in-buffer
4653 'keyword 'keyword list nil
4654 (format "Select keyword for procedure %s%s"
4655 (idlwave-make-full-name class name)
15e42531
CD
4656 (if (or (member '("_EXTRA") list)
4657 (member '("_REF_EXTRA") list))
4658 " (note _EXTRA)" ""))
f32b3b91
CD
4659 isa
4660 'idlwave-attach-keyword-classes)))
4661
4662 ((eq what 'function-keyword)
4663 ;; Complete a function keyword
4664 (let* ((where (nth 3 where-list))
4665 (name (car where))
4666 (method-selector name)
4667 (type-selector 'fun)
4668 (class (idlwave-determine-class where 'fun))
4669 (class-selector class)
4670 (isa (format "function%s-keyword" (if class "-method" "")))
15e42531 4671 (entry (idlwave-best-rinfo-assq
f32b3b91 4672 name 'fun class (idlwave-routines)))
15e42531
CD
4673 (list (nth 5 entry))
4674 msg-name)
f32b3b91
CD
4675 (unless (or entry (eq class t))
4676 (error "Nothing known about function %s"
4677 (idlwave-make-full-name class name)))
4678 (setq list (idlwave-fix-keywords name 'fun class list))
15e42531
CD
4679 ;; OBJ_NEW: Messages mention the proper Init method
4680 (setq msg-name (if (and (null class)
4681 (string= (upcase name) "OBJ_NEW"))
4682 (concat idlwave-current-obj_new-class
4683 "::Init (via OBJ_NEW)")
4684 (idlwave-make-full-name class name)))
f32b3b91 4685 (unless list (error (format "No keywords available for function %s"
15e42531
CD
4686 msg-name)))
4687 (setq idlwave-completion-help-info
4688 (list 'keyword name type-selector class-selector))
f32b3b91
CD
4689 (idlwave-complete-in-buffer
4690 'keyword 'keyword list nil
15e42531
CD
4691 (format "Select keyword for function %s%s" msg-name
4692 (if (or (member '("_EXTRA") list)
4693 (member '("_REF_EXTRA") list))
4694 " (note _EXTRA)" ""))
f32b3b91
CD
4695 isa
4696 'idlwave-attach-keyword-classes)))
15e42531 4697
f32b3b91
CD
4698 (t (error "This should not happen (idlwave-complete)")))))
4699
4700(defun idlwave-make-force-complete-where-list (what &optional module class)
4701 ;; Return an artificial WHERE specification to force the completion
4702 ;; routine to complete a specific item independent of context.
4703 ;; WHAT is the prefix arg of `idlwave-complete', see there for details.
4704 ;; MODULE and CLASS can be used to specify the routine name and class.
4705 ;; The class name will also be found in MODULE if that is like "class::mod".
4706 (let* ((what-list '(("procedure") ("procedure-keyword")
4707 ("function") ("function-keyword")
4708 ("procedure-method") ("procedure-method-keyword")
4709 ("function-method") ("function-method-keyword")
4710 ("class")))
4711 (module (idlwave-sintern-routine-or-method module class))
4712 (class (idlwave-sintern-class class))
4713 (what (cond
4714 ((equal what 0)
4715 (setq what
4716 (intern (completing-read
4717 "Complete what? " what-list nil t))))
4718 ((integerp what)
4719 (setq what (intern (car (nth (1- what) what-list)))))
4720 ((and what
4721 (symbolp what)
4722 (assoc (symbol-name what) what-list))
4723 what)
4724 (t (error "Illegal WHAT"))))
4725 (nil-list '(nil nil nil nil))
4726 (class-list (list nil nil (or class t) nil)))
4727
4728 (cond
4729
4730 ((eq what 'procedure)
4731 (list nil-list nil-list 'procedure nil-list nil))
4732
4733 ((eq what 'procedure-keyword)
4734 (let* ((class-selector nil)
4735 (type-selector 'pro)
4736 (pro (or module
4737 (idlwave-completing-read
4738 "Procedure: " (idlwave-routines) 'idlwave-selector))))
4739 (setq pro (idlwave-sintern-routine pro))
4740 (list nil-list nil-list 'procedure-keyword
4741 (list pro nil nil nil) nil)))
4742
4743 ((eq what 'function)
4744 (list nil-list nil-list 'function nil-list nil))
4745
4746 ((eq what 'function-keyword)
4747 (let* ((class-selector nil)
4748 (type-selector 'fun)
4749 (func (or module
4750 (idlwave-completing-read
4751 "Function: " (idlwave-routines) 'idlwave-selector))))
4752 (setq func (idlwave-sintern-routine func))
4753 (list nil-list nil-list 'function-keyword
4754 (list func nil nil nil) nil)))
4755
4756 ((eq what 'procedure-method)
4757 (list nil-list nil-list 'procedure class-list nil))
4758
4759 ((eq what 'procedure-method-keyword)
4760 (let* ((class (idlwave-determine-class class-list 'pro))
4761 (class-selector class)
4762 (type-selector 'pro)
4763 (pro (or module
4764 (idlwave-completing-read
4765 (format "Procedure in %s class: " class-selector)
4766 (idlwave-routines) 'idlwave-selector))))
4767 (setq pro (idlwave-sintern-method pro))
4768 (list nil-list nil-list 'procedure-keyword
4769 (list pro nil class nil) nil)))
4770
4771 ((eq what 'function-method)
4772 (list nil-list nil-list 'function class-list nil))
4773
4774 ((eq what 'function-method-keyword)
4775 (let* ((class (idlwave-determine-class class-list 'fun))
4776 (class-selector class)
4777 (type-selector 'fun)
4778 (func (or module
4779 (idlwave-completing-read
4780 (format "Function in %s class: " class-selector)
4781 (idlwave-routines) 'idlwave-selector))))
4782 (setq func (idlwave-sintern-method func))
4783 (list nil-list nil-list 'function-keyword
4784 (list func nil class nil) nil)))
4785
4786 ((eq what 'class)
4787 (list nil-list nil-list 'class nil-list nil))
4788
4789 (t (error "Illegal value for WHAT")))))
4790
4791(defun idlwave-completing-read (&rest args)
4792 ;; Completing read, case insensitive
4793 (let ((old-value (default-value 'completion-ignore-case)))
4794 (unwind-protect
4795 (progn
4796 (setq-default completion-ignore-case t)
4797 (apply 'completing-read args))
4798 (setq-default completion-ignore-case old-value))))
4799
4800(defun idlwave-make-full-name (class name)
4801 ;; Make a fully qualified module name including the class name
4802 (concat (if class (format "%s::" class) "") name))
4803
15e42531
CD
4804(defun idlwave-rinfo-assoc (name type class list)
4805 "Like `idlwave-rinfo-assq', but sintern strings first."
4806 (idlwave-rinfo-assq
4807 (idlwave-sintern-routine-or-method name class)
4808 type (idlwave-sintern-class class) list))
4809
f32b3b91
CD
4810(defun idlwave-rinfo-assq (name type class list)
4811 ;; Works like assq, but also checks type and class
4812 (catch 'exit
4813 (let (match)
4814 (while (setq match (assq name list))
4815 (and (or (eq type t)
4816 (eq (nth 1 match) type))
4817 (eq (nth 2 match) class)
4818 (throw 'exit match))
4819 (setq list (cdr (memq match list)))))))
4820
15e42531
CD
4821(defun idlwave-best-rinfo-assq (name type class list)
4822 "Like `idlwave-rinfo-assq', but get all twins and sort, then return first."
4823 (let ((twins (idlwave-routine-twins
4824 (idlwave-rinfo-assq name type class list)
4825 list))
4826 syslibp)
4827 (when (> (length twins) 1)
4828 (setq twins (sort twins 'idlwave-routine-entry-compare-twins))
4829 (if (and (eq 'system (car (nth 3 (car twins))))
4830 (setq syslibp (idlwave-any-syslib (cdr twins)))
4831 (not (equal 1 syslibp)))
4832 ;; Its a syslib, so we need to remove the system entry
4833 (setq twins (cdr twins))))
4834 (car twins)))
4835
4836(defun idlwave-best-rinfo-assoc (name type class list)
4837 "Like `idlwave-best-rinfo-assq', but sintern strings first."
4838 (idlwave-best-rinfo-assq
4839 (idlwave-sintern-routine-or-method name class)
4840 type (idlwave-sintern-class class) list))
4841
4842(defun idlwave-any-syslib (entries)
4843 "Does the entry list ENTRIES contain a syslib entry?
4844If yes, return the index (>=1)."
4845 (let (file (cnt 0))
4846 (catch 'exit
4847 (while entries
4848 (incf cnt)
4849 (setq file (cdr (nth 3 (car entries))))
4850 (if (and file
4851 (idlwave-syslib-p
4852 (idlwave-expand-lib-file-name file)))
4853 (throw 'exit cnt)
4854 (setq entries (cdr entries))))
4855 nil)))
4856
f32b3b91
CD
4857(defun idlwave-all-assq (key list)
4858 "Return a list of all associations of Key in LIST."
4859 (let (rtn elt)
4860 (while (setq elt (assq key list))
4861 (push elt rtn)
4862 (setq list (cdr (memq elt list))))
4863 (nreverse rtn)))
4864
4865(defun idlwave-all-method-classes (method &optional type)
4866 "Return all classes which have a method METHOD. TYPE is 'fun or 'pro.
4867When TYPE is not specified, both procedures and functions will be considered."
4868 (if (null method)
15e42531 4869 (mapcar 'car (idlwave-class-alist))
f32b3b91
CD
4870 (let (rtn)
4871 (mapcar (lambda (x)
4872 (and (nth 2 x)
4873 (or (not type)
4874 (eq type (nth 1 x)))
4875 (push (nth 2 x) rtn)))
4876 (idlwave-all-assq method (idlwave-routines)))
4877 (idlwave-uniquify rtn))))
4878
4879(defun idlwave-all-method-keyword-classes (method keyword &optional type)
4880 "Return all classes which have a method METHOD with keyword KEYWORD.
4881TYPE is 'fun or 'pro.
4882When TYPE is not specified, both procedures and functions will be considered."
4883 (if (or (null method)
4884 (null keyword))
4885 nil
4886 (let (rtn)
4887 (mapcar (lambda (x)
4888 (and (nth 2 x)
4889 (or (not type)
4890 (eq type (nth 1 x)))
4891 (assoc keyword (nth 5 x))
4892 (push (nth 2 x) rtn)))
4893 (idlwave-all-assq method (idlwave-routines)))
4894 (idlwave-uniquify rtn))))
4895
4896(defun idlwave-determine-class (info type)
4897 ;; Determine the class of a routine call. INFO is the structure returned
4898 ;; `idlwave-what-function' or `idlwave-what-procedure'.
4899 ;; The third element in this structure is the class. When nil, we return nil.
15e42531
CD
4900 ;; When t, try to get the class from text properties at the arrow. When
4901 ;; the object is "self", we use the class of the current routine.
f32b3b91
CD
4902 ;; otherwise prompt the user for a class name. Also stores the selected
4903 ;; class as a text property at the arrow.
4904 ;; TYPE is 'fun or 'pro.
4905 (let* ((class (nth 2 info))
4906 (apos (nth 3 info))
4907 (nassoc (assoc (if (stringp (car info))
4908 (upcase (car info))
4909 (car info))
4910 idlwave-query-class))
4911 (dassoc (assq (if (car info) 'keyword-default 'method-default)
4912 idlwave-query-class))
4913 (query (cond (nassoc (cdr nassoc))
4914 (dassoc (cdr dassoc))
4915 (t t)))
4916 (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->")))
15e42531
CD
4917 (is-self
4918 (and arrow
4919 (save-excursion (goto-char apos)
4920 (forward-word -1)
4921 (let ((case-fold-search t))
4922 (looking-at "self\\>")))))
f32b3b91
CD
4923 (force-query idlwave-force-class-query)
4924 store class-alist)
4925 (cond
4926 ((null class) nil)
4927 ((eq t class)
4928 ;; There is an object which would like to know its class
4929 (if (and arrow (get-text-property apos 'idlwave-class)
4930 idlwave-store-inquired-class
4931 (not force-query))
4932 (setq class (get-text-property apos 'idlwave-class)
4933 class (idlwave-sintern-class class)))
15e42531
CD
4934 (when (and (eq t class)
4935 is-self)
4936 (setq class (or (nth 2 (idlwave-current-routine)) class)))
f32b3b91
CD
4937 (when (and (eq class t)
4938 (or force-query query))
4939 (setq class-alist
4940 (mapcar 'list (idlwave-all-method-classes (car info) type)))
4941 (setq class
4942 (idlwave-sintern-class
4943 (cond
4944 ((and (= (length class-alist) 0) (not force-query))
4945 (error "No classes available with method %s" (car info)))
4946 ((and (= (length class-alist) 1) (not force-query))
4947 (car (car class-alist)))
4948 (t
4949 (setq store idlwave-store-inquired-class)
4950 (idlwave-completing-read
4951 (format "Class%s: " (if (stringp (car info))
4952 (format " for %s method %s"
4953 type (car info))
4954 ""))
4955 class-alist nil nil nil 'idlwave-class-history))))))
4956 (when (and class (not (eq t class)))
4957 ;; We have a real class here
4958 (when (and store arrow)
4959 (put-text-property apos (+ apos 2) 'idlwave-class class)
4960 (put-text-property apos (+ apos 2) 'face idlwave-class-arrow-face))
4961 (setf (nth 2 info) class))
4962 ;; Return the class
4963 class)
4964 ;; Default as fallback
4965 (t class))))
4966
4967(defvar type-selector)
4968(defvar class-selector)
4969(defvar method-selector)
4970(defun idlwave-selector (a)
4971 (and (eq (nth 1 a) type-selector)
4972 (or (and (nth 2 a) (eq class-selector t))
4973 (eq (nth 2 a) class-selector))))
4974
4975(defun idlwave-where ()
4976 "Find out where we are.
4977The return value is a list with the following stuff:
4978(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR)
4979
4980PRO-LIST (PRO POINT CLASS ARROW)
4981FUNC-LIST (FUNC POINT CLASS ARROW)
4982COMPLETE-WHAT a symbol indicating what kind of completion makes sense here
4983CW-LIST Like PRO-LIST, for what can be copmpleted here.
4984LAST-CHAR last relevant character before point (non-white non-comment,
4985 not part of current identifier or leading slash).
4986
4987In the lists, we have these meanings:
4988PRO: Procedure name
4989FUNC: Function name
4990POINT: Where is this
4991CLASS: What class has the routine (nil=no, t=is method, but class unknown)
4992ARROW: Where is the arrow?"
4993 (idlwave-routines)
15e42531
CD
4994 (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point)))
4995 ;; FIXME: WAS THIS CHANGE CORRECT??? Answer: yes.
4996 (bos (save-excursion (idlwave-start-of-substatement 'pre) (point)))
f32b3b91
CD
4997 (func-entry (idlwave-what-function bos))
4998 (func (car func-entry))
4999 (func-class (nth 1 func-entry))
5000 (func-arrow (nth 2 func-entry))
5001 (func-point (or (nth 3 func-entry) 0))
5002 (func-level (or (nth 4 func-entry) 0))
5003 (pro-entry (idlwave-what-procedure bos))
5004 (pro (car pro-entry))
5005 (pro-class (nth 1 pro-entry))
5006 (pro-arrow (nth 2 pro-entry))
5007 (pro-point (or (nth 3 pro-entry) 0))
5008 (last-char (idlwave-last-valid-char))
5009 (case-fold-search t)
5010 cw cw-mod cw-arrow cw-class cw-point)
5011 (if (< func-point pro-point) (setq func nil))
5012 (cond
15e42531
CD
5013 ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'"
5014 (buffer-substring bos (point)))
5015 (setq cw 'class))
f32b3b91
CD
5016 ((string-match
5017 "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'"
5018 (buffer-substring (if (> pro-point 0) pro-point bos) (point)))
5019 (setq cw 'procedure cw-class pro-class cw-point pro-point
5020 cw-arrow pro-arrow))
5021 ((string-match "\\`[ \t]*\\(pro\\|function\\)\\>"
5022 (buffer-substring bos (point)))
5023 nil)
15e42531 5024 ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'"
f32b3b91
CD
5025 (buffer-substring bos (point)))
5026 (setq cw 'class))
5027 ((and func
5028 (> func-point pro-point)
5029 (= func-level 1)
5030 (memq last-char '(?\( ?,)))
5031 (setq cw 'function-keyword cw-mod func cw-point func-point
5032 cw-class func-class cw-arrow func-arrow))
5033 ((and pro (eq last-char ?,))
5034 (setq cw 'procedure-keyword cw-mod pro cw-point pro-point
5035 cw-class pro-class cw-arrow pro-arrow))
5036; ((member last-char '(?\' ?\) ?\] ?!))
5037; ;; after these chars, a function makes no sense
5038; ;; FIXME: I am sure there can be more in this list
5039; ;; FIXME: Do we want to do this at all?
5040; nil)
5041 ;; Everywhere else we try a function.
5042 (t
5043 (setq cw 'function)
5044 (save-excursion
5045 (if (re-search-backward "->[ \t]*\\(\\([$a-zA-Z0-9_]+\\)::\\)?[$a-zA-Z0-9_]*\\=" bos t)
5046 (setq cw-arrow (match-beginning 0)
5047 cw-class (if (match-end 2)
5048 (idlwave-sintern-class (match-string 2))
5049 t))))))
5050 (list (list pro pro-point pro-class pro-arrow)
5051 (list func func-point func-class func-arrow)
5052 cw
5053 (list cw-mod cw-point cw-class cw-arrow)
5054 last-char)))
5055
5056(defun idlwave-this-word (&optional class)
5057 ;; Grab the word around point. CLASS is for the `skip-chars=...' functions
5058 (setq class (or class "a-zA-Z0-9$_"))
5059 (save-excursion
5060 (buffer-substring-no-properties
5061 (progn (skip-chars-backward class) (point))
5062 (progn (skip-chars-forward class) (point)))))
5063
f32b3b91
CD
5064(defun idlwave-what-function (&optional bound)
5065 ;; Find out if point is within the argument list of a function.
5066 ;; The return value is ("function-name" (point) level).
5067 ;; Level is 1 on the to level parenthesis, higher further down.
5068
5069 ;; If the optional BOUND is an integer, bound backwards directed
5070 ;; searches to this point.
5071
5072 (catch 'exit
5073 (let (pos
5074 func-point
f32b3b91
CD
5075 (cnt 0)
5076 func arrow-start class)
15e42531
CD
5077 (idlwave-with-special-syntax
5078 (save-restriction
5079 (save-excursion
5080 (narrow-to-region (max 1 (or bound 0)) (point-max))
5081 ;; move back out of the current parenthesis
5082 (while (condition-case nil
5083 (progn (up-list -1) t)
5084 (error nil))
5085 (setq pos (point))
5086 (incf cnt)
5087 (when (and (= (following-char) ?\()
5088 (re-search-backward
5089 "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\="
5090 bound t))
5091 (setq func (match-string 2)
5092 func-point (goto-char (match-beginning 2))
5093 pos func-point)
5094 (if (re-search-backward
5095 "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t)
5096 (setq arrow-start (match-beginning 0)
5097 class (or (match-string 2) t)))
5098 (throw
5099 'exit
5100 (list
5101 (idlwave-sintern-routine-or-method func class)
5102 (idlwave-sintern-class class)
5103 arrow-start func-point cnt)))
5104 (goto-char pos))
5105 (throw 'exit nil)))))))
f32b3b91
CD
5106
5107(defun idlwave-what-procedure (&optional bound)
5108 ;; Find out if point is within the argument list of a procedure.
5109 ;; The return value is ("procedure-name" class arrow-pos (point)).
5110
5111 ;; If the optional BOUND is an integer, bound backwards directed
5112 ;; searches to this point.
5113 (let ((pos (point)) pro-point
5114 pro class arrow-start string)
5115 (save-excursion
15e42531
CD
5116 ;????(idlwave-beginning-of-statement)
5117 ;; FIXME: WAS THIS CHANGE CORRECT: Answer: yes
5118 (idlwave-start-of-substatement 'pre)
f32b3b91
CD
5119 (setq string (buffer-substring (point) pos))
5120 (if (string-match
5121 "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string)
5122 (setq pro (match-string 1 string)
5123 pro-point (+ (point) (match-beginning 1)))
5124 (if (and (idlwave-skip-object)
5125 (setq string (buffer-substring (point) pos))
5126 (string-match
5127 "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\'\\)" string))
5128 (setq pro (if (match-beginning 4)
5129 (match-string 4 string))
5130 pro-point (if (match-beginning 4)
5131 (+ (point) (match-beginning 4))
5132 pos)
5133 arrow-start (+ (point) (match-beginning 1))
5134 class (or (match-string 3 string) t)))))
5135 (list (idlwave-sintern-routine-or-method pro class)
5136 (idlwave-sintern-class class)
5137 arrow-start
5138 pro-point)))
5139
5140(defun idlwave-skip-object ()
5141 ;; If there is an object at point, move over it and return t.
5142 (let ((pos (point)))
5143 (if (catch 'exit
5144 (save-excursion
5145 (skip-chars-forward " ") ; white space
5146 (skip-chars-forward "*") ; de-reference
5147 (cond
5148 ((looking-at idlwave-identifier)
5149 (goto-char (match-end 0)))
5150 ((eq (following-char) ?\()
5151 nil)
5152 (t (throw 'exit nil)))
5153 (catch 'endwhile
5154 (while t
5155 (cond ((eq (following-char) ?.)
5156 (forward-char 1)
5157 (if (not (looking-at idlwave-identifier))
5158 (throw 'exit nil))
5159 (goto-char (match-end 0)))
5160 ((memq (following-char) '(?\( ?\[))
5161 (condition-case nil
5162 (forward-list 1)
5163 (error (throw 'exit nil))))
5164 (t (throw 'endwhile t)))))
5165 (if (looking-at "[ \t]*->")
5166 (throw 'exit (setq pos (match-beginning 0)))
5167 (throw 'exit nil))))
5168 (goto-char pos)
5169 nil)))
5170
5171
5172(defun idlwave-last-valid-char ()
5173 "Return the last character before point which is not white or a comment
5174and also not part of the current identifier. Since we do this in
5175order to identify places where keywords are, we consider the initial
5176`/' of a keyword as part of the identifier.
5177This 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.
5208SELECTOR is the PREDICATE argument for the completion function.
5209Show PROMPT in echo area. TYPE is one of 'function, 'procedure or 'keyword."
5210 (let* ((completion-ignore-case t)
5211 beg (end (point)) slash part spart completion all-completions
5212 dpart dcompletion)
5213
5214 (unless list
5215 (error (concat prompt ": No completions available")))
5216
5217 ;; What is already in the buffer?
5218 (save-excursion
5219 (skip-chars-backward "a-zA-Z0-9_$")
5220 (setq slash (eq (preceding-char) ?/)
5221 beg (point)
5222 idlwave-complete-after-success-form
5223 (list 'idlwave-after-successful-completion
5224 (list 'quote type) slash beg)
5225 idlwave-complete-after-success-form-force
5226 (list 'idlwave-after-successful-completion
5227 (list 'quote type) slash (list 'quote 'force))))
5228
5229 ;; Try a completion
5230 (setq part (buffer-substring beg end)
5231 dpart (downcase part)
5232 spart (idlwave-sintern stype part)
5233 completion (try-completion part list selector)
5234 dcompletion (if (stringp completion) (downcase completion)))
5235 (cond
5236 ((null completion)
5237 ;; nothing available.
5238 (error "Can't find %s completion for \"%s\"" isa part))
5239 ((and (not (equal dpart dcompletion))
5240 (not (eq t completion)))
5241 ;; We can add something
5242 (delete-region beg end)
5243 (if (and (string= part dpart)
5244 (or (not (string= part ""))
5245 idlwave-complete-empty-string-as-lower-case)
5246 (not idlwave-completion-force-default-case))
5247 (insert dcompletion)
5248 (insert completion))
5249 (if (eq t (try-completion completion list selector))
5250 ;; Now this is a unique match
5251 (idlwave-after-successful-completion type slash beg))
5252 t)
5253 ((or (eq completion t)
5254 (and (equal dpart dcompletion)
5255 (= 1 (length (setq all-completions
5256 (idlwave-uniquify
5257 (all-completions part list selector)))))))
5258 ;; This is already complete
5259 (idlwave-after-successful-completion type slash beg)
5260 (message "%s is already the complete %s" part isa)
5261 nil)
5262 (t
5263 ;; We cannot add something - offer a list.
5264 (message "Making completion list...")
5265 (let* ((list all-completions)
5266 (complete (memq spart all-completions))
5267 (completion-highlight-first-word-only t) ; XEmacs
5268 (completion-fixup-function ; Emacs
5269 (lambda () (and (eq (preceding-char) ?>)
5270 (re-search-backward " <" beg t)))))
5271 (setq list (sort list (lambda (a b)
5272 (string< (downcase a) (downcase b)))))
5273 (if prepare-display-function
5274 (setq list (funcall prepare-display-function list)))
5275 (if (and (string= part dpart)
5276 (or (not (string= part ""))
5277 idlwave-complete-empty-string-as-lower-case)
5278 (not idlwave-completion-force-default-case))
5279 (setq list (mapcar (lambda (x)
5280 (if (listp x)
5281 (setcar x (downcase (car x)))
5282 (setq x (downcase x)))
5283 x)
5284 list)))
5285 (idlwave-display-completion-list list prompt beg complete))
5286 t))))
5287
5288(defun idlwave-complete-class ()
5289 "Complete a class at point."
5290 (interactive)
5291 ;; Call `idlwave-routines' to make sure the class list will be available
5292 (idlwave-routines)
15e42531
CD
5293 ;; Check for the special case of completing empty string after pro/function
5294 (if (let ((case-fold-search t))
5295 (save-excursion
5296 (and
5297 (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\="
5298 (- (point) 15) t)
5299 (goto-char (point-min))
5300 (re-search-forward
5301 "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t))))
5302 ;; Yank the full class specification
5303 (insert (match-string 2))
5304 ;; Do the completion
5305 (idlwave-complete-in-buffer 'class 'class (idlwave-class-alist) nil
5306 "Select a class" "class")))
f32b3b91
CD
5307
5308(defun idlwave-attach-classes (list is-kwd show-classes)
5309 ;; attach the proper class list to a LIST of completion items.
5310 ;; IS-KWD, when non-nil, shows its keywords - otherwise its methods
5311 ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'.
5312 (catch 'exit
5313 (if (or (null show-classes) ; don't wnat to see classes
5314 (null class-selector) ; not a method call
5315 (stringp class-selector)) ; the class is already known
5316 ;; In these cases, we do not have to do anything
5317 (throw 'exit list))
5318
5319 ;; The property and dots stuff currently only make sense with XEmacs
5320 ;; because Emacs drops text properties when filling the *Completions*
5321 ;; buffer.
5322 (let* ((do-prop (and (featurep 'xemacs) (>= show-classes 0)))
5323 (do-buf (not (= show-classes 0)))
5324 (do-dots (featurep 'xemacs))
5325 (max (abs show-classes))
5326 (lmax (if do-dots (apply 'max (mapcar 'length list))))
5327 classes nclasses class-info space)
5328 (mapcar
5329 (lambda (x)
5330 ;; get the classes
5331 (setq classes
5332 (if is-kwd
5333 (idlwave-all-method-keyword-classes
5334 method-selector x type-selector)
5335 (idlwave-all-method-classes x type-selector)))
5336 (setq nclasses (length classes))
5337 ;; Make the separator between item and class-info
5338 (if do-dots
5339 (setq space (concat " " (make-string (- lmax (length x)) ?.)))
5340 (setq space " "))
5341 (if do-buf
5342 ;; We do want info in the buffer
5343 (if (<= nclasses max)
5344 (setq class-info (concat
5345 space
5346 "<" (mapconcat 'identity classes ",") ">"))
5347 (setq class-info (format "%s<%d classes>" space nclasses)))
5348 (setq class-info nil))
5349 (when do-prop
5350 ;; We do want properties
5351 (setq x (copy-sequence x))
5352 (put-text-property 0 (length x)
5353 'help-echo (mapconcat 'identity classes " ")
5354 x))
5355 (if class-info
5356 (list x class-info)
5357 x))
5358 list))))
5359
5360(defun idlwave-attach-method-classes (list)
5361 ;; Call idlwave-attach-classes with method parameters
5362 (idlwave-attach-classes list nil idlwave-completion-show-classes))
5363(defun idlwave-attach-keyword-classes (list)
5364 ;; Call idlwave-attach-classes with keyword parameters
5365 (idlwave-attach-classes list t idlwave-completion-show-classes))
5366
5367;;----------------------------------------------------------------------
5368;;----------------------------------------------------------------------
5369;;----------------------------------------------------------------------
5370;;----------------------------------------------------------------------
5371;;----------------------------------------------------------------------
5372
15e42531
CD
5373(defvar idlwave-completion-setup-hook nil)
5374
f32b3b91
CD
5375(defun idlwave-scroll-completions (&optional message)
5376 "Scroll the completion window on this frame."
5377 (let ((cwin (get-buffer-window "*Completions*" 'visible))
5378 (win (selected-window)))
5379 (unwind-protect
5380 (progn
5381 (select-window cwin)
5382 (condition-case nil
5383 (scroll-up)
5384 (error (if (and (listp last-command)
5385 (nth 2 last-command))
5386 (progn
5387 (select-window win)
5388 (eval idlwave-complete-after-success-form))
5389 (set-window-start cwin (point-min)))))
5390 (and message (message message)))
5391 (select-window win))))
5392
5393(defun idlwave-display-completion-list (list &optional message beg complete)
5394 "Display the completions in LIST in the completions buffer and echo MESSAGE."
5395 (unless (and (get-buffer-window "*Completions*")
5396 (idlwave-local-value 'idlwave-completion-p "*Completions*"))
5397 (move-marker idlwave-completion-mark beg)
5398 (setq idlwave-before-completion-wconf (current-window-configuration)))
5399
5400 (if (featurep 'xemacs)
15e42531
CD
5401 (idlwave-display-completion-list-xemacs
5402 list)
f32b3b91
CD
5403 (idlwave-display-completion-list-emacs list))
5404
5405 ;; Store a special value in `this-command'. When `idlwave-complete'
5406 ;; finds this in `last-command', it will scroll the *Completions* buffer.
5407 (setq this-command (list 'idlwave-display-completion-list message complete))
5408
5409 ;; Mark the completions buffer as created by cib
5410 (idlwave-set-local 'idlwave-completion-p t "*Completions*")
5411
5412 ;; Fontify the classes
5413 (if (and idlwave-completion-fontify-classes
5414 (consp (car list)))
5415 (idlwave-completion-fontify-classes))
5416
15e42531
CD
5417 ;; Run the hook
5418 (run-hooks 'idlwave-completion-setup-hook)
5419
f32b3b91
CD
5420 ;; Display the message
5421 (message (or message "Making completion list...done")))
5422
5423(defun idlwave-choose (function &rest args)
5424 "Call FUNCTION as a completion chooser and pass ARGS to it."
5425 (let ((completion-ignore-case t)) ; install correct value
5426 (apply function args))
15e42531
CD
5427 (if (and (eq major-mode 'idlwave-shell-mode)
5428 (boundp 'font-lock-mode)
5429 (not font-lock-mode))
5430 ;; Remove the fontification of the word before point
5431 (let ((beg (save-excursion
5432 (skip-chars-backward "a-zA-Z0-9_")
5433 (point))))
5434 (remove-text-properties beg (point) '(face nil))))
f32b3b91
CD
5435 (eval idlwave-complete-after-success-form-force))
5436
5437(defun idlwave-restore-wconf-after-completion ()
5438 "Restore the old (before completion) window configuration."
5439 (and idlwave-completion-restore-window-configuration
5440 idlwave-before-completion-wconf
5441 (set-window-configuration idlwave-before-completion-wconf)))
5442
5443(defun idlwave-set-local (var value &optional buffer)
5444 "Set the buffer-local value of VAR in BUFFER to VALUE."
5445 (save-excursion
5446 (set-buffer (or buffer (current-buffer)))
5447 (set (make-local-variable var) value)))
5448
5449(defun idlwave-local-value (var &optional buffer)
5450 "Return the value of VAR in BUFFER, but only if VAR is local to BUFFER."
5451 (save-excursion
5452 (set-buffer (or buffer (current-buffer)))
5453 (and (local-variable-p var (current-buffer))
5454 (symbol-value var))))
5455
15e42531
CD
5456;; In XEmacs, we can use :activate-callback directly to advice the
5457;; choose functions. We use the private keymap only for the online
5458;; help feature.
f32b3b91 5459
15e42531
CD
5460(defvar idlwave-completion-map nil
5461 "Keymap for completion-list-mode with idlwave-complete.")
5462
5463(defun idlwave-display-completion-list-xemacs (list &rest cl-args)
f32b3b91 5464 (with-output-to-temp-buffer "*Completions*"
15e42531
CD
5465 (apply 'display-completion-list list
5466 ':activate-callback 'idlwave-default-choose-completion
5467 cl-args))
5468 (save-excursion
5469 (set-buffer "*Completions*")
5470 (use-local-map
5471 (or idlwave-completion-map
5472 (setq idlwave-completion-map
5473 (idlwave-make-modified-completion-map-xemacs
5474 (current-local-map)))))))
f32b3b91
CD
5475
5476(defun idlwave-default-choose-completion (&rest args)
5477 "Execute `default-choose-completion' and then restore the win-conf."
5478 (apply 'idlwave-choose 'default-choose-completion args))
5479
15e42531
CD
5480(defun idlwave-make-modified-completion-map-xemacs (old-map)
5481 "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."
5482 (let ((new-map (copy-keymap old-map)))
5483 (define-key new-map [button3up] 'idlwave-mouse-completion-help)
5484 (define-key new-map [button3] (lambda ()
5485 (interactive)
5486 (setq this-command last-command)))
5487 new-map))
f32b3b91 5488
15e42531
CD
5489;; In Emacs we also to replace choose keybindings in the completion
5490;; map in order to install our wrappers.
f32b3b91
CD
5491
5492(defun idlwave-display-completion-list-emacs (list)
5493 "Display completion list and install the choose wrappers."
5494 (with-output-to-temp-buffer "*Completions*"
5495 (display-completion-list list))
5496 (save-excursion
5497 (set-buffer "*Completions*")
5498 (use-local-map
5499 (or idlwave-completion-map
5500 (setq idlwave-completion-map
15e42531
CD
5501 (idlwave-make-modified-completion-map-emacs
5502 (current-local-map)))))))
5503
5504(defun idlwave-make-modified-completion-map-emacs (old-map)
f32b3b91
CD
5505 "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."
5506 (let ((new-map (copy-keymap old-map)))
5507 (substitute-key-definition
5508 'choose-completion 'idlwave-choose-completion new-map)
5509 (substitute-key-definition
5510 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map)
15e42531 5511 (define-key new-map [mouse-3] 'idlwave-mouse-completion-help)
f32b3b91
CD
5512 new-map))
5513
5514(defun idlwave-choose-completion (&rest args)
5515 "Choose the completion that point is in or next to."
5516 (interactive)
5517 (apply 'idlwave-choose 'choose-completion args))
5518
5519(defun idlwave-mouse-choose-completion (&rest args)
5520 "Click on an alternative in the `*Completions*' buffer to choose it."
5521 (interactive "e")
5522 (apply 'idlwave-choose 'mouse-choose-completion args))
5523
5524;;----------------------------------------------------------------------
5525;;----------------------------------------------------------------------
5526
5527(defun idlwave-completion-fontify-classes ()
5528 "Goto the *Completions* buffer and fontify the class info."
5529 (when (featurep 'font-lock)
5530 (save-excursion
5531 (set-buffer "*Completions*")
5532 (save-excursion
5533 (goto-char (point-min))
5534 (while (re-search-forward "\\.*<[^>]+>" nil t)
5535 (put-text-property (match-beginning 0) (match-end 0)
5536 'face 'font-lock-string-face))))))
5537
5538(defun idlwave-uniquify (list)
5539 (let (nlist)
5540 (loop for x in list do
5541 (add-to-list 'nlist x))
5542 nlist))
5543
5544(defun idlwave-after-successful-completion (type slash &optional verify)
5545 "Add `=' or `(' after successful completion of keyword and function.
5546Restore the pre-completion window configuration if possible."
5547 (cond
5548 ((eq type 'procedure)
5549 nil)
5550 ((eq type 'function)
5551 (cond
5552 ((equal idlwave-function-completion-adds-paren nil) nil)
5553 ((or (equal idlwave-function-completion-adds-paren t)
5554 (equal idlwave-function-completion-adds-paren 1))
5555 (insert "("))
5556 ((equal idlwave-function-completion-adds-paren 2)
5557 (insert "()")
5558 (backward-char 1))
5559 (t nil)))
5560 ((eq type 'keyword)
5561 (if (and idlwave-keyword-completion-adds-equal
5562 (not slash))
5563 (progn (insert "=") t)
5564 nil)))
5565
5566 ;; Restore the pre-completion window configuration if this is safe.
5567
5568 (if (or (eq verify 'force) ; force
5569 (and
5570 (get-buffer-window "*Completions*") ; visible
5571 (idlwave-local-value 'idlwave-completion-p
5572 "*Completions*") ; cib-buffer
5573 (eq (marker-buffer idlwave-completion-mark)
5574 (current-buffer)) ; buffer OK
5575 (equal (marker-position idlwave-completion-mark)
5576 verify))) ; pos OK
5577 (idlwave-restore-wconf-after-completion))
5578 (move-marker idlwave-completion-mark nil)
5579 (setq idlwave-before-completion-wconf nil))
5580
15e42531
CD
5581(defun idlwave-mouse-context-help (ev &optional arg)
5582 "Call `idlwave-context-help' on the clicked location."
5583 (interactive "eP")
5584 (mouse-set-point ev)
5585 (idlwave-context-help arg))
5586
5587(defvar idlwave-last-context-help-pos nil)
5588(defun idlwave-context-help (&optional arg)
5589 "Display IDL Online Help on context.
5590If point is on a keyword, help for that keyword will be shown.
5591If point is on a routine name or in the argument list of a routine,
5592help for that routine will be displayed.
5593Works for system routines and keywords only."
f32b3b91 5594 (interactive "P")
15e42531
CD
5595 (idlwave-require-online-help)
5596 (idlwave-do-context-help arg))
5597
5598(defun idlwave-mouse-completion-help (ev)
5599 "Display online help about the completion at point."
5600 (interactive "eP")
5601 (idlwave-require-online-help)
5602 ;; Restore last-command for next command, to make scrolling of completions
5603 ;; work.
5604 (setq this-command last-command)
5605 (idlwave-do-mouse-completion-help ev))
5606
5607
5608(defvar idlwave-help-is-loaded nil
5609 "Is online help avaiable?")
5610;; The following variables will be defined by `idlw-help.el'.
5611(defvar idlwave-help-frame-width nil)
5612(defvar idlwave-help-file nil)
5613(defvar idlwave-help-topics nil)
5614
5615(defun idlwave-help-directory ()
5616 "Return the help directory, or nil if that is not known."
5617 (or (and (stringp idlwave-help-directory)
5618 (> (length idlwave-help-directory) 0)
5619 idlwave-help-directory)
5620 (getenv "IDLWAVE_HELP_DIRECTORY")))
5621
5622(defun idlwave-require-online-help ()
5623 (if idlwave-help-is-loaded
5624 t ;; everything is OK.
5625 (let* ((dir (or (idlwave-help-directory)
5626 (error "Online Help is not installed (idlwave-help-directory is unknown).")))
5627 (lfile1 (expand-file-name "idlw-help.elc" dir))
5628 (lfile2 (expand-file-name "idlw-help.el" dir))
5629 (hfile (expand-file-name "idlw-help.txt" dir)))
5630 (if (or (and (file-regular-p lfile1) (load-file lfile1))
5631 (and (file-regular-p lfile2) (load-file lfile2)))
5632 (progn
5633 (if (and idlwave-help-frame-parameters
5634 (not (assoc 'width idlwave-help-frame-parameters)))
5635 (push (cons 'width idlwave-help-frame-width)
5636 idlwave-help-frame-parameters))
5637 (or idlwave-help-topics
5638 (error "File `%s' in help dir `%s' does not define `idlwave-help-topics'"
5639 "idlw-help.el" dir)))
5640 (error "No such file `%s' in help dir `%s'" "idlw-help.el" dir))
5641 (if (file-regular-p hfile)
5642 (setq idlwave-help-is-loaded t
5643 idlwave-help-file hfile)
5644 (error "No such file `%s' in dir `%s'" "idlw-help.txt" dir)))))
f32b3b91
CD
5645
5646(defun idlwave-routine-info (&optional arg external)
5647 "Display a routines calling sequence and list of keywords.
5648When point is on the name a function or procedure, or in the argument
5649list of a function or procedure, this command displays a help buffer
5650with the information. When called with prefix arg, enforce class
5651query.
5652
5653When point is on an object operator `->', display the class stored in
5654this arrow, if any (see `idlwave-store-inquired-class'). With a
5655prefix arg, the class property is cleared out."
5656
5657 (interactive "P")
5658 (idlwave-routines)
5659 (if (string-match "->" (buffer-substring
5660 (max (point-min) (1- (point)))
5661 (min (+ 2 (point)) (point-max))))
5662 ;; Cursor is on an arrow
5663 (if (get-text-property (point) 'idlwave-class)
5664 ;; arrow has class property
5665 (if arg
5666 ;; Remove property
5667 (save-excursion
5668 (backward-char 1)
5669 (when (looking-at ".?\\(->\\)")
5670 (remove-text-properties (match-beginning 1) (match-end 1)
5671 '(idlwave-class nil face nil))
5672 (message "Class property removed from arrow")))
5673 ;; Echo class property
5674 (message "Arrow has text property identifying object to be class %s"
5675 (get-text-property (point) 'idlwave-class)))
5676 ;; No property found
5677 (message "Arrow has no class text property"))
5678
5679 ;; Not on an arrow...
5680 (let* ((idlwave-query-class nil)
5681 (idlwave-force-class-query (equal arg '(4)))
5682 (module (idlwave-what-module)))
15e42531
CD
5683 (if (car module)
5684 (apply 'idlwave-display-calling-sequence module)
5685 (error "Don't know which calling sequence to show.")))))
f32b3b91
CD
5686
5687(defun idlwave-resolve (&optional arg)
5688 "Call RESOLVE on the module name at point.
5689Like `idlwave-routine-info', this looks for a routine call at point.
5690After confirmation in the minibuffer, it will use the shell to issue
5691a RESOLVE call for this routine, to attempt to make it defined and its
5692routine info available for IDLWAVE. If the routine is a method call,
5693both `class__method' and `class__define' will be tried.
5694With 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.
5731Works for modules for which IDLWAVE has routine info available.
5732The function offers as default the module name `idlwave-routine-info' would
5733use. With ARG force class query for object methods."
5734 (interactive "P")
5735 (let* ((idlwave-query-class nil)
5736 (idlwave-force-class-query (equal arg '(4)))
5737 (module (idlwave-what-module))
5738 (default (concat (idlwave-make-full-name (nth 2 module) (car module))
5739 (if (eq (nth 1 module) 'pro) "<p>" "<f>")))
5740 (list
5741 (delq nil
5742 (mapcar (lambda (x)
5743 (if (eq 'system (car-safe (nth 3 x)))
5744 ;; Take out system routines with no source.
5745 nil
5746 (cons
5747 (concat (idlwave-make-full-name (nth 2 x) (car x))
5748 (if (eq (nth 1 x) 'pro) "<p>" "<f>"))
5749 (cdr x))))
5750 (idlwave-routines))))
5751 (name (idlwave-completing-read
5752 (format "Module (Default %s): "
5753 (if default default "none"))
5754 list))
5755 type class)
5756 (if (string-match "\\`\\s-*\\'" name)
5757 ;; Nothing, use the default.
5758 (setq name default))
5759 (if (string-match "<[fp]>" name)
5760 (setq type (substring name -2 -1)
5761 name (substring name 0 -3)))
5762 (if (string-match "\\(.*\\)::\\(.*\\)" name)
5763 (setq class (match-string 1 name)
5764 name (match-string 2 name)))
5765 (setq name (idlwave-sintern-routine-or-method name class)
5766 class (idlwave-sintern-class class)
5767 type (cond ((equal type "f") 'fun)
5768 ((equal type "p") 'pro)
5769 (t t)))
5770 (idlwave-do-find-module name type class)))
5771
15e42531 5772(defun idlwave-do-find-module (name type class &optional force-source)
f32b3b91
CD
5773 (let ((name1 (idlwave-make-full-name class name))
5774 source buf1 entry
5775 (buf (current-buffer))
5776 (pos (point)))
15e42531
CD
5777 (setq entry (idlwave-best-rinfo-assq name type class (idlwave-routines))
5778 source (or force-source (nth 3 entry)))
f32b3b91
CD
5779 (cond
5780 ((or (null name) (equal name ""))
5781 (error "Abort"))
5782 ((null entry)
5783 (error "Nothing known about a module %s" name1))
5784 ((eq (car source) 'system)
5785 (error "Source code for system routine %s is not available."
5786 name1))
5787 ((equal (cdr source) "")
5788 (error "Source code for routine %s is not available."
5789 name1))
5790 ((memq (car source) '(buffer lib compiled))
5791 (setq buf1
5792 (if (eq (car source) 'lib)
15e42531
CD
5793 (idlwave-find-file-noselect
5794 (idlwave-expand-lib-file-name
5795 (or (cdr source)
5796 (format "%s.pro" (downcase name)))) 'find)
5797 (idlwave-find-file-noselect (cdr source) 'find)))
5798 (pop-to-buffer buf1 t)
5799 (goto-char (point-max))
f32b3b91 5800 (let ((case-fold-search t))
15e42531 5801 (if (re-search-backward
f32b3b91
CD
5802 (concat "^[ \t]*\\<"
5803 (cond ((equal type "f") "function")
5804 ((equal type "p") "pro")
5805 (t "\\(pro\\|function\\)"))
5806 "\\>[ \t]+"
5807 (regexp-quote (downcase name1))
5808 "[^a-zA-Z0-9_$]")
5809 nil t)
5810 (goto-char (match-beginning 0))
5811 (pop-to-buffer buf)
5812 (goto-char pos)
5813 (error "Could not find routine %s" name1)))))))
5814
5815(defun idlwave-what-module ()
5816 "Return a default module for stuff near point.
5817Used by `idlwave-routine-info' and `idlwave-find-module'."
5818 (idlwave-routines)
15e42531
CD
5819 (if (let ((case-fold-search t))
5820 (save-excursion
5821 (idlwave-beginning-of-statement)
5822 (looking-at "[ \t]*\\(pro\\|function\\)[ \t]+\\(\\([a-zA-Z0-9_$]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)\\([, \t\n]\\|$\\)")))
5823 ;; This is a function or procedure definition statement
5824 ;; We return the defined routine as module.
5825 (list
5826 (idlwave-sintern-routine-or-method (match-string 4)
5827 (match-string 2))
5828 (if (equal (downcase (match-string 1)) "pro") 'pro 'fun)
5829 (idlwave-sintern-class (match-string 3)))
5830
5831 ;; Not a definition statement - analyze precise positon.
5832 (let* ((where (idlwave-where))
5833 (cw (nth 2 where))
5834 (pro (car (nth 0 where)))
5835 (func (car (nth 1 where)))
5836 (this-word (idlwave-this-word "a-zA-Z0-9$_"))
5837 (next-char (save-excursion (skip-chars-forward "a-zA-Z0-9$_")
5838 (following-char)))
5839 )
5840 (cond
5841 ((and (eq cw 'procedure)
5842 (not (equal this-word "")))
5843 (setq this-word (idlwave-sintern-routine-or-method
5844 this-word (nth 2 (nth 3 where))))
5845 (list this-word 'pro
5846 (idlwave-determine-class
5847 (cons this-word (cdr (nth 3 where)))
5848 'pro)))
5849 ((and (eq cw 'function)
5850 (not (equal this-word ""))
5851 (or (eq next-char ?\() ; exclude arrays, vars.
5852 (looking-at "[a-zA-Z0-9_]*[ \t]*(")))
5853 (setq this-word (idlwave-sintern-routine-or-method
5854 this-word (nth 2 (nth 3 where))))
5855 (list this-word 'fun
5856 (idlwave-determine-class
5857 (cons this-word (cdr (nth 3 where)))
5858 'fun)))
5859 ((and (memq cw '(function-keyword procedure-keyword))
5860 (not (equal this-word ""))
5861 (eq next-char ?\()) ; A function!
5862 (setq this-word (idlwave-sintern-routine this-word))
5863 (list this-word 'fun nil))
5864 (func
5865 (list func 'fun (idlwave-determine-class (nth 1 where) 'fun)))
5866 (pro
5867 (list pro 'pro (idlwave-determine-class (nth 0 where) 'pro)))
5868 (t nil)))))
f32b3b91
CD
5869
5870(defun idlwave-fix-keywords (name type class keywords)
5871 ;; This fixes the list of keywords.
5872 (let ((case-fold-search t)
5873 name1 type1)
5874
5875 ;; If this is the OBJ_NEW function, try to figure out the class and use
5876 ;; the keywords from the corresponding INIT method.
5877 (if (and (equal name "OBJ_NEW")
5878 (eq major-mode 'idlwave-mode))
5879 (let* ((bos (save-excursion (idlwave-beginning-of-statement) (point)))
5880 (string (buffer-substring bos (point)))
5881 (case-fold-search t)
5882 class)
5883 (and (string-match "obj_new([^'\"]*['\"]\\([a-zA-Z0-9_]+\\)"
5884 string)
5885 (setq class (idlwave-sintern-class (match-string 1 string)))
15e42531 5886 (setq idlwave-current-obj_new-class class)
f32b3b91
CD
5887 (setq keywords
5888 (append keywords
5889 (nth 5 (idlwave-rinfo-assq
5890 (idlwave-sintern-method "INIT")
5891 'fun
5892 class
5893 (idlwave-routines))))))))
5894
5895 ;; If the class is `t', combine all keywords of all methods NAME
5896 (when (eq class t)
5897 (loop for x in (idlwave-routines) do
5898 (and (nth 2 x) ; non-nil class
5899 (or (and (eq (nth 1 x) type) ; default type
5900 (eq (car x) name)) ; default name
5901 (and (eq (nth 1 x) type1) ; backup type
5902 (eq (car x) name1))) ; backup name
5903 (mapcar (lambda (k) (add-to-list 'keywords k))
5904 (nth 5 x))))
5905 (setq keywords (idlwave-uniquify keywords)))
5906 ;; Return the final list
5907 keywords))
5908
15e42531
CD
5909(defun idlwave-expand-keyword (keyword module)
5910 "Expand KEYWORD to one of the legal keyword parameters of MODULE.
5911KEYWORD may be an exact match or an abbreviation of a keyword.
5912If the match is exact, KEYWORD itself is returned, even if there may be other
5913keywords of which KEYWORD is an abbreviation. This is necessary because some
5914system routines have keywords which are prefixes of other keywords.
5915If KEYWORD is an abbreviation of several keywords, a list of all possible
5916completions is returned.
5917If the abbreviation was unique, the correct keyword is returned.
5918If it cannot be a keyword, the function return nil.
5919If we do not know about MODULE, just return KEYWORD literally."
5920 (let* ((name (car module))
5921 (type (nth 1 module))
5922 (class (nth 2 module))
5923 (kwd (idlwave-sintern-keyword keyword))
5924 (entry (idlwave-best-rinfo-assoc name type class (idlwave-routines)))
5925 (kwd-alist (nth 5 entry))
5926 (extra (or (assq (idlwave-sintern-keyword "_EXTRA") kwd-alist)
5927 (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist)))
5928 (completion-ignore-case t)
5929 candidates)
5930 (cond ((assq kwd kwd-alist)
5931 kwd)
5932 ((setq candidates (all-completions kwd kwd-alist))
5933 (if (= (length candidates) 1)
5934 (car candidates)
5935 candidates))
5936 ((and entry extra)
5937 ;; Inheritance may cause this keyword to be correct
5938 keyword)
5939 (entry
5940 ;; We do know the function, which does not have the keyword.
5941 nil)
5942 (t
5943 ;; We do not know the function, so this just might be a correct
5944 ;; keyword - return it as it is.
5945 keyword))))
5946
5947(defvar idlwave-rinfo-mouse-map (make-sparse-keymap))
f32b3b91 5948(defvar idlwave-rinfo-map (make-sparse-keymap))
15e42531 5949(define-key idlwave-rinfo-mouse-map
f32b3b91
CD
5950 (if (featurep 'xemacs) [button2] [mouse-2])
5951 'idlwave-mouse-active-rinfo)
15e42531
CD
5952(define-key idlwave-rinfo-mouse-map
5953 (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
5954 'idlwave-mouse-active-rinfo-shift)
5955(define-key idlwave-rinfo-mouse-map
f32b3b91
CD
5956 (if (featurep 'xemacs) [button3] [mouse-3])
5957 'idlwave-mouse-active-rinfo-right)
15e42531
CD
5958(define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space)
5959(define-key idlwave-rinfo-map "q" 'idlwave-quit-help)
5960(define-key idlwave-rinfo-mouse-map "q" 'idlwave-quit-help)
5961(defvar idlwave-popup-source nil)
5962(defvar idlwave-rinfo-marker (make-marker))
5963
5964(defun idlwave-quit-help ()
5965 (interactive)
5966 (let ((ri-window (get-buffer-window "*Help*"))
5967 (olh-window (get-buffer-window "*IDLWAVE Help*")))
5968 (when (and olh-window
5969 (fboundp 'idlwave-help-quit))
5970 (select-window olh-window)
5971 (idlwave-help-quit))
5972 (when (window-live-p ri-window)
5973 (delete-window ri-window))))
f32b3b91
CD
5974
5975(defun idlwave-display-calling-sequence (name type class)
5976 ;; Display the calling sequence of module NAME, type TYPE in class CLASS.
15e42531
CD
5977 (let* ((entry (or (idlwave-best-rinfo-assq name type class
5978 (idlwave-routines))
5979 (idlwave-rinfo-assq name type class
5980 idlwave-unresolved-routines)))
f32b3b91
CD
5981 (name (or (car entry) name))
5982 (class (or (nth 2 entry) class))
15e42531
CD
5983 (twins (idlwave-routine-twins entry))
5984 (dtwins (idlwave-study-twins twins))
5985 (all dtwins)
5986 (system (idlwave-rinfo-assq
5987 name type class idlwave-system-routines))
5988 (have-sysdoc (and system (idlwave-help-directory)))
5989 ;; (source (nth 3 entry))
5990 (have-olh (and (or system idlwave-extra-help-function)
5991 (idlwave-help-directory)))
f32b3b91
CD
5992 (calling-seq (nth 4 entry))
5993 (keywords (nth 5 entry))
5994 (olh (nth 6 entry))
15e42531
CD
5995 (help-echo-kwd
5996 (if have-olh
5997 "Button2: Insert KEYWORD (SHIFT=`/KEYWORD') Button3: Online Help "
5998 "Button2: Insert KEYWORD (SHIFT=`/KEYWORD')."))
5999 (help-echo-use
6000 (if have-olh
6001 "Button2/3: Online Help"
6002 nil))
6003 (help-echo-src
6004 (if (idlwave-help-directory)
6005 "Button2: Pop to source and back. Button3: Source in Help window."
6006 "Button2: Pop to source and back."))
f32b3b91
CD
6007 (col 0)
6008 (data (list name type class (current-buffer) olh))
6009 (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
15e42531
CD
6010 (face 'idlwave-help-link-face)
6011 beg props win cnt total)
f32b3b91
CD
6012 (setq keywords (idlwave-fix-keywords name type class keywords))
6013 (cond
6014 ((null entry)
6015 (error "No %s %s known" type name))
6016 ((or (null name) (equal name ""))
6017 (error "No function or procedure call at point."))
6018 ((null calling-seq)
6019 (error "Calling sequence of %s %s is not available" type name))
6020 (t
6021 (save-excursion
15e42531 6022 (move-marker idlwave-rinfo-marker (point))
f32b3b91 6023 (set-buffer (get-buffer-create "*Help*"))
15e42531 6024 (use-local-map idlwave-rinfo-map)
f32b3b91
CD
6025 (setq buffer-read-only nil)
6026 (erase-buffer)
6027 (set (make-local-variable 'idlwave-popup-source) nil)
15e42531
CD
6028 (set (make-local-variable 'idlwave-current-obj_new-class)
6029 idlwave-current-obj_new-class)
6030 (setq props (if have-olh
6031 (list 'mouse-face 'highlight
6032 km-prop idlwave-rinfo-mouse-map
6033 'help-echo help-echo-use
6034 'data (cons 'usage data))))
6035 (if have-sysdoc (setq props (append (list 'face face) props)))
f32b3b91
CD
6036 (insert "Usage: ")
6037 (setq beg (point))
6038 (insert (if class
6039 (format calling-seq class name)
6040 (format calling-seq name))
6041 "\n")
6042 (add-text-properties beg (point) props)
15e42531 6043
f32b3b91
CD
6044 (insert "Keywords:")
6045 (if (null keywords)
6046 (insert " No keywords accepted.")
6047 (setq col 9)
6048 (mapcar
6049 (lambda (x)
6050 (if (>= (+ col 1 (length (car x)))
6051 (window-width))
6052 (progn
6053 (insert "\n ")
6054 (setq col 9)))
6055 (insert " ")
6056 (setq beg (point)
6057 props (list 'mouse-face 'highlight
15e42531 6058 km-prop idlwave-rinfo-mouse-map
f32b3b91 6059 'data (cons 'keyword data)
15e42531 6060 'help-echo help-echo-kwd
f32b3b91 6061 'keyword (car x)))
15e42531 6062 (if have-sysdoc (setq props (append (list 'face face) props)))
f32b3b91
CD
6063 (insert (car x))
6064 (add-text-properties beg (point) props)
6065 (setq col (+ col 1 (length (car x)))))
6066 keywords))
15e42531
CD
6067
6068 (setq cnt 1 total (length all))
6069 (while (setq entry (pop all))
6070 (setq props (list 'mouse-face 'highlight
6071 km-prop idlwave-rinfo-mouse-map
6072 'help-echo help-echo-src
6073 'source (cons (car (nth 2 entry)) (nth 1 entry))
6074 'data (cons 'source data)))
6075 (idlwave-insert-source-location
6076 (format "\n%-8s %s"
6077 (if (equal cnt 1)
6078 (if (> total 1) "Sources:" "Source:")
6079 "")
6080 (if (> total 1) "- " ""))
6081 entry props)
6082 (incf cnt)
6083 (when (and all (> cnt idlwave-rinfo-max-source-lines))
6084 ;; No more source lines, please
6085 (insert (format
6086 "\n Source information truncated to %d entries."
6087 idlwave-rinfo-max-source-lines))
6088 (setq all nil)))
6089
f32b3b91
CD
6090 (setq buffer-read-only t))
6091 (display-buffer "*Help*")
6092 (if (and (setq win (get-buffer-window "*Help*"))
6093 idlwave-resize-routine-help-window)
6094 (progn
6095 (let ((ww (selected-window)))
6096 (unwind-protect
6097 (progn
6098 (select-window win)
6099 (enlarge-window (- (/ (frame-height) 2)
6100 (window-height)))
6101 (shrink-window-if-larger-than-buffer))
6102 (select-window ww)))))))))
6103
15e42531
CD
6104(defun idlwave-insert-source-location (prefix entry &optional file-props)
6105 "Insert a source location into the routine info buffer.
6106Start line with PREFIX.
6107If 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.
6162Return the name of the special lib if there is a match."
6163 (let ((alist idlwave-special-lib-alist)
6164 entry rtn)
6165 (cond
6166 ((stringp file)
6167 (while (setq entry (pop alist))
6168 (if (string-match (car entry) file)
6169 (setq rtn (cdr entry)
6170 alist nil)))
6171 rtn)
6172 (t nil))))
6173
f32b3b91
CD
6174(defun idlwave-mouse-active-rinfo-right (ev)
6175 (interactive "e")
6176 (idlwave-mouse-active-rinfo ev 'right))
6177
15e42531 6178(defun idlwave-mouse-active-rinfo-shift (ev)
f32b3b91 6179 (interactive "e")
15e42531
CD
6180 (idlwave-mouse-active-rinfo ev nil 'shift))
6181
6182(defun idlwave-active-rinfo-space ()
6183 (interactive)
6184 (idlwave-mouse-active-rinfo nil 'right))
6185
6186(defun idlwave-mouse-active-rinfo (ev &optional right shift)
6187 "Does the mouse actions in the routine info buffer.
6188Optional args RIGHT and SHIFT indicate, if mouse-3 was used, and if SHIFT
6189was pressed."
6190 (interactive "e")
6191 (if ev (mouse-set-point ev))
6192 (let (data id name type class buf keyword bufwin source)
f32b3b91 6193 (setq data (get-text-property (point) 'data)
15e42531 6194 source (get-text-property (point) 'source)
f32b3b91
CD
6195 keyword (get-text-property (point) 'keyword)
6196 id (car data)
15e42531 6197 name (nth 1 data) type (nth 2 data) class (nth 3 data)
f32b3b91 6198 buf (nth 4 data)
f32b3b91 6199 bufwin (get-buffer-window buf t))
15e42531
CD
6200 (cond ((eq id 'usage)
6201 (idlwave-require-online-help)
6202 (idlwave-online-help nil name type class))
6203 ((eq id 'source)
6204 (if (and right (idlwave-help-directory))
6205 (let ((idlwave-extra-help-function 'idlwave-help-with-source)
6206 (idlwave-help-source-try-header nil)
6207 ;; Fake idlwave-routines, to make help find the right entry
6208 (idlwave-routines
6209 (list (list (nth 1 data) (nth 2 data) (nth 3 data) source ""))))
6210 (idlwave-require-online-help)
6211 (idlwave-help-get-special-help name type class nil))
f32b3b91
CD
6212 (setq idlwave-popup-source (not idlwave-popup-source))
6213 (if idlwave-popup-source
6214 (condition-case err
15e42531 6215 (idlwave-do-find-module name type class source)
f32b3b91
CD
6216 (error
6217 (setq idlwave-popup-source nil)
6218 (if (window-live-p bufwin) (select-window bufwin))
6219 (error (nth 1 err))))
6220 (if bufwin
6221 (select-window bufwin)
15e42531
CD
6222 (pop-to-buffer buf))
6223 (goto-char (marker-position idlwave-rinfo-marker)))))
f32b3b91
CD
6224 ((eq id 'keyword)
6225 (if right
15e42531
CD
6226 (progn
6227 (idlwave-require-online-help)
6228 (idlwave-online-help nil name type class keyword))
6229 (idlwave-rinfo-insert-keyword keyword buf shift))))))
6230
6231(defun idlwave-rinfo-insert-keyword (keyword buffer &optional shift)
6232 "Insert KEYWORD in BUFFER. Make sure buffer is displayed in a window."
6233 (let ((bwin (get-buffer-window buffer)))
6234 (if idlwave-complete-empty-string-as-lower-case
6235 (setq keyword (downcase keyword)))
6236 (if bwin
6237 (select-window bwin)
6238 (pop-to-buffer buffer)
6239 (setq bwin (get-buffer-window buffer)))
6240 (if (eq (preceding-char) ?/)
6241 (insert keyword)
6242 (unless (save-excursion
6243 (re-search-backward
6244 "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\="
6245 (min (- (point) 100) (point-min)) t))
6246 (insert ", "))
6247 (if shift (insert "/"))
6248 (insert keyword)
6249 (if (and (not shift)
6250 idlwave-keyword-completion-adds-equal)
6251 (insert "=")))))
6252
6253(defun idlwave-list-buffer-load-path-shadows (&optional arg)
6254 "List the load path shadows of all routines defined in current buffer."
6255 (interactive "P")
6256 (idlwave-routines)
6257 (if (eq major-mode 'idlwave-mode)
6258 (idlwave-list-load-path-shadows
6259 nil (idlwave-update-current-buffer-info 'save-buffer)
6260 "in current buffer")
6261 (error "Current buffer is not in idlwave-mode")))
6262
6263(defun idlwave-list-shell-load-path-shadows (&optional arg)
6264 "List the load path shadows of all routines compiled under the shell.
6265This is very useful for checking an IDL application. Just compile the
6266application, do RESOLVE_ALL, and `C-c C-i' to compile all referenced
6267routines and update IDLWAVE internal info. Then check for shadowing
6268with 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.
6287Search the information IDLWAVE has about IDL routines for multiple
6288definitions.
6289When SPECIAL-ROUTINES in non-nil, only look for shadows of these routines.
6290
6291When IDL hits a routine call which is not defined, it will search on
6292the load path in order to find a definition. The output of this
6293command 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.
6403LIST defaults to `idlwave-routines'.
6404Twin entries are those which have the same name, type, and class.
6405ENTRY 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.
6423Dangerous twins are routines with same name, but in different files
6424on the load path.
6425If 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
6427routines 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.
6479It first compates class, names, and type. If it turns out that A and B
6480are twins (same name, class, and type), calls another routine which
6481compares 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.
6503This 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.
6524In here, A and B are not normal routine info entries, but special
6525lists (KEY FILENAME (TYPES...)).
6526This 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.
6607Info is cached, but relies on the functons setting `idlwave-path-alist'
6608to reset the variable `idlwave-true-path-alist' to nil."
6609 (or idlwave-true-path-alist
6610 (setq idlwave-true-path-alist
6611 (mapcar (lambda(x) (cons
6612 (file-name-as-directory
6613 (file-truename
6614 (directory-file-name
6615 (car x))))
6616 (cdr x)))
6617 idlwave-path-alist))))
6618
6619(defun idlwave-syslib-scanned-p ()
6620 "Non-nil if the system lib file !DIR/lib has been scanned."
6621 (let* ((true-syslib (file-name-as-directory
6622 (file-truename
6623 (expand-file-name "lib" (idlwave-sys-dir))))))
6624 (cdr (assoc true-syslib (idlwave-true-path-alist)))))
6625
6626;; ----------------------------------------------------------------------------
6627;;
6628;; Online Help display
6629
f32b3b91
CD
6630
6631;; ----------------------------------------------------------------------------
6632;;
6633;; Additions for use with imenu.el and func-menu.el
6634;; (pop-up a list of IDL units in the current file).
6635;;
6636
6637(defun idlwave-prev-index-position ()
6638 "Search for the previous procedure or function.
6639Return 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.
6648Assumes that point is at the beginning of the unit as found by
6649`idlwave-prev-index-position'."
6650 (forward-sexp 2)
6651 (forward-sexp -1)
6652 (let ((begin (point)))
6653 (re-search-forward "[a-zA-Z][a-zA-Z0-9$_]+\\(::[a-zA-Z][a-zA-Z0-9$_]+\\)?")
6654 (if (fboundp 'buffer-substring-no-properties)
6655 (buffer-substring-no-properties begin (point))
6656 (buffer-substring begin (point)))))
6657
6658(defun idlwave-function-menu ()
6659 "Use `imenu' or `function-menu' to jump to a procedure or function."
6660 (interactive)
6661 (if (string-match "XEmacs" emacs-version)
6662 (progn
6663 (require 'func-menu)
6664 (function-menu))
6665 (require 'imenu)
6666 (imenu (imenu-choose-buffer-index))))
6667
6668;; Here we kack func-menu.el in order to support this new mode.
6669;; The latest versions of func-menu.el already have this stuff in, so
6670;; we hack only if it is not already there.
6671(when (fboundp 'eval-after-load)
6672 (eval-after-load "func-menu"
6673 '(progn
6674 (or (assq 'idlwave-mode fume-function-name-regexp-alist)
6675 (not (boundp 'fume-function-name-regexp-idl)) ; avoid problems
6676 (setq fume-function-name-regexp-alist
6677 (cons '(idlwave-mode . fume-function-name-regexp-idl)
6678 fume-function-name-regexp-alist)))
6679 (or (assq 'idlwave-mode fume-find-function-name-method-alist)
6680 (not (fboundp 'fume-find-next-idl-function-name)) ; avoid problems
6681 (setq fume-find-function-name-method-alist
6682 (cons '(idlwave-mode . fume-find-next-idl-function-name)
6683 fume-find-function-name-method-alist))))))
6684
6685(defun idlwave-edit-in-idlde ()
6686 "Edit the current file in IDL Development environment."
6687 (interactive)
6688 (start-process "idldeclient" nil
6689 idlwave-shell-explicit-file-name "-c" "-e"
6690 (buffer-file-name) "&"))
6691
6692(defun idlwave-launch-idlhelp ()
6693 "Start the IDLhelp application."
6694 (interactive)
6695 (start-process "idlhelp" nil idlwave-help-application))
6696
6697;; Menus - using easymenu.el
6698(defvar idlwave-mode-menu-def
6699 `("IDLWAVE"
6700 ["PRO/FUNC menu" idlwave-function-menu t]
6701 ("Motion"
6702 ["Subprogram Start" idlwave-beginning-of-subprogram t]
6703 ["Subprogram End" idlwave-end-of-subprogram t]
6704 ["Block Start" idlwave-beginning-of-block t]
6705 ["Block End" idlwave-end-of-block t]
6706 ["Up Block" idlwave-backward-up-block t]
6707 ["Down Block" idlwave-down-block t]
6708 ["Skip Block Backward" idlwave-backward-block t]
6709 ["Skip Block Forward" idlwave-forward-block t])
6710 ("Mark"
6711 ["Subprogram" idlwave-mark-subprogram t]
6712 ["Block" idlwave-mark-block t]
6713 ["Header" idlwave-mark-doclib t])
6714 ("Format"
6715 ["Indent Subprogram" idlwave-indent-subprogram t]
6716 ["(Un)Comment Region" idlwave-toggle-comment-region "C-c ;"]
6717 ["Continue/Split line" idlwave-split-line t]
6718 "--"
6719 ["Toggle Auto Fill" idlwave-auto-fill-mode :style toggle
6720 :selected (symbol-value idlwave-fill-function)])
6721 ("Templates"
6722 ["Procedure" idlwave-procedure t]
6723 ["Function" idlwave-function t]
6724 ["Doc Header" idlwave-doc-header t]
6725 ["Log" idlwave-doc-modification t]
6726 "--"
6727 ["Case" idlwave-case t]
6728 ["For" idlwave-for t]
6729 ["Repeat" idlwave-repeat t]
6730 ["While" idlwave-while t]
6731 "--"
6732 ["Close Block" idlwave-close-block t])
15e42531 6733 ("Completion"
f32b3b91
CD
6734 ["Complete" idlwave-complete t]
6735 ("Complete Special"
6736 ["1 Procedure Name" (idlwave-complete 'procedure) t]
6737 ["2 Procedure Keyword" (idlwave-complete 'procedure-keyword) t]
6738 "--"
6739 ["3 Function Name" (idlwave-complete 'function) t]
6740 ["4 Function Keyword" (idlwave-complete 'function-keyword) t]
6741 "--"
6742 ["5 Procedure Method Name" (idlwave-complete 'procedure-method) t]
6743 ["6 Procedure Method Keyword" (idlwave-complete 'procedure-method-keyword) t]
6744 "--"
6745 ["7 Function Method Name" (idlwave-complete 'function-method) t]
6746 ["8 Function Method Keyword" (idlwave-complete 'function-method-keyword) t]
6747 "--"
15e42531
CD
6748 ["9 Class Name" idlwave-complete-class t]))
6749 ("Routine Info"
f32b3b91 6750 ["Show Routine Info" idlwave-routine-info t]
15e42531 6751 ["Online Context Help" idlwave-context-help (idlwave-help-directory)]
f32b3b91
CD
6752 "--"
6753 ["Find Routine Source" idlwave-find-module t]
15e42531 6754 ["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)]
f32b3b91
CD
6755 "--"
6756 ["Update Routine Info" idlwave-update-routine-info t]
6757 "--"
15e42531
CD
6758 "IDL Library Catalog"
6759 ["Select Catalog Directories" idlwave-create-libinfo-file t]
6760 ["Scan Directories" (idlwave-update-routine-info '(16))
6761 idlwave-path-alist]
6762 "--"
6763 "Routine Shadows"
6764 ["Check Current Buffer" idlwave-list-buffer-load-path-shadows t]
6765 ["Check Compiled Routines" idlwave-list-shell-load-path-shadows t]
6766 ["Check Everything" idlwave-list-all-load-path-shadows t])
6767 ("Misc"
6768 ["Kill auto-created buffers" idlwave-kill-autoloaded-buffers t]
6769 "--"
6770 ["Insert TAB character" idlwave-hard-tab t])
f32b3b91
CD
6771 "--"
6772 ("External"
6773 ["Generate IDL tags" idlwave-make-tags t]
6774 ["Start IDL shell" idlwave-shell t]
6775 ["Edit file in IDLDE" idlwave-edit-in-idlde t]
6776 ["Launch IDL Help" idlwave-launch-idlhelp t])
6777 "--"
6778 ("Customize"
6779 ["Browse IDLWAVE Group" idlwave-customize t]
6780 "--"
6781 ["Build Full Customize Menu" idlwave-create-customize-menu
6782 (fboundp 'customize-menu-create)])
6783 ("Documentation"
6784 ["Describe Mode" describe-mode t]
6785 ["Abbreviation List" idlwave-list-abbrevs t]
6786 "--"
6787 ["Commentary in idlwave.el" idlwave-show-commentary t]
595ab50b 6788 ["Commentary in idlw-shell.el" idlwave-shell-show-commentary t]
f32b3b91
CD
6789 "--"
6790 ["Info" idlwave-info t]
6791 "--"
6792 ["Launch IDL Help" idlwave-launch-idlhelp t])))
6793
6794(defvar idlwave-mode-debug-menu-def
6795 '("Debug"
6796 ["Start IDL shell" idlwave-shell t]
6797 ["Save and .RUN buffer" idlwave-shell-save-and-run
6798 (and (boundp 'idlwave-shell-automatic-start)
6799 idlwave-shell-automatic-start)]))
6800
6801(if (or (featurep 'easymenu) (load "easymenu" t))
6802 (progn
6803 (easy-menu-define idlwave-mode-menu idlwave-mode-map
6804 "IDL and WAVE CL editing menu"
6805 idlwave-mode-menu-def)
6806 (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
6807 "IDL and WAVE CL editing menu"
6808 idlwave-mode-debug-menu-def)))
6809
6810(defun idlwave-customize ()
6811 "Call the customize function with idlwave as argument."
6812 (interactive)
6813 ;; Try to load the code for the shell, so that we can customize it
6814 ;; as well.
22d5821d
CD
6815 (or (featurep 'idlw-shell)
6816 (load "idlw-shell" t))
f32b3b91
CD
6817 (customize-browse 'idlwave))
6818
6819(defun idlwave-create-customize-menu ()
6820 "Create a full customization menu for IDLWAVE, insert it into the menu."
6821 (interactive)
6822 (if (fboundp 'customize-menu-create)
6823 (progn
6824 ;; Try to load the code for the shell, so that we can customize it
6825 ;; as well.
22d5821d
CD
6826 (or (featurep 'idlw-shell)
6827 (load "idlw-shell" t))
f32b3b91
CD
6828 (easy-menu-change
6829 '("IDLWAVE") "Customize"
6830 `(["Browse IDLWAVE group" idlwave-customize t]
6831 "--"
6832 ,(customize-menu-create 'idlwave)
6833 ["Set" Custom-set t]
6834 ["Save" Custom-save t]
6835 ["Reset to Current" Custom-reset-current t]
6836 ["Reset to Saved" Custom-reset-saved t]
6837 ["Reset to Standard Settings" Custom-reset-standard t]))
6838 (message "\"IDLWAVE\"-menu now contains full customization menu"))
6839 (error "Cannot expand menu (outdated version of cus-edit.el)")))
6840
6841(defun idlwave-show-commentary ()
6842 "Use the finder to view the file documentation from `idlwave.el'."
6843 (interactive)
6844 (require 'finder)
6845 (finder-commentary "idlwave.el"))
6846
6847(defun idlwave-shell-show-commentary ()
595ab50b 6848 "Use the finder to view the file documentation from `idlw-shell.el'."
f32b3b91
CD
6849 (interactive)
6850 (require 'finder)
595ab50b 6851 (finder-commentary "idlw-shell.el"))
f32b3b91
CD
6852
6853(defun idlwave-info ()
6854 "Read documentation for IDLWAVE in the info system."
6855 (interactive)
6856 (require 'info)
6857 (Info-goto-node "(idlwave)"))
6858
6859(defun idlwave-list-abbrevs (arg)
6860 "Show the code abbreviations define in IDLWAVE mode.
6861This lists all abbrevs where the replacement text differs from the input text.
6862These are the ones the users want to learn to speed up their writing.
6863
6864The function does *not* list abbrevs which replace a word with itself
6865to call a hook. These hooks are used to change the case of words or
6866to blink the matching `begin', and the user does not need to know them.
6867
6868With arg, list all abbrevs with the corresponding hook.
6869
6870This function was written since `list-abbrevs' looks terrible for IDLWAVE mode."
6871
6872 (interactive "P")
6873 (let ((table (symbol-value 'idlwave-mode-abbrev-table))
6874 abbrevs
6875 str rpl func fmt (len-str 0) (len-rpl 0))
6876 (mapatoms
6877 (lambda (sym)
6878 (if (symbol-value sym)
6879 (progn
6880 (setq str (symbol-name sym)
6881 rpl (symbol-value sym)
6882 func (symbol-function sym))
6883 (if arg
6884 (setq func (prin1-to-string func))
6885 (if (and (listp func) (stringp (nth 2 func)))
6886 (setq rpl (concat "EVAL: " (nth 2 func))
6887 func "")
6888 (setq func "")))
6889 (if (or arg (not (string= rpl str)))
6890 (progn
6891 (setq len-str (max len-str (length str)))
6892 (setq len-rpl (max len-rpl (length rpl)))
6893 (setq abbrevs (cons (list str rpl func) abbrevs)))))))
6894 table)
6895 ;; sort the list
6896 (setq abbrevs (sort abbrevs (lambda (a b) (string< (car a) (car b)))))
6897 ;; Make the format
6898 (setq fmt (format "%%-%ds %%-%ds %%s\n" len-str len-rpl))
6899 (with-output-to-temp-buffer "*Help*"
6900 (if arg
6901 (progn
6902 (princ "Abbreviations and Actions in IDLWAVE-Mode\n")
6903 (princ "=========================================\n\n")
6904 (princ (format fmt "KEY" "REPLACE" "HOOK"))
6905 (princ (format fmt "---" "-------" "----")))
6906 (princ "Code Abbreviations and Templates in IDLWAVE-Mode\n")
6907 (princ "================================================\n\n")
6908 (princ (format fmt "KEY" "ACTION" ""))
6909 (princ (format fmt "---" "------" "")))
6910 (mapcar
6911 (lambda (list)
6912 (setq str (car list)
6913 rpl (nth 1 list)
6914 func (nth 2 list))
6915 (princ (format fmt str rpl func)))
6916 abbrevs)))
6917 ;; Make sure each abbreviation uses only one display line
6918 (save-excursion
6919 (set-buffer "*Help*")
6920 (setq truncate-lines t)))
6921
15e42531
CD
6922;; Try to load online help, but catch any errors.
6923(condition-case nil
6924 (idlwave-require-online-help)
6925 (error nil))
6926
6927;; Run the hook
f32b3b91
CD
6928(run-hooks 'idlwave-load-hook)
6929
6930(provide 'idlwave)
6931
6932;;; idlwave.el ends here
6933