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