1 |
;;; idlwave.el --- IDL editing mode for GNU Emacs |
;; idlwave.el --- IDL editing mode for GNU Emacs |
2 |
;; Copyright (c) 1999, 2000, 2001,2002 Free Software Foundation |
;; Copyright (c) 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation |
3 |
|
|
4 |
;; Author: Carsten Dominik <dominik@astro.uva.nl> |
;; Authors: J.D. Smith <jdsmith@as.arizona.edu> |
5 |
;; Chris Chase <chase@att.com> |
;; Carsten Dominik <dominik@astro.uva.nl> |
6 |
|
;; Chris Chase <chase@att.com> |
7 |
;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> |
;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> |
8 |
;; Version: 4.15 |
;; Version: 5.5 |
9 |
;; Keywords: languages |
;; Keywords: languages |
10 |
|
|
11 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
27 |
|
|
28 |
;;; Commentary: |
;;; Commentary: |
29 |
|
|
30 |
;; In distant past, based on pascal.el. Though bears little |
;; In the remotely distant past, based on pascal.el, though bears |
31 |
;; resemblance to that now. |
;; little resemblance to it now. |
32 |
;; |
;; |
33 |
;; Incorporates many ideas, such as abbrevs, action routines, and |
;; Incorporates many ideas, such as abbrevs, action routines, and |
34 |
;; continuation line indenting, from wave.el. |
;; continuation line indenting, from wave.el. |
58 |
;; ====== |
;; ====== |
59 |
;; |
;; |
60 |
;; The newest version of this file is available from the maintainer's |
;; The newest version of this file is available from the maintainer's |
61 |
;; Webpage. |
;; Webpage: |
62 |
;; |
;; |
63 |
;; http://idlwave.org |
;; http://idlwave.org |
64 |
;; |
;; |
65 |
;; DOCUMENTATION |
;; DOCUMENTATION |
66 |
;; ============= |
;; ============= |
67 |
;; |
;; |
68 |
;; IDLWAVE is documented online in info format. |
;; IDLWAVE is documented online in info format. A printable version |
69 |
;; A printable version of the documentation is available from the |
;; of the documentation is available from the maintainers webpage (see |
70 |
;; maintainers webpage (see under SOURCE) |
;; SOURCE). |
|
;; |
|
71 |
;; |
;; |
72 |
|
;; |
73 |
;; ACKNOWLEDGMENTS |
;; ACKNOWLEDGMENTS |
74 |
;; =============== |
;; =============== |
75 |
;; |
;; |
76 |
;; Thanks to the following people for their contributions and comments: |
;; Thanks to the following people for their contributions and comments: |
77 |
;; |
;; |
78 |
;; Ulrik Dickow <dickow@nbi.dk> |
;; Ulrik Dickow <dickow_at_nbi.dk> |
79 |
;; Eric E. Dors <edors@lanl.gov> |
;; Eric E. Dors <edors_at_lanl.gov> |
80 |
;; Stein Vidar H. Haugan <s.v.h.haugan@astro.uio.no> |
;; Stein Vidar H. Haugan <s.v.h.haugan_at_astro.uio.no> |
81 |
;; David Huenemoerder <dph@space.mit.edu> |
;; David Huenemoerder <dph_at_space.mit.edu> |
82 |
;; Kevin Ivory <Kevin.Ivory@linmpi.mpg.de> |
;; Kevin Ivory <Kevin.Ivory_at_linmpi.mpg.de> |
83 |
;; Xuyong Liu <liu@stsci.edu> |
;; Dick Jackson <dick_at_d-jackson.com> |
84 |
;; Simon Marshall <Simon.Marshall@esrin.esa.it> |
;; Xuyong Liu <liu_at_stsci.edu> |
85 |
;; Laurent Mugnier <mugnier@onera.fr> |
;; Simon Marshall <Simon.Marshall_at_esrin.esa.it> |
86 |
;; Lubos Pochman <lubos@rsinc.com> |
;; Laurent Mugnier <mugnier_at_onera.fr> |
87 |
;; Bob Portmann <portmann@al.noaa.gov> |
;; Lubos Pochman <lubos_at_rsinc.com> |
88 |
;; Patrick M. Ryan <pat@jaameri.gsfc.nasa.gov> |
;; Bob Portmann <portmann_at_al.noaa.gov> |
89 |
;; Marty Ryba <ryba@ll.mit.edu> |
;; Patrick M. Ryan <pat_at_jaameri.gsfc.nasa.gov> |
90 |
;; Phil Williams <williams@irc.chmcc.org> |
;; Marty Ryba <ryba_at_ll.mit.edu> |
91 |
;; Phil Sterne <sterne@dublin.llnl.gov> |
;; Paul Sorenson <aardvark62_at_msn.com> |
92 |
|
;; Phil Sterne <sterne_at_dublin.llnl.gov> |
93 |
|
;; Phil Williams <williams_at_irc.chmcc.org> |
94 |
;; |
;; |
95 |
;; CUSTOMIZATION: |
;; CUSTOMIZATION: |
96 |
;; ============= |
;; ============= |
97 |
;; |
;; |
98 |
;; IDLWAVE has extensive customize support - so if you want to learn |
;; IDLWAVE has extensive customize support; to learn about the |
99 |
;; about the variables which control the behavior of the mode, use |
;; variables which control the mode's behavior, use `M-x |
100 |
;; `M-x idlwave-customize'. |
;; idlwave-customize'. |
101 |
;; |
;; |
102 |
;; You can set your own preferred values with Customize, or with Lisp |
;; You can set your own preferred values with Customize, or with Lisp |
103 |
;; code in .emacs. For an example of what to put into .emacs, check |
;; code in .emacs. For an example of what to put into .emacs, check |
104 |
;; the TexInfo documentation or see a complete .emacs at |
;; the TexInfo documentation or see a complete .emacs available at the |
105 |
;; http://idlwave.org. |
;; website. |
106 |
;; |
;; |
107 |
;; KNOWN PROBLEMS: |
;; KNOWN PROBLEMS: |
108 |
;; ============== |
;; ============== |
110 |
;; IDLWAVE support for the IDL-derived PV-WAVE CL language of Visual |
;; IDLWAVE support for the IDL-derived PV-WAVE CL language of Visual |
111 |
;; Numerics, Inc. is growing less and less complete as the two |
;; Numerics, Inc. is growing less and less complete as the two |
112 |
;; languages grow increasingly apart. The mode probably shouldn't |
;; languages grow increasingly apart. The mode probably shouldn't |
113 |
;; even have "WAVE" in it's title, but it's catchy, and required to |
;; even have "WAVE" in it's title, but it's catchy, and was required |
114 |
;; avoid conflict with the CORBA idl.el mode. Caveat WAVEor. |
;; to avoid conflict with the CORBA idl.el mode. Caveat WAVEor. |
115 |
;; |
;; |
116 |
;; Moving the point backwards in conjunction with abbrev expansion |
;; Moving the point backwards in conjunction with abbrev expansion |
117 |
;; does not work as I would like it, but this is a problem with |
;; does not work as I would like it, but this is a problem with |
119 |
;; up inserting the character that expanded the abbrev after moving |
;; up inserting the character that expanded the abbrev after moving |
120 |
;; point backward, e.g., "\cl" expanded with a space becomes |
;; point backward, e.g., "\cl" expanded with a space becomes |
121 |
;; "LONG( )" with point before the close paren. This is solved by |
;; "LONG( )" with point before the close paren. This is solved by |
122 |
;; using a temporary function in `post-command-hook' - not pretty, |
;; using a temporary function in `post-command-hook' - not pretty, |
123 |
;; but it works. |
;; but it works. |
124 |
;; |
;; |
125 |
;; Tabs and spaces are treated equally as whitespace when filling a |
;; Tabs and spaces are treated equally as whitespace when filling a |
129 |
;; limited to comments only and occurs only when a comment |
;; limited to comments only and occurs only when a comment |
130 |
;; paragraph is filled via `idlwave-fill-paragraph'. |
;; paragraph is filled via `idlwave-fill-paragraph'. |
131 |
;; |
;; |
132 |
;; Avoid muti-statement lines (using "&") on block begin and end |
;; Muti-statement lines (using "&") on block begin and end lines can |
133 |
;; lines. Multi-statement lines can mess up the formatting, for |
;; ruin the formatting. For example, multiple end statements on a |
134 |
;; example, multiple end statements on a line: endif & endif. |
;; line: endif & endif. Using "&" outside of block begin/end lines |
135 |
;; Using "&" outside of block begin/end lines should be okay. |
;; should be okay. |
136 |
;; |
;; |
137 |
;; Determining the expression at point for printing and other |
;; Determining the expression at point for printing and other |
138 |
;; examination commands is somewhat rough: currently only fairly |
;; examination commands is somewhat rough: currently only fairly |
139 |
;; simple entities are found. You can always drag-select or examine |
;; simple entities are found. You can always drag-select or examine |
140 |
;; a region. |
;; a pre-selected region. |
141 |
;; |
;; |
142 |
;; When forcing completion of method keywords, the initial |
;; When forcing completion of method keywords, the initial |
143 |
;; query for a method has multiple entries for some methods. Would |
;; query for a method has multiple entries for some methods. Would |
146 |
|
|
147 |
;;; Code: |
;;; Code: |
148 |
|
|
149 |
|
|
150 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
151 |
|
(require 'idlw-help) |
152 |
|
|
153 |
|
;; For XEmacs |
154 |
|
(unless (fboundp 'line-beginning-position) |
155 |
|
(defalias 'line-beginning-position 'point-at-bol)) |
156 |
|
(unless (fboundp 'line-end-position) |
157 |
|
(defalias 'line-end-position 'point-at-eol)) |
158 |
|
(unless (fboundp 'char-valid-p) |
159 |
|
(defalias 'char-valid-p 'characterp)) |
160 |
|
|
161 |
(eval-and-compile |
(eval-and-compile |
162 |
;; Kludge to allow `defcustom' for Emacs 19. |
;; Kludge to allow `defcustom' for Emacs 19. |
165 |
nil ;; We've got what we needed |
nil ;; We've got what we needed |
166 |
;; We have the old or no custom-library, hack around it! |
;; We have the old or no custom-library, hack around it! |
167 |
(defmacro defgroup (&rest args) nil) |
(defmacro defgroup (&rest args) nil) |
168 |
(defmacro defcustom (var value doc &rest args) |
(defmacro defcustom (var value doc &rest args) |
169 |
`(defvar ,var ,value ,doc)))) |
`(defvar ,var ,value ,doc)))) |
170 |
|
|
171 |
(defgroup idlwave nil |
(defgroup idlwave nil |
172 |
"Major mode for editing IDL .pro files" |
"Major mode for editing IDL .pro files" |
173 |
:tag "IDLWAVE" |
:tag "IDLWAVE" |
174 |
:link '(url-link :tag "Home Page" |
:link '(url-link :tag "Home Page" |
175 |
"http://idlwave.org") |
"http://idlwave.org") |
176 |
:link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" |
:link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" |
177 |
"idlw-shell.el") |
"idlw-shell.el") |
180 |
:prefix "idlwave" |
:prefix "idlwave" |
181 |
:group 'languages) |
:group 'languages) |
182 |
|
|
183 |
|
|
184 |
;;; Variables for indentation behavior --------------------------------------- |
;;; Variables for indentation behavior --------------------------------------- |
185 |
|
|
186 |
(defgroup idlwave-code-formatting nil |
(defgroup idlwave-code-formatting nil |
223 |
standard continuation indentation, otherwise defaulting to a fixed |
standard continuation indentation, otherwise defaulting to a fixed |
224 |
offset. Set to 0 to effectively disable all special continuation |
offset. Set to 0 to effectively disable all special continuation |
225 |
indentation, or to a large number (like 100) to enable it in all |
indentation, or to a large number (like 100) to enable it in all |
226 |
cases. See also `idlwave-indent-top-open-paren', which can override |
cases. See also `idlwave-indent-to-open-paren', which can override |
227 |
this variable." |
this variable." |
228 |
:group 'idlwave-code-formatting |
:group 'idlwave-code-formatting |
229 |
:type 'integer) |
:type 'integer) |
252 |
:group 'idlwave-code-formatting |
:group 'idlwave-code-formatting |
253 |
:type 'boolean) |
:type 'boolean) |
254 |
|
|
255 |
|
(defcustom idlwave-indent-parens-nested nil |
256 |
|
"*Non-nil means, indent continuation lines with parens by nesting |
257 |
|
lines at consecutively deeper levels." |
258 |
|
:group 'idlwave-code-formatting |
259 |
|
:type 'boolean) |
260 |
|
|
261 |
|
|
262 |
(defcustom idlwave-hanging-indent t |
(defcustom idlwave-hanging-indent t |
263 |
"*If set non-nil then comment paragraphs are indented under the |
"*If set non-nil then comment paragraphs are indented under the |
264 |
hanging indent given by `idlwave-hang-indent-regexp' match in the first line |
hanging indent given by `idlwave-hang-indent-regexp' match in the first line |
285 |
|
|
286 |
(defcustom idlwave-auto-fill-split-string t |
(defcustom idlwave-auto-fill-split-string t |
287 |
"*If non-nil then auto fill will split strings with the IDL `+' operator. |
"*If non-nil then auto fill will split strings with the IDL `+' operator. |
288 |
When the line end falls within a string, string concatenation with the |
When the line end falls within a string, string concatenation with the |
289 |
'+' operator will be used to distribute a long string over lines. |
'+' operator will be used to distribute a long string over lines. |
290 |
If nil and a string is split then a terminal beep and warning are issued. |
If nil and a string is split then a terminal beep and warning are issued. |
291 |
|
|
292 |
This variable is ignored when `idlwave-fill-comment-line-only' is |
This variable is ignored when `idlwave-fill-comment-line-only' is |
329 |
;; Comments not matching any of the above will be indented as a |
;; Comments not matching any of the above will be indented as a |
330 |
;; right-margin comment, i.e., to a minimum of `comment-column'. |
;; right-margin comment, i.e., to a minimum of `comment-column'. |
331 |
|
|
|
|
|
332 |
;;; Routine Info and Completion --------------------------------------- |
;;; Routine Info and Completion --------------------------------------- |
333 |
|
|
334 |
(defgroup idlwave-routine-info nil |
(defgroup idlwave-routine-info nil |
335 |
"Routine Info options for IDLWAVE mode." |
"Routine Info options for IDLWAVE mode." |
336 |
:group 'idlwave) |
:group 'idlwave) |
337 |
|
|
338 |
|
(defcustom idlwave-use-library-catalogs t |
339 |
|
"*Non-nil means search the IDL path for library catalog files. |
340 |
|
|
341 |
|
These files, named .idlwave_catalog, document routine information for |
342 |
|
individual directories and libraries of IDL .pro files. Many popular |
343 |
|
libraries come with catalog files by default, so leaving this on is a |
344 |
|
usually a good idea.." |
345 |
|
:group 'idlwave-routine-info |
346 |
|
:type 'boolean) |
347 |
|
|
348 |
(defcustom idlwave-init-rinfo-when-idle-after 10 |
(defcustom idlwave-init-rinfo-when-idle-after 10 |
349 |
"*Seconds of idle time before routine info is automatically initialized. |
"*Seconds of idle time before routine info is automatically initialized. |
350 |
Initializing the routine info can take long, in particular if a large |
Initializing the routine info can take long, in particular if a large |
351 |
library catalog is involved. When Emacs is idle for more than the number |
library catalog is involved. When Emacs is idle for more than the number |
352 |
of seconds specified by this variable, it starts the initialization. |
of seconds specified by this variable, it starts the initialization. |
353 |
The process is split into five steps, in order to keep possible work |
The process is split into five steps, in order to keep possible work |
354 |
interruption as short as possible. If one of the steps finishes, and no |
interruption as short as possible. If one of the steps finishes, and no |
355 |
user input has arrived in the mean time, initialization proceeds immediately |
user input has arrived in the mean time, initialization proceeds immediately |
356 |
to the next step. |
to the next step. |
402 |
(const :tag "When saving a buffer" save-buffer) |
(const :tag "When saving a buffer" save-buffer) |
403 |
(const :tag "After a buffer was killed" kill-buffer) |
(const :tag "After a buffer was killed" kill-buffer) |
404 |
(const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) |
(const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) |
405 |
|
|
406 |
(defcustom idlwave-rinfo-max-source-lines 5 |
(defcustom idlwave-rinfo-max-source-lines 5 |
407 |
"*Maximum number of source files displayed in the Routine Info window. |
"*Maximum number of source files displayed in the Routine Info window. |
408 |
When an integer, it is the maximum number of source files displayed. |
When an integer, it is the maximum number of source files displayed. |
411 |
:type 'integer) |
:type 'integer) |
412 |
|
|
413 |
(defcustom idlwave-library-path nil |
(defcustom idlwave-library-path nil |
414 |
"Library path for Windows and MacOS. Not needed under Unix. |
"Library path for Windows and MacOS. Not needed under Unix. When |
415 |
When selecting the directories to scan for IDL library routine info, |
selecting the directories to scan for IDL user catalog routine info, |
416 |
IDLWAVE can under UNIX query the shell for the exact search path. |
IDLWAVE can, under UNIX, query the shell for the exact search path |
417 |
However, under Windows and MacOS, the IDLWAVE shell does not work. In this |
\(the value of !PATH). However, under Windows and MacOS (pre-OSX), |
418 |
case, this variable specifies the path where IDLWAVE can find library files. |
the IDLWAVE shell does not work. In this case, this variable can be |
419 |
The shell will only be asked when this variable is nil. |
set to specify the paths where IDLWAVE can find PRO files. The shell |
420 |
The value is a list of directories. A directory preceeded by a `+' will |
will only be asked for a list of paths when this variable is nil. The |
421 |
be searched recursively. If you set this variable on a UNIX system, the shell |
value is a list of directories. A directory preceeded by a `+' will |
422 |
will not be asked. |
be searched recursively. If you set this variable on a UNIX system, |
423 |
See also `idlwave-system-directory'." |
the shell will not be queried. See also `idlwave-system-directory'." |
424 |
:group 'idlwave-routine-info |
:group 'idlwave-routine-info |
425 |
:type '(repeat (directory))) |
:type '(repeat (directory))) |
426 |
|
|
427 |
(defcustom idlwave-system-directory "" |
(defcustom idlwave-system-directory "" |
428 |
"The IDL system directory for Windows and MacOS. Not needed under UNIX. |
"The IDL system directory for Windows and MacOS. Not needed under |
429 |
Set this to the value of the `!DIR' system variable in IDL. IDLWAVE uses |
UNIX. Set this to the value of the `!DIR' system variable in IDL. |
430 |
this to find out which of the library routines belong to the official system |
IDLWAVE uses this to find out which of the library routines belong to |
431 |
library. All files inside the `lib' subdirectory are considered system |
the official system library. All files inside the `lib' subdirectory |
432 |
library files - so don't install private stuff in this directory. |
are considered system library files - so don't install private stuff |
433 |
On UNIX systems, IDLWAVE queries the shell for the value of `!DIR'. |
in this directory. On UNIX systems, IDLWAVE queries the shell for the |
434 |
See also `idlwave-library-path'." |
value of `!DIR'. See also `idlwave-library-path'." |
435 |
:group 'idlwave-routine-info |
:group 'idlwave-routine-info |
436 |
:type 'directory) |
:type 'directory) |
437 |
|
|
438 |
(defcustom idlwave-libinfo-file "~/.idlcat.el" |
(defcustom idlwave-config-directory |
439 |
"*File for routine information of the IDL library. |
(convert-standard-filename "~/.idlwave") |
440 |
When this points to a file, the file will be loaded when IDLWAVE first |
"*Directory for configuration files and user-library catalog." |
|
accesses routine info (or does completion). |
|
|
When you scan the library with `idlwave-create-libinfo-file', this file |
|
|
will be used to store the result." |
|
441 |
:group 'idlwave-routine-info |
:group 'idlwave-routine-info |
442 |
:type 'file) |
:type 'file) |
443 |
|
|
444 |
|
(defvar idlwave-user-catalog-file "idlusercat.el") |
445 |
|
(defvar idlwave-path-file "idlpath.el") |
446 |
|
|
447 |
|
(defvar idlwave-libinfo-file nil |
448 |
|
"*Obsolete variable, no longer used.") |
449 |
|
|
450 |
(defcustom idlwave-special-lib-alist nil |
(defcustom idlwave-special-lib-alist nil |
451 |
"Alist of regular expressions matching special library directories. |
"Alist of regular expressions matching special library directories. |
452 |
When listing routine source locations, IDLWAVE gives a short hint where |
When listing routine source locations, IDLWAVE gives a short hint where |
453 |
the file defining the routine is located. By default it lists `SystemLib' |
the file defining the routine is located. By default it lists `SystemLib' |
454 |
for routines in the system library `!DIR/lib' and `Library' for anything |
for routines in the system library `!DIR/lib' and `Library' for anything |
455 |
else. This variable can define additional types. The car of each entry |
else. This variable can define additional types. The car of each entry |
456 |
is a regular expression matching the file name (they normally will match |
is a regular expression matching the file name (they normally will match |
460 |
:type '(repeat |
:type '(repeat |
461 |
(cons regexp string))) |
(cons regexp string))) |
462 |
|
|
463 |
(defgroup idlwave-online-help nil |
(defcustom idlwave-auto-write-paths t |
464 |
"Online Help options for IDLWAVE mode." |
"Write out path (!PATH) and system directory (!DIR) info automatically. |
465 |
:group 'idlwave) |
Path info is needed to locate library catalog files. If non-nil, |
466 |
|
whenever the path-list changes as a result of shell-query, etc., it is |
467 |
(defcustom idlwave-help-directory "" |
written to file. Otherwise, the menu option \"Write Paths\" can be |
468 |
"The directory where idlw-help.txt and idlw-help.el are stored." |
used to force a write." |
469 |
:group 'idlwave-online-help |
:group 'idlwave-routine-info |
|
:type 'file) |
|
|
|
|
|
(defcustom idlwave-help-use-dedicated-frame t |
|
|
"*Non-nil means, use a separate frame for Online Help if possible." |
|
|
:group 'idlwave-online-help |
|
|
:type 'boolean) |
|
|
|
|
|
(defcustom idlwave-help-frame-parameters |
|
|
'((height . 20) (unsplittable . t)) |
|
|
"The frame parameters for the special Online Help frame. |
|
|
See also `idlwave-help-use-dedicated-frame'. |
|
|
If you do not set the frame width here, the value specified in |
|
|
`idlw-help.el' will be used." |
|
|
:group 'idlwave-online-help |
|
|
:type '(repeat |
|
|
(cons symbol sexp))) |
|
|
|
|
|
(defcustom idlwave-max-popup-menu-items 20 |
|
|
"Maximum number of items per pane in popup menus. |
|
|
Currently only used for class selection during completion help." |
|
|
:group 'idlwave-online-help |
|
|
:type 'integer) |
|
|
|
|
|
(defcustom idlwave-extra-help-function 'idlwave-help-with-source |
|
|
"The function to call for online help if the normal help fails. |
|
|
Online help works only for system routines which are described in the |
|
|
IDL manuals. A function may be specified to access help from other sources. |
|
|
|
|
|
The function must accept four arguments: NAME, TYPE, CLASS, KEYWORD. |
|
|
The Help buffer is current when this function is called, and the help |
|
|
text should be loaded into this buffer. If help is found, the function |
|
|
should return the buffer position which should be used as `window-start' |
|
|
in the help window. Also, the variable `idlwave-help-mode-line-indicator' |
|
|
should be set to a useful string, which will be displayed in the mode line |
|
|
of the help window. If should also set the variable `idlwave-min-frame-width' |
|
|
to a positive integer. IDLWAVE will ensure that the help frame is at |
|
|
least that many columns wide. |
|
|
Failure to find help should be indicated by throwing an error. |
|
|
|
|
|
When this variable is non-nil, IDLWAVE will allow the mouse-3 help click |
|
|
for every routine and keyword, even though the item may not be highlighted |
|
|
in blue (indicating the availability of system documentation). |
|
|
|
|
|
The default value for this function is `idlwave-help-with-source' which |
|
|
loads the routine source file into the help buffer. If you try to write |
|
|
a different function which accesses a special help file or so, it is |
|
|
probably a good idea to still call this function as a fallback." |
|
|
:group 'idlwave-online-help |
|
|
:type 'symbol) |
|
|
|
|
|
(defcustom idlwave-help-fontify-source-code nil |
|
|
"*Non-nil means, fontify source code displayed as help like normal code." |
|
|
:group 'idlwave-online-help |
|
|
:type 'boolean) |
|
|
|
|
|
(defcustom idlwave-help-source-try-header t |
|
|
"*Non-nil means, try to find help in routine header when displaying source. |
|
|
Routines which are not documented in the system manual use their source as |
|
|
help text. When this variable is non-nil, we try to find a description of |
|
|
the help item in the first routine doclib header above the routine definition. |
|
|
If the variable is nil, or if we cannot find/parse the header, the routine |
|
|
definition is displayed instead." |
|
|
:group 'idlwave-online-help |
|
|
:type 'boolean) |
|
|
|
|
|
(defface idlwave-help-link-face |
|
|
'((((class color)) (:foreground "Blue")) |
|
|
(t (:weight bold))) |
|
|
"Face for highlighting links into IDLWAVE online help." |
|
|
:group 'idlwave-online-help) |
|
|
|
|
|
(defcustom idlwave-help-activate-links-aggressively t |
|
|
"*Non-nil means, make all possible links in help active. |
|
|
This just activates all words which are also a help topic - some links may |
|
|
be misleading." |
|
|
:group 'idlwave-online-help |
|
470 |
:type 'boolean) |
:type 'boolean) |
471 |
|
|
|
|
|
472 |
(defgroup idlwave-completion nil |
(defgroup idlwave-completion nil |
473 |
"Completion options for IDLWAVE mode." |
"Completion options for IDLWAVE mode." |
474 |
:prefix "idlwave" |
:prefix "idlwave" |
492 |
This variable determines the case (UPPER/lower/Capitalized...) of |
This variable determines the case (UPPER/lower/Capitalized...) of |
493 |
words inserted into the buffer by completion. The preferred case can |
words inserted into the buffer by completion. The preferred case can |
494 |
be specified separately for routine names, keywords, classes and |
be specified separately for routine names, keywords, classes and |
495 |
methods. |
methods. |
496 |
This alist should therefore have entries for `routine' (normal |
This alist should therefore have entries for `routine' (normal |
497 |
functions and procedures, i.e. non-methods), `keyword', `class', and |
functions and procedures, i.e. non-methods), `keyword', `class', and |
498 |
`method'. Plausible values are |
`method'. Plausible values are |
579 |
for which to assume this can be set here." |
for which to assume this can be set here." |
580 |
:group 'idlwave-routine-info |
:group 'idlwave-routine-info |
581 |
:type '(repeat (regexp :tag "Match method:"))) |
:type '(repeat (regexp :tag "Match method:"))) |
582 |
|
|
583 |
|
|
584 |
(defcustom idlwave-completion-show-classes 1 |
(defcustom idlwave-completion-show-classes 1 |
585 |
"*Number of classes to show when completing object methods and keywords. |
"*Number of classes to show when completing object methods and keywords. |
644 |
specify if the class should be found during method and keyword |
specify if the class should be found during method and keyword |
645 |
completion, respectively. |
completion, respectively. |
646 |
|
|
647 |
The alist may have additional entries specifying exceptions from the |
The alist may have additional entries specifying exceptions from the |
648 |
keyword completion rule for specific methods, like INIT or |
keyword completion rule for specific methods, like INIT or |
649 |
GETPROPERTY. In order to turn on class specification for the INIT |
GETPROPERTY. In order to turn on class specification for the INIT |
650 |
method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." |
method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." |
668 |
value of the variable `idlwave-query-class'. |
value of the variable `idlwave-query-class'. |
669 |
|
|
670 |
When you specify a class, this information can be stored as a text |
When you specify a class, this information can be stored as a text |
671 |
property on the `->' arrow in the source code, so that during the same |
property on the `->' arrow in the source code, so that during the same |
672 |
editing session, IDLWAVE will not have to ask again. When this |
editing session, IDLWAVE will not have to ask again. When this |
673 |
variable is non-nil, IDLWAVE will store and reuse the class information. |
variable is non-nil, IDLWAVE will store and reuse the class information. |
674 |
The class stored can be checked and removed with `\\[idlwave-routine-info]' |
The class stored can be checked and removed with `\\[idlwave-routine-info]' |
762 |
:type 'boolean) |
:type 'boolean) |
763 |
|
|
764 |
(defcustom idlwave-pad-keyword t |
(defcustom idlwave-pad-keyword t |
765 |
"*Non-nil means pad '=' for keywords like assignments. |
"*Non-nil means pad '=' in keywords (routine calls or defs) like assignment. |
766 |
Whenever `idlwave-surround' is non-nil then this affects how '=' is padded |
Whenever `idlwave-surround' is non-nil then this affects how '=' is |
767 |
for keywords. If t, it is padded the same as for assignments. |
padded for keywords and for variables. If t, pad the same as for |
768 |
If nil then spaces are removed. With any other value, spaces are left |
assignments. If nil then spaces are removed. With any other value, |
769 |
unchanged." |
spaces are left unchanged." |
770 |
:group 'idlwave-abbrev-and-indent-action |
:group 'idlwave-abbrev-and-indent-action |
771 |
:type '(choice |
:type '(choice |
772 |
(const :tag "Pad like assignments" t) |
(const :tag "Pad like assignments" t) |
1048 |
:group 'idlwave-misc |
:group 'idlwave-misc |
1049 |
:type 'boolean) |
:type 'boolean) |
1050 |
|
|
1051 |
(defcustom idlwave-default-font-lock-items |
(defcustom idlwave-default-font-lock-items |
1052 |
'(pros-and-functions batch-files idlwave-idl-keywords label goto |
'(pros-and-functions batch-files idlwave-idl-keywords label goto |
1053 |
common-blocks class-arrows) |
common-blocks class-arrows) |
1054 |
"Items which should be fontified on the default fontification level 2. |
"Items which should be fontified on the default fontification level 2. |
1106 |
;;; Non customization variables |
;;; Non customization variables |
1107 |
|
|
1108 |
;;; font-lock mode - Additions by Phil Williams, Ulrik Dickow and |
;;; font-lock mode - Additions by Phil Williams, Ulrik Dickow and |
1109 |
;;; Simon Marshall <simon@gnu.ai.mit.edu> |
;;; Simon Marshall <simon_at_gnu.ai.mit.edu> |
1110 |
;;; and Carsten Dominik... |
;;; and Carsten Dominik... |
1111 |
|
|
1112 |
;; The following are the reserved words in IDL. Maybe we should |
;; The following are the reserved words in IDL. Maybe we should |
1113 |
;; highlight some more stuff as well? |
;; highlight some more stuff as well? |
1114 |
;; Procedure declarations. Fontify keyword plus procedure name. |
;; Procedure declarations. Fontify keyword plus procedure name. |
1115 |
(defvar idlwave-idl-keywords |
(defvar idlwave-idl-keywords |
1116 |
;; To update this regexp, update the list of keywords and |
;; To update this regexp, update the list of keywords and |
1117 |
;; evaluate the form. |
;; evaluate the form. |
1118 |
;; (insert |
;; (insert |
1119 |
;; (prin1-to-string |
;; (prin1-to-string |
1120 |
;; (concat |
;; (concat |
1121 |
;; "\\<\\(" |
;; "\\<\\(" |
1122 |
;; (regexp-opt |
;; (regexp-opt |
1123 |
;; '("and" "or" "xor" "not" |
;; '("||" "&&" "and" "or" "xor" "not" |
1124 |
;; "eq" "ge" "gt" "le" "lt" "ne" |
;; "eq" "ge" "gt" "le" "lt" "ne" |
1125 |
;; "for" "do" "endfor" |
;; "for" "do" "endfor" |
1126 |
;; "if" "then" "endif" "else" "endelse" |
;; "if" "then" "endif" "else" "endelse" |
1127 |
;; "case" "of" "endcase" |
;; "case" "of" "endcase" |
1128 |
;; "switch" "break" "continue" "endswitch" |
;; "switch" "break" "continue" "endswitch" |
1129 |
;; "begin" "end" |
;; "begin" "end" |
1130 |
;; "repeat" "until" "endrep" |
;; "repeat" "until" "endrep" |
1131 |
;; "while" "endwhile" |
;; "while" "endwhile" |
1132 |
;; "goto" "return" |
;; "goto" "return" |
1133 |
;; "inherits" "mod" |
;; "inherits" "mod" |
1134 |
;; "compile_opt" "forward_function" |
;; "compile_opt" "forward_function" |
1135 |
;; "on_error" "on_ioerror")) ; on_error is not officially reserved |
;; "on_error" "on_ioerror")) ; on_error is not officially reserved |
1136 |
;; "\\)\\>"))) |
;; "\\)\\>"))) |
1137 |
"\\<\\(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\\)\\>") |
"\\<\\(&&\\|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\\|||\\)\\>") |
1138 |
|
|
1139 |
|
|
1140 |
(let* (;; Procedure declarations. Fontify keyword plus procedure name. |
(let* (;; Procedure declarations. Fontify keyword plus procedure name. |
1141 |
;; Function declarations. Fontify keyword plus function name. |
;; Function declarations. Fontify keyword plus function name. |
1151 |
(2 font-lock-reference-face nil t) ; block name |
(2 font-lock-reference-face nil t) ; block name |
1152 |
(font-lock-match-c++-style-declaration-item-and-skip-to-next |
(font-lock-match-c++-style-declaration-item-and-skip-to-next |
1153 |
;; Start with point after block name and comma |
;; Start with point after block name and comma |
1154 |
(goto-char (match-end 0)) ; needed for XEmacs, could be nil |
(goto-char (match-end 0)) ; needed for XEmacs, could be nil |
1155 |
nil |
nil |
1156 |
(1 font-lock-variable-name-face) ; variable names |
(1 font-lock-variable-name-face) ; variable names |
1157 |
))) |
))) |
1174 |
(1 font-lock-keyword-face) |
(1 font-lock-keyword-face) |
1175 |
(2 font-lock-reference-face))) |
(2 font-lock-reference-face))) |
1176 |
|
|
1177 |
;; Tags in structure definitions. Note that this definition actually |
;; Tags in structure definitions. Note that this definition |
1178 |
;; collides with labels, so we have to use the same face. |
;; actually collides with labels, so we have to use the same |
1179 |
|
;; face. It also matches named subscript ranges, |
1180 |
|
;; e.g. vec{bottom:top]. No good way around this. |
1181 |
(structtag |
(structtag |
1182 |
'("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face))) |
'("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face))) |
1183 |
|
|
1186 |
'("\\({\\|\\<inherits\\s-\\)\\s-*\\([a-zA-Z][a-zA-Z0-9_]*\\)[},\t \n]" |
'("\\({\\|\\<inherits\\s-\\)\\s-*\\([a-zA-Z][a-zA-Z0-9_]*\\)[},\t \n]" |
1187 |
(2 font-lock-function-name-face))) |
(2 font-lock-function-name-face))) |
1188 |
|
|
1189 |
;; Named parameters, like /xlog or ,xrange=[] |
;; Keyword parameters, like /xlog or ,xrange=[] |
1190 |
;; This is anchored to the comma preceeding the keyword. |
;; This is anchored to the comma preceeding the keyword. |
1191 |
;; Treats continuation lines, works only during whole buffer |
;; Treats continuation lines, works only during whole buffer |
1192 |
;; fontification. Slow, use it only in fancy fontification. |
;; fontification. Slow, use it only in fancy fontification. |
1206 |
;; All operators (not used because too noisy) |
;; All operators (not used because too noisy) |
1207 |
(all-operators |
(all-operators |
1208 |
'("[-*^#+<>/]" (0 font-lock-keyword-face))) |
'("[-*^#+<>/]" (0 font-lock-keyword-face))) |
1209 |
|
|
1210 |
;; Arrows with text property `idlwave-class' |
;; Arrows with text property `idlwave-class' |
1211 |
(class-arrows |
(class-arrows |
1212 |
'(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) |
'(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) |
1243 |
|
|
1244 |
(defvar idlwave-font-lock-defaults |
(defvar idlwave-font-lock-defaults |
1245 |
'((idlwave-font-lock-keywords |
'((idlwave-font-lock-keywords |
1246 |
idlwave-font-lock-keywords-1 |
idlwave-font-lock-keywords-1 |
1247 |
idlwave-font-lock-keywords-2 |
idlwave-font-lock-keywords-2 |
1248 |
idlwave-font-lock-keywords-3) |
idlwave-font-lock-keywords-3) |
1249 |
nil t |
nil t |
1250 |
((?$ . "w") (?_ . "w") (?. . "w")) |
((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) |
1251 |
beginning-of-line)) |
beginning-of-line)) |
1252 |
|
|
1253 |
(put 'idlwave-mode 'font-lock-defaults |
(put 'idlwave-mode 'font-lock-defaults |
1254 |
idlwave-font-lock-defaults) ; XEmacs |
idlwave-font-lock-defaults) ; XEmacs |
1255 |
|
|
1256 |
(defconst idlwave-comment-line-start-skip "^[ \t]*;" |
(defconst idlwave-comment-line-start-skip "^[ \t]*;" |
1258 |
That is the _beginning_ of a line containing a comment delimiter `;' preceded |
That is the _beginning_ of a line containing a comment delimiter `;' preceded |
1259 |
only by whitespace.") |
only by whitespace.") |
1260 |
|
|
1261 |
(defconst idlwave-begin-block-reg |
(defconst idlwave-begin-block-reg |
1262 |
"\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" |
"\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" |
1263 |
"Regular expression to find the beginning of a block. The case does |
"Regular expression to find the beginning of a block. The case does |
1264 |
not matter. The search skips matches in comments.") |
not matter. The search skips matches in comments.") |
1265 |
|
|
1266 |
(defconst idlwave-begin-unit-reg "\\<\\(pro\\|function\\)\\>\\|\\`" |
(defconst idlwave-begin-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\`" |
1267 |
"Regular expression to find the beginning of a unit. The case does |
"Regular expression to find the beginning of a unit. The case does |
1268 |
not matter.") |
not matter.") |
1269 |
|
|
1270 |
(defconst idlwave-end-unit-reg "\\<\\(pro\\|function\\)\\>\\|\\'" |
(defconst idlwave-end-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\'" |
1271 |
"Regular expression to find the line that indicates the end of unit. |
"Regular expression to find the line that indicates the end of unit. |
1272 |
This line is the end of buffer or the start of another unit. The case does |
This line is the end of buffer or the start of another unit. The case does |
1273 |
not matter. The search skips matches in comments.") |
not matter. The search skips matches in comments.") |
1303 |
blocks starting with a BEGIN statement. The matches must have associations |
blocks starting with a BEGIN statement. The matches must have associations |
1304 |
`idlwave-block-matches'") |
`idlwave-block-matches'") |
1305 |
|
|
1306 |
(defconst idlwave-identifier "[a-zA-Z][a-zA-Z0-9$_]*" |
(defconst idlwave-identifier "[a-zA-Z_][a-zA-Z0-9$_]*" |
1307 |
"Regular expression matching an IDL identifier.") |
"Regular expression matching an IDL identifier.") |
1308 |
|
|
1309 |
(defconst idlwave-sysvar (concat "!" idlwave-identifier) |
(defconst idlwave-sysvar (concat "!" idlwave-identifier) |
1315 |
(defconst idlwave-label (concat idlwave-identifier ":") |
(defconst idlwave-label (concat idlwave-identifier ":") |
1316 |
"Regular expression matching IDL labels.") |
"Regular expression matching IDL labels.") |
1317 |
|
|
1318 |
|
(defconst idlwave-method-call (concat idlwave-identifier "\\s *->" |
1319 |
|
"\\(\\s *" idlwave-identifier "::\\)?" |
1320 |
|
)) |
1321 |
|
|
1322 |
(defconst idlwave-statement-match |
(defconst idlwave-statement-match |
1323 |
(list |
(list |
1324 |
;; "endif else" is the only possible "end" that can be |
;; "endif else" is the only possible "end" that can be |
1335 |
'(goto . ("goto\\>" nil)) |
'(goto . ("goto\\>" nil)) |
1336 |
'(case . ("case\\>" nil)) |
'(case . ("case\\>" nil)) |
1337 |
'(switch . ("switch\\>" nil)) |
'(switch . ("switch\\>" nil)) |
1338 |
(cons 'call (list (concat idlwave-identifier "\\(\\s *$\\|\\s *,\\)") nil)) |
(cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" |
1339 |
'(assign . ("[^=>\n]*=" nil))) |
"\\(" idlwave-method-call "\\s *\\)?" |
1340 |
|
idlwave-identifier |
1341 |
|
"\\s *(") nil)) |
1342 |
|
(cons 'call (list (concat |
1343 |
|
"\\(" idlwave-method-call "\\s *\\)?" |
1344 |
|
idlwave-identifier |
1345 |
|
"\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil)) |
1346 |
|
(cons 'assign (list (concat |
1347 |
|
"\\(" idlwave-variable "\\) *=") nil))) |
1348 |
|
|
1349 |
"Associated list of statement matching regular expressions. |
"Associated list of statement matching regular expressions. |
1350 |
Each regular expression matches the start of an IDL statement. The |
Each regular expression matches the start of an IDL statement. The |
1351 |
first element of each association is a symbol giving the statement |
first element of each association is a symbol giving the statement |
1368 |
;; Note that this is documented in the v18 manuals as being a string |
;; Note that this is documented in the v18 manuals as being a string |
1369 |
;; of length one rather than a single character. |
;; of length one rather than a single character. |
1370 |
;; The code in this file accepts either format for compatibility. |
;; The code in this file accepts either format for compatibility. |
1371 |
(defvar idlwave-comment-indent-char ?\s |
(defvar idlwave-comment-indent-char ?\ |
1372 |
"Character to be inserted for IDL comment indentation. |
"Character to be inserted for IDL comment indentation. |
1373 |
Normally a space.") |
Normally a space.") |
1374 |
|
|
1376 |
"Character which is inserted as a last character on previous line by |
"Character which is inserted as a last character on previous line by |
1377 |
\\[idlwave-split-line] to begin a continuation line. Normally $.") |
\\[idlwave-split-line] to begin a continuation line. Normally $.") |
1378 |
|
|
1379 |
(defconst idlwave-mode-version " 4.15") |
(defconst idlwave-mode-version "5.5") |
1380 |
|
|
1381 |
(defmacro idlwave-keyword-abbrev (&rest args) |
(defmacro idlwave-keyword-abbrev (&rest args) |
1382 |
"Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." |
"Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." |
1534 |
(define-key idlwave-mode-map "\C-c\C-m" 'idlwave-doc-modification) |
(define-key idlwave-mode-map "\C-c\C-m" 'idlwave-doc-modification) |
1535 |
(define-key idlwave-mode-map "\C-c\C-c" 'idlwave-case) |
(define-key idlwave-mode-map "\C-c\C-c" 'idlwave-case) |
1536 |
(define-key idlwave-mode-map "\C-c\C-d" 'idlwave-debug-map) |
(define-key idlwave-mode-map "\C-c\C-d" 'idlwave-debug-map) |
|
(define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) |
|
|
(define-key idlwave-mode-map "\C-c\C-d\C-b" 'idlwave-shell-break-here) |
|
1537 |
(when (and (boundp 'idlwave-shell-debug-modifiers) |
(when (and (boundp 'idlwave-shell-debug-modifiers) |
1538 |
(listp idlwave-shell-debug-modifiers) |
(listp idlwave-shell-debug-modifiers) |
1539 |
(not (equal idlwave-shell-debug-modifiers '()))) |
(not (equal idlwave-shell-debug-modifiers '()))) |
1540 |
;; Bind the debug commands also with the special modifiers. |
;; Bind the debug commands also with the special modifiers. |
1541 |
(let ((shift (memq 'shift idlwave-shell-debug-modifiers)) |
(let ((shift (memq 'shift idlwave-shell-debug-modifiers)) |
1542 |
(mods-noshift (delq 'shift |
(mods-noshift (delq 'shift |
1543 |
(copy-sequence idlwave-shell-debug-modifiers)))) |
(copy-sequence idlwave-shell-debug-modifiers)))) |
1544 |
(define-key idlwave-mode-map |
(define-key idlwave-mode-map |
1545 |
(vector (append mods-noshift (list (if shift ?C ?c)))) |
(vector (append mods-noshift (list (if shift ?C ?c)))) |
1546 |
'idlwave-shell-save-and-run) |
'idlwave-shell-save-and-run) |
1547 |
(define-key idlwave-mode-map |
(define-key idlwave-mode-map |
1548 |
(vector (append mods-noshift (list (if shift ?B ?b)))) |
(vector (append mods-noshift (list (if shift ?B ?b)))) |
1549 |
'idlwave-shell-break-here))) |
'idlwave-shell-break-here) |
1550 |
|
(define-key idlwave-mode-map |
1551 |
|
(vector (append mods-noshift (list (if shift ?E ?e)))) |
1552 |
|
'idlwave-shell-run-region))) |
1553 |
|
(define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) |
1554 |
|
(define-key idlwave-mode-map "\C-c\C-d\C-b" 'idlwave-shell-break-here) |
1555 |
|
(define-key idlwave-mode-map "\C-c\C-d\C-e" 'idlwave-shell-run-region) |
1556 |
(define-key idlwave-mode-map "\C-c\C-f" 'idlwave-for) |
(define-key idlwave-mode-map "\C-c\C-f" 'idlwave-for) |
1557 |
;; (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-function) |
;; (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-function) |
1558 |
;; (define-key idlwave-mode-map "\C-c\C-p" 'idlwave-procedure) |
;; (define-key idlwave-mode-map "\C-c\C-p" 'idlwave-procedure) |
1571 |
"Save and run buffer under the shell." t) |
"Save and run buffer under the shell." t) |
1572 |
(autoload 'idlwave-shell-break-here "idlw-shell" |
(autoload 'idlwave-shell-break-here "idlw-shell" |
1573 |
"Set breakpoint in current line." t) |
"Set breakpoint in current line." t) |
1574 |
|
(autoload 'idlwave-shell-run-region "idlw-shell" |
1575 |
|
"Compile and run the region." t) |
1576 |
(define-key idlwave-mode-map "\C-c\C-v" 'idlwave-find-module) |
(define-key idlwave-mode-map "\C-c\C-v" 'idlwave-find-module) |
1577 |
(define-key idlwave-mode-map "\C-c?" 'idlwave-routine-info) |
(define-key idlwave-mode-map "\C-c?" 'idlwave-routine-info) |
1578 |
(define-key idlwave-mode-map "\M-?" 'idlwave-context-help) |
(define-key idlwave-mode-map "\M-?" 'idlwave-context-help) |
1579 |
(define-key idlwave-mode-map [(control meta ?\?)] 'idlwave-online-help) |
(define-key idlwave-mode-map [(control meta ?\?)] 'idlwave-online-help) |
1580 |
|
;; Pickup both forms of Esc/Meta binding |
1581 |
(define-key idlwave-mode-map [(meta tab)] 'idlwave-complete) |
(define-key idlwave-mode-map [(meta tab)] 'idlwave-complete) |
1582 |
(define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info) |
(define-key idlwave-mode-map [?\e?\t] 'idlwave-complete) |
1583 |
(define-key idlwave-mode-map "\C-c=" 'idlwave-resolve) |
(define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete) |
1584 |
(define-key idlwave-mode-map |
(define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info) |
1585 |
|
(define-key idlwave-mode-map "\C-c=" 'idlwave-resolve) |
1586 |
|
(define-key idlwave-mode-map |
1587 |
(if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) |
(if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) |
1588 |
'idlwave-mouse-context-help) |
'idlwave-mouse-context-help) |
1589 |
|
|
1590 |
;; Set action and key bindings. |
;; Set action and key bindings. |
1591 |
;; See description of the function `idlwave-action-and-binding'. |
;; See description of the function `idlwave-action-and-binding'. |
1592 |
;; Automatically add spaces for the following characters |
;; Automatically add spaces for the following characters |
1593 |
(idlwave-action-and-binding "&" '(idlwave-surround -1 -1)) |
;(idlwave-action-and-binding "&" '(idlwave-surround -1 -1 '(?&) 1 |
1594 |
|
; (lambda (char) 0))) |
1595 |
(idlwave-action-and-binding "<" '(idlwave-surround -1 -1)) |
(idlwave-action-and-binding "<" '(idlwave-surround -1 -1)) |
1596 |
;; Binding works for both > and ->, by changing the length of the token. |
;; Binding works for both > and ->, by changing the length of the token. |
1597 |
(idlwave-action-and-binding ">" '(idlwave-surround -1 -1 '(?-) 1 |
(idlwave-action-and-binding ">" '(idlwave-surround -1 -1 '(?-) 1 |
1598 |
'idlwave-gtr-pad-hook)) |
'idlwave-gtr-pad-hook)) |
1599 |
(idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t) |
(idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t) |
1600 |
(idlwave-action-and-binding "," '(idlwave-surround 0 -1)) |
(idlwave-action-and-binding "," '(idlwave-surround 0 -1)) |
1601 |
|
|
1602 |
;; Automatically add spaces to equal sign if not keyword |
;; Automatically add spaces to equal sign if not keyword |
1603 |
(idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1)) |
(idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1)) |
1604 |
|
|
1628 |
(error (apply 'define-abbrev args))))) |
(error (apply 'define-abbrev args))))) |
1629 |
|
|
1630 |
(condition-case nil |
(condition-case nil |
1631 |
(modify-syntax-entry (string-to-char idlwave-abbrev-start-char) |
(modify-syntax-entry (string-to-char idlwave-abbrev-start-char) |
1632 |
"w" idlwave-mode-syntax-table) |
"w" idlwave-mode-syntax-table) |
1633 |
(error nil)) |
(error nil)) |
1634 |
|
|
1701 |
(idlwave-define-abbrev "s" "size()" (idlwave-keyword-abbrev 1)) |
(idlwave-define-abbrev "s" "size()" (idlwave-keyword-abbrev 1)) |
1702 |
(idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1)) |
(idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1)) |
1703 |
(idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0)) |
(idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0)) |
1704 |
|
|
1705 |
;; This section is reserved words only. (From IDL user manual) |
;; This section is reserved words only. (From IDL user manual) |
1706 |
;; |
;; |
1707 |
(idlwave-define-abbrev "and" "and" (idlwave-keyword-abbrev 0 t) t) |
(idlwave-define-abbrev "and" "and" (idlwave-keyword-abbrev 0 t) t) |
1750 |
(defvar imenu-extract-index-name-function) |
(defvar imenu-extract-index-name-function) |
1751 |
(defvar imenu-prev-index-position-function) |
(defvar imenu-prev-index-position-function) |
1752 |
;; defined later - so just make the compiler hush |
;; defined later - so just make the compiler hush |
1753 |
(defvar idlwave-mode-menu) |
(defvar idlwave-mode-menu) |
1754 |
(defvar idlwave-mode-debug-menu) |
(defvar idlwave-mode-debug-menu) |
1755 |
|
|
1756 |
;;;###autoload |
;;;###autoload |
1757 |
(defun idlwave-mode () |
(defun idlwave-mode () |
1758 |
"Major mode for editing IDL and WAVE CL .pro files. |
"Major mode for editing IDL source files (version 5.5). |
1759 |
|
|
1760 |
The main features of this mode are |
The main features of this mode are |
1761 |
|
|
1782 |
relative to the first will be retained. Use |
relative to the first will be retained. Use |
1783 |
\\[idlwave-auto-fill-mode] to toggle auto-fill mode for these |
\\[idlwave-auto-fill-mode] to toggle auto-fill mode for these |
1784 |
comments. When the variable `idlwave-fill-comment-line-only' is |
comments. When the variable `idlwave-fill-comment-line-only' is |
1785 |
nil, code can also be auto-filled and auto-indented (not |
nil, code can also be auto-filled and auto-indented. |
|
recommended). |
|
1786 |
|
|
1787 |
To convert pre-existing IDL code to your formatting style, mark the |
To convert pre-existing IDL code to your formatting style, mark the |
1788 |
entire buffer with \\[mark-whole-buffer] and execute |
entire buffer with \\[mark-whole-buffer] and execute |
1797 |
source file of a module. These commands know about system |
source file of a module. These commands know about system |
1798 |
routines, all routines in idlwave-mode buffers and (when the |
routines, all routines in idlwave-mode buffers and (when the |
1799 |
idlwave-shell is active) about all modules currently compiled under |
idlwave-shell is active) about all modules currently compiled under |
1800 |
this shell. Use \\[idlwave-update-routine-info] to update this |
this shell. It also makes use of pre-compiled or custom-scanned |
1801 |
|
user and library catalogs many popular libraries ship with by |
1802 |
|
default. Use \\[idlwave-update-routine-info] to update this |
1803 |
information, which is also used for completion (see item 4). |
information, which is also used for completion (see item 4). |
1804 |
|
|
1805 |
3. Online IDL Help |
3. Online IDL Help |
1806 |
--------------- |
--------------- |
1807 |
\\[idlwave-context-help] displays the IDL documentation relevant |
\\[idlwave-context-help] displays the IDL documentation relevant |
1808 |
for the system variable, keyword, or routine at point. A single key |
for the system variable, keyword, or routine at point. A single |
1809 |
stroke gets you directly to the right place in the docs. Two additional |
key stroke gets you directly to the right place in the docs. The |
1810 |
files (an ASCII version of the IDL documentation and a topics file) must |
HTML help files package must be installed for this to work -- check |
1811 |
be installed for this - check the IDLWAVE webpage for these files. |
the IDLWAVE webpage for the correct package for your version. See |
1812 |
|
the manual to configure where and how the HTML help is displayed. |
1813 |
|
|
1814 |
4. Completion |
4. Completion |
1815 |
---------- |
---------- |
1816 |
\\[idlwave-complete] completes the names of procedures, functions |
\\[idlwave-complete] completes the names of procedures, functions |
1817 |
class names and keyword parameters. It is context sensitive and |
class names, keyword parameters, system variables and tags, class |
1818 |
figures out what is expected at point (procedure/function/keyword). |
tags, structure tags, filenames and much more. It is context |
1819 |
Lower case strings are completed in lower case, other strings in |
sensitive and figures out what is expected at point. Lower case |
1820 |
mixed or upper case. |
strings are completed in lower case, other strings in mixed or |
1821 |
|
upper case. |
1822 |
|
|
1823 |
5. Code Templates and Abbreviations |
5. Code Templates and Abbreviations |
1824 |
-------------------------------- |
-------------------------------- |
1835 |
\\i IF statement template |
\\i IF statement template |
1836 |
\\elif IF-ELSE statement template |
\\elif IF-ELSE statement template |
1837 |
\\b BEGIN |
\\b BEGIN |
1838 |
|
|
1839 |
For a full list, use \\[idlwave-list-abbrevs]. Some templates also have |
For a full list, use \\[idlwave-list-abbrevs]. Some templates also |
1840 |
direct keybindings - see the list of keybindings below. |
have direct keybindings - see the list of keybindings below. |
1841 |
|
|
1842 |
\\[idlwave-doc-header] inserts a documentation header at the beginning of the |
\\[idlwave-doc-header] inserts a documentation header at the |
1843 |
current program unit (pro, function or main). Change log entries |
beginning of the current program unit (pro, function or main). |
1844 |
can be added to the current program unit with \\[idlwave-doc-modification]. |
Change log entries can be added to the current program unit with |
1845 |
|
\\[idlwave-doc-modification]. |
1846 |
|
|
1847 |
6. Automatic Case Conversion |
6. Automatic Case Conversion |
1848 |
------------------------- |
------------------------- |
1877 |
|
|
1878 |
(interactive) |
(interactive) |
1879 |
(kill-all-local-variables) |
(kill-all-local-variables) |
1880 |
|
|
1881 |
(if idlwave-startup-message |
(if idlwave-startup-message |
1882 |
(message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) |
(message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) |
1883 |
(setq idlwave-startup-message nil) |
(setq idlwave-startup-message nil) |
1884 |
|
|
1885 |
(setq local-abbrev-table idlwave-mode-abbrev-table) |
(setq local-abbrev-table idlwave-mode-abbrev-table) |
1886 |
(set-syntax-table idlwave-mode-syntax-table) |
(set-syntax-table idlwave-mode-syntax-table) |
1887 |
|
|
1888 |
(set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) |
(set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) |
1889 |
|
|
1890 |
(make-local-variable idlwave-comment-indent-function) |
(make-local-variable idlwave-comment-indent-function) |
1891 |
(set idlwave-comment-indent-function 'idlwave-comment-hook) |
(set idlwave-comment-indent-function 'idlwave-comment-hook) |
1892 |
|
|
1893 |
(set (make-local-variable 'comment-start-skip) ";+[ \t]*") |
(set (make-local-variable 'comment-start-skip) ";+[ \t]*") |
1894 |
(set (make-local-variable 'comment-start) ";") |
(set (make-local-variable 'comment-start) ";") |
1895 |
(set (make-local-variable 'require-final-newline) t) |
(set (make-local-variable 'require-final-newline) t) |
1896 |
(set (make-local-variable 'abbrev-all-caps) t) |
(set (make-local-variable 'abbrev-all-caps) t) |
1897 |
(set (make-local-variable 'indent-tabs-mode) nil) |
(set (make-local-variable 'indent-tabs-mode) nil) |
1898 |
(set (make-local-variable 'completion-ignore-case) t) |
(set (make-local-variable 'completion-ignore-case) t) |
1899 |
|
|
1900 |
(use-local-map idlwave-mode-map) |
(use-local-map idlwave-mode-map) |
1901 |
|
|
1902 |
(when (featurep 'easymenu) |
(when (featurep 'easymenu) |
1906 |
(setq mode-name "IDLWAVE") |
(setq mode-name "IDLWAVE") |
1907 |
(setq major-mode 'idlwave-mode) |
(setq major-mode 'idlwave-mode) |
1908 |
(setq abbrev-mode t) |
(setq abbrev-mode t) |
1909 |
|
|
1910 |
(set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) |
(set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) |
1911 |
(setq comment-end "") |
(setq comment-end "") |
1912 |
(set (make-local-variable 'comment-multi-line) nil) |
(set (make-local-variable 'comment-multi-line) nil) |
1913 |
(set (make-local-variable 'paragraph-separate) |
(set (make-local-variable 'paragraph-separate) |
1914 |
"[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$") |
"[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$") |
1915 |
(set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") |
(set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") |
1916 |
(set (make-local-variable 'paragraph-ignore-fill-prefix) nil) |
(set (make-local-variable 'paragraph-ignore-fill-prefix) nil) |
1919 |
;; Set tag table list to use IDLTAGS as file name. |
;; Set tag table list to use IDLTAGS as file name. |
1920 |
(if (boundp 'tag-table-alist) |
(if (boundp 'tag-table-alist) |
1921 |
(add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) |
(add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) |
1922 |
|
|
1923 |
;; Font-lock additions - originally Phil Williams, then Ulrik Dickow |
;; Font-lock additions - originally Phil Williams, then Ulrik Dickow |
1924 |
;; Following line is for Emacs - XEmacs uses the corresponding porperty |
;; Following line is for Emacs - XEmacs uses the corresponding property |
1925 |
;; on the `idlwave-mode' symbol. |
;; on the `idlwave-mode' symbol. |
1926 |
(set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) |
(set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) |
1927 |
|
|
1946 |
(add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) |
(add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) |
1947 |
(add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) |
(add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) |
1948 |
|
|
1949 |
|
;; Setup directories and file, if necessary |
1950 |
|
(idlwave-setup) |
1951 |
|
|
1952 |
;; Update the routine info with info about current buffer? |
;; Update the routine info with info about current buffer? |
1953 |
(idlwave-new-buffer-update) |
(idlwave-new-buffer-update) |
1954 |
|
|
1955 |
;; Run the mode hook |
;; Run the mode hook |
1956 |
(run-hooks 'idlwave-mode-hook)) |
(run-hooks 'idlwave-mode-hook)) |
1957 |
|
|
1958 |
|
(defvar idlwave-setup-done nil) |
1959 |
|
(defun idlwave-setup () |
1960 |
|
(unless idlwave-setup-done |
1961 |
|
(if (not (file-directory-p idlwave-config-directory)) |
1962 |
|
(make-directory idlwave-config-directory)) |
1963 |
|
(setq idlwave-user-catalog-file (expand-file-name |
1964 |
|
idlwave-user-catalog-file |
1965 |
|
idlwave-config-directory) |
1966 |
|
idlwave-path-file (expand-file-name |
1967 |
|
idlwave-path-file |
1968 |
|
idlwave-config-directory)) |
1969 |
|
(idlwave-read-paths) ; we may need these early |
1970 |
|
(setq idlwave-setup-done t))) |
1971 |
|
|
1972 |
;; |
;; |
1973 |
;; Done with start up and initialization code. |
;; Code Formatting ---------------------------------------------------- |
1974 |
;; The remaining routines are the code formatting functions. |
;; |
|
;; |
|
1975 |
|
|
1976 |
(defun idlwave-push-mark (&rest rest) |
(defun idlwave-push-mark (&rest rest) |
1977 |
"Push mark for compatibility with Emacs 18/19." |
"Push mark for compatibility with Emacs 18/19." |
2063 |
(defvar zmacs-regions) |
(defvar zmacs-regions) |
2064 |
(defvar mark-active) |
(defvar mark-active) |
2065 |
(defun idlwave-region-active-p () |
(defun idlwave-region-active-p () |
2066 |
"Is transien-mark-mode on and the region active? |
"Is transient-mark-mode on and the region active? |
2067 |
Works on both Emacs and XEmacs." |
Works on both Emacs and XEmacs." |
2068 |
(if (featurep 'xemacs) |
(if (featurep 'xemacs) |
2069 |
(and zmacs-regions (region-active-p)) |
(and zmacs-regions (region-active-p)) |
2100 |
Also checks if the correct end statement has been used." |
Also checks if the correct end statement has been used." |
2101 |
;; All end statements are reserved words |
;; All end statements are reserved words |
2102 |
;; Re-indent end line |
;; Re-indent end line |
2103 |
(insert-char ?\ 1) ;; So indent, etc. work well |
;;(insert-char ?\ 1) ;; So indent, etc. work well |
2104 |
(backward-char 1) |
;;(backward-char 1) |
2105 |
(let* ((pos (point-marker)) |
(let* ((pos (point-marker)) |
2106 |
(last-abbrev-marker (copy-marker last-abbrev-location)) |
(last-abbrev-marker (copy-marker last-abbrev-location)) |
2107 |
(eol-pos (save-excursion (end-of-line) (point))) |
(eol-pos (save-excursion (end-of-line) (point))) |
2108 |
begin-pos end-pos end end1 ) |
begin-pos end-pos end end1 ) |
2109 |
(if idlwave-reindent-end (idlwave-indent-line)) |
(if idlwave-reindent-end (idlwave-indent-line)) |
2110 |
|
(setq last-abbrev-location (marker-position last-abbrev-marker)) |
2111 |
(when (and (idlwave-check-abbrev 0 t) |
(when (and (idlwave-check-abbrev 0 t) |
2112 |
idlwave-show-block) |
idlwave-show-block) |
2113 |
(save-excursion |
(save-excursion |
2120 |
(if (> end-pos eol-pos) |
(if (> end-pos eol-pos) |
2121 |
(setq end-pos pos)) |
(setq end-pos pos)) |
2122 |
(goto-char end-pos) |
(goto-char end-pos) |
2123 |
(setq end (buffer-substring |
(setq end (buffer-substring |
2124 |
(progn |
(progn |
2125 |
(skip-chars-backward "a-zA-Z") |
(skip-chars-backward "a-zA-Z") |
2126 |
(point)) |
(point)) |
2142 |
(sit-for 1)) |
(sit-for 1)) |
2143 |
(t |
(t |
2144 |
(beep) |
(beep) |
2145 |
(message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" |
(message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" |
2146 |
end1 end) |
end1 end) |
2147 |
(sit-for 1))))))) |
(sit-for 1)))))))) |
2148 |
(delete-char 1)) |
;;(delete-char 1)) |
2149 |
|
|
2150 |
(defun idlwave-block-master () |
(defun idlwave-block-master () |
2151 |
(let ((case-fold-search t)) |
(let ((case-fold-search t)) |
2154 |
((looking-at "pro\\|case\\|switch\\|function\\>") |
((looking-at "pro\\|case\\|switch\\|function\\>") |
2155 |
(assoc (downcase (match-string 0)) idlwave-block-matches)) |
(assoc (downcase (match-string 0)) idlwave-block-matches)) |
2156 |
((looking-at "begin\\>") |
((looking-at "begin\\>") |
2157 |
(let ((limit (save-excursion |
(let ((limit (save-excursion |
2158 |
(idlwave-beginning-of-statement) |
(idlwave-beginning-of-statement) |
2159 |
(point)))) |
(point)))) |
2160 |
(cond |
(cond |
2161 |
|
((re-search-backward ":[ \t]*\\=" limit t) |
2162 |
|
;; seems to be a case thing |
2163 |
|
'("begin" . "end")) |
2164 |
((re-search-backward idlwave-block-match-regexp limit t) |
((re-search-backward idlwave-block-match-regexp limit t) |
2165 |
(assoc (downcase (match-string 1)) |
(assoc (downcase (match-string 1)) |
2166 |
idlwave-block-matches)) |
idlwave-block-matches)) |
|
;;((re-search-backward ":[ \t]*\\=" limit t) |
|
|
;; ;; seems to be a case thing |
|
|
;; '("begin" . "end")) |
|
2167 |
(t |
(t |
2168 |
;; Just a nromal block |
;; Just a normal block |
2169 |
'("begin" . "end"))))) |
'("begin" . "end"))))) |
2170 |
(t nil))))) |
(t nil))))) |
2171 |
|
|
2183 |
(insert "end") |
(insert "end") |
2184 |
(idlwave-show-begin))) |
(idlwave-show-begin))) |
2185 |
|
|
2186 |
(defun idlwave-gtr-pad-hook (char) |
(defun idlwave-gtr-pad-hook (char) |
2187 |
"Let the > symbol expand around -> if present. The new token length |
"Let the > symbol expand around -> if present. The new token length |
2188 |
is returned." |
is returned." |
2189 |
2) |
2) |
2190 |
|
|
2191 |
(defun idlwave-surround (&optional before after escape-chars length ec-hook) |
(defun idlwave-surround (&optional before after escape-chars length ec-hook) |
2215 |
(let* ((length (or length 1)) ; establish a default for LENGTH |
(let* ((length (or length 1)) ; establish a default for LENGTH |
2216 |
(prev-char (char-after (- (point) (1+ length))))) |
(prev-char (char-after (- (point) (1+ length))))) |
2217 |
(when (or (not (memq prev-char escape-chars)) |
(when (or (not (memq prev-char escape-chars)) |
2218 |
(and (fboundp ec-hook) |
(and (fboundp ec-hook) |
2219 |
(setq length |
(setq length |
2220 |
(save-excursion (funcall ec-hook prev-char))))) |
(save-excursion (funcall ec-hook prev-char))))) |
2221 |
(backward-char length) |
(backward-char length) |
2222 |
(save-restriction |
(save-restriction |
2438 |
(let ((eos (save-excursion |
(let ((eos (save-excursion |
2439 |
(idlwave-block-jump-out -1 'nomark) |
(idlwave-block-jump-out -1 'nomark) |
2440 |
(point)))) |
(point)))) |
2441 |
(if (setq status (idlwave-find-key |
(if (setq status (idlwave-find-key |
2442 |
idlwave-end-block-reg -1 'nomark eos)) |
idlwave-end-block-reg -1 'nomark eos)) |
2443 |
(idlwave-beginning-of-statement) |
(idlwave-beginning-of-statement) |
2444 |
(message "No nested block before beginning of containing block."))) |
(message "No nested block before beginning of containing block."))) |
2446 |
(let ((eos (save-excursion |
(let ((eos (save-excursion |
2447 |
(idlwave-block-jump-out 1 'nomark) |
(idlwave-block-jump-out 1 'nomark) |
2448 |
(point)))) |
(point)))) |
2449 |
(if (setq status (idlwave-find-key |
(if (setq status (idlwave-find-key |
2450 |
idlwave-begin-block-reg 1 'nomark eos)) |
idlwave-begin-block-reg 1 'nomark eos)) |
2451 |
(idlwave-end-of-statement) |
(idlwave-end-of-statement) |
2452 |
(message "No nested block before end of containing block.")))) |
(message "No nested block before end of containing block.")))) |
2460 |
(here (point))) |
(here (point))) |
2461 |
(goto-char (point-max)) |
(goto-char (point-max)) |
2462 |
(if (re-search-backward idlwave-doclib-start nil t) |
(if (re-search-backward idlwave-doclib-start nil t) |
2463 |
(progn |
(progn |
2464 |
(setq beg (progn (beginning-of-line) (point))) |
(setq beg (progn (beginning-of-line) (point))) |
2465 |
(if (re-search-forward idlwave-doclib-end nil t) |
(if (re-search-forward idlwave-doclib-end nil t) |
2466 |
(progn |
(progn |
2494 |
((eq major-mode 'idlwave-shell-mode) |
((eq major-mode 'idlwave-shell-mode) |
2495 |
(if (re-search-backward idlwave-shell-prompt-pattern nil t) |
(if (re-search-backward idlwave-shell-prompt-pattern nil t) |
2496 |
(goto-char (match-end 0)))) |
(goto-char (match-end 0)))) |
2497 |
(t |
(t |
2498 |
(if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) |
(if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) |
2499 |
(idlwave-previous-statement) |
(idlwave-previous-statement) |
2500 |
(beginning-of-line))))) |
(beginning-of-line))))) |
2571 |
(let ((save-point (point))) |
(let ((save-point (point))) |
2572 |
(when (re-search-forward ".*&" lim t) |
(when (re-search-forward ".*&" lim t) |
2573 |
(goto-char (match-end 0)) |
(goto-char (match-end 0)) |
2574 |
(if (idlwave-in-quote) (goto-char save-point))) |
(if (idlwave-quoted) (goto-char save-point))) |
2575 |
(point))) |
(point))) |
2576 |
|
|
2577 |
(defun idlwave-skip-label-or-case () |
(defun idlwave-skip-label-or-case () |
2586 |
;; - not in parenthesis (like a[0:3]) |
;; - not in parenthesis (like a[0:3]) |
2587 |
;; - not followed by another ":" in explicit class, ala a->b::c |
;; - not followed by another ":" in explicit class, ala a->b::c |
2588 |
;; As many in this mode, this function is heuristic and not an exact |
;; As many in this mode, this function is heuristic and not an exact |
2589 |
;; parser. |
;; parser. |
2590 |
(let* ((start (point)) |
(let* ((start (point)) |
2591 |
(eos (save-excursion (idlwave-end-of-statement) (point))) |
(eos (save-excursion (idlwave-end-of-statement) (point))) |
2592 |
(end (idlwave-find-key ":" 1 'nomark eos))) |
(end (idlwave-find-key ":" 1 'nomark eos))) |
2613 |
st nst last) |
st nst last) |
2614 |
(idlwave-beginning-of-statement) |
(idlwave-beginning-of-statement) |
2615 |
(idlwave-skip-label-or-case) |
(idlwave-skip-label-or-case) |
2616 |
(idlwave-skip-multi-commands orig) |
(if (< (point) orig) |
2617 |
|
(idlwave-skip-multi-commands orig)) |
2618 |
(setq last (point)) |
(setq last (point)) |
2619 |
;; Continue looking for substatements until we are past orig |
;; Continue looking for substatements until we are past orig |
2620 |
(while (and (<= (point) orig) (not (eobp))) |
(while (and (<= (point) orig) (not (eobp))) |
2656 |
(append st (match-end 0)))))) |
(append st (match-end 0)))))) |
2657 |
|
|
2658 |
(defun idlwave-expand-equal (&optional before after) |
(defun idlwave-expand-equal (&optional before after) |
2659 |
"Pad '=' with spaces. |
"Pad '=' with spaces. Two cases: Assignment statement, and keyword |
2660 |
Two cases: Assignment statement, and keyword assignment. |
assignment. Which case is determined using |
2661 |
The case is determined using `idlwave-start-of-substatement' and |
`idlwave-start-of-substatement' and `idlwave-statement-type'. The |
2662 |
`idlwave-statement-type'. |
equal sign will be surrounded by BEFORE and AFTER blanks. If |
2663 |
The equal sign will be surrounded by BEFORE and AFTER blanks. |
`idlwave-pad-keyword' is t then keyword assignment is treated just |
|
If `idlwave-pad-keyword' is t then keyword assignment is treated just |
|
2664 |
like assignment statements. When nil, spaces are removed for keyword |
like assignment statements. When nil, spaces are removed for keyword |
2665 |
assignment. Any other value keeps the current space around the `='. |
assignment. Any other value keeps the current space around the `='. |
2666 |
Limits in for loops are treated as keyword assignment. |
Limits in for loops are treated as keyword assignment. |
2667 |
See `idlwave-surround'. " |
|
2668 |
;; Even though idlwave-surround checks `idlwave-surround-by-blank' this |
Starting with IDL 6.0, a number of op= assignments are available. |
2669 |
;; check saves the time of finding the statement type. |
Since ambiguities of the form: |
2670 |
|
|
2671 |
|
r and= b |
2672 |
|
rand= b |
2673 |
|
|
2674 |
|
can occur, alphanumeric operator assignment will never be pre-padded, |
2675 |
|
only post-padded. You must use a space before these to disambiguate |
2676 |
|
\(not just for padding, but for proper parsing by IDL too!). Other |
2677 |
|
operators, such as ##=, ^=, etc., will be pre-padded. |
2678 |
|
|
2679 |
|
See `idlwave-surround'." |
2680 |
(if idlwave-surround-by-blank |
(if idlwave-surround-by-blank |
2681 |
(let ((st (save-excursion |
(let |
2682 |
(idlwave-start-of-substatement t) |
((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=") |
2683 |
(idlwave-statement-type)))) |
(an-ops |
2684 |
|
"\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=") |
2685 |
(cond ((or (and (equal (car (car st)) 'assign) |
(len 1)) |
2686 |
(equal (cdr st) (point))) |
|
2687 |
(eq t idlwave-pad-keyword)) |
(save-excursion |
2688 |
;; An assignment statement or keywor and we need padding |
(let ((case-fold-search t)) |
2689 |
(idlwave-surround before after)) |
(backward-char) |
2690 |
((null idlwave-pad-keyword) |
(if (or |
2691 |
;; Spaces should be removed at a keyword |
(re-search-backward non-an-ops nil t) |
2692 |
(idlwave-surround 0 0)) |
;; Why doesn't ##? work for both? |
2693 |
(t))))) |
(re-search-backward "\\(#\\)\\=" nil t)) |
2694 |
|
(setq len (1+ (length (match-string 1)))) |
2695 |
|
(when (re-search-backward an-ops nil t) |
2696 |
|
(setq begin nil) ; won't modify begin |
2697 |
|
(setq len (1+ (length (match-string 1)))))))) |
2698 |
|
|
2699 |
|
(if (eq t idlwave-pad-keyword) |
2700 |
|
;; Everything gets padded equally |
2701 |
|
(idlwave-surround before after nil len) |
2702 |
|
;; Treating keywords/for variables specially... |
2703 |
|
(let ((st (save-excursion ; To catch "for" variables |
2704 |
|
(idlwave-start-of-substatement t) |
2705 |
|
(idlwave-statement-type))) |
2706 |
|
(what (save-excursion ; To catch keywords |
2707 |
|
(skip-chars-backward "= \t") |
2708 |
|
(nth 2 (idlwave-where))))) |
2709 |
|
(cond ((or (memq what '(function-keyword procedure-keyword)) |
2710 |
|
(memq (caar st) '(for pdef))) |
2711 |
|
(cond |
2712 |
|
((null idlwave-pad-keyword) |
2713 |
|
(idlwave-surround 0 0) |
2714 |
|
) ; remove space |
2715 |
|
(t))) ; leave any spaces alone |
2716 |
|
(t (idlwave-surround before after nil len)))))))) |
2717 |
|
|
2718 |
|
|
2719 |
(defun idlwave-indent-and-action (&optional arg) |
(defun idlwave-indent-and-action (&optional arg) |
2720 |
"Call `idlwave-indent-line' and do expand actions. |
"Call `idlwave-indent-line' and do expand actions. |
2721 |
With prefix ARG non-nil, indent the entire sub-statement." |
With prefix ARG non-nil, indent the entire sub-statement." |
2722 |
(interactive "p") |
(interactive "p") |
2723 |
(save-excursion |
(save-excursion |
2724 |
(if (and idlwave-expand-generic-end |
(if (and idlwave-expand-generic-end |
2725 |
(re-search-backward "\\<\\(end\\)\\s-*\\=" |
(re-search-backward "\\<\\(end\\)\\s-*\\=" |
2726 |
(max 0 (- (point) 10)) t) |
(max 0 (- (point) 10)) t) |
2727 |
(looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)")) |
(looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)")) |
2728 |
(progn (goto-char (match-end 1)) |
(progn (goto-char (match-end 1)) |
2729 |
;;Expand the END abbreviation, just as RET or Space would have. |
;;Expand the END abbreviation, just as RET or Space would have. |
2730 |
(if abbrev-mode (expand-abbrev) |
(if abbrev-mode (expand-abbrev) |
2731 |
(idlwave-show-begin))))) |
(idlwave-show-begin))))) |
2732 |
(if arg |
(when (and (not arg) current-prefix-arg) |
2733 |
|
(setq arg current-prefix-arg) |
2734 |
|
(setq current-prefix-arg nil)) |
2735 |
|
(if arg |
2736 |
(idlwave-indent-statement) |
(idlwave-indent-statement) |
2737 |
(idlwave-indent-line t))) |
(idlwave-indent-line t))) |
2738 |
|
|
2859 |
(idlwave-is-continuation-line))) |
(idlwave-is-continuation-line))) |
2860 |
(idlwave-calculate-cont-indent)) |
(idlwave-calculate-cont-indent)) |
2861 |
;; calculate indent based on previous and current statements |
;; calculate indent based on previous and current statements |
2862 |
(t (let ((the-indent |
(t (let* (beg-prev-pos |
2863 |
;; calculate indent based on previous statement |
(the-indent |
2864 |
(save-excursion |
;; calculate indent based on previous statement |
2865 |
(cond |
(save-excursion |
2866 |
((idlwave-previous-statement) |
(cond |
2867 |
0) |
;; Beginning of file |
2868 |
;; Main block |
((prog1 |
2869 |
((idlwave-look-at idlwave-begin-unit-reg t) |
(idlwave-previous-statement) |
2870 |
(+ (idlwave-current-statement-indent) |
(setq beg-prev-pos (point))) |
2871 |
idlwave-main-block-indent)) |
0) |
2872 |
;; Begin block |
;; Main block |
2873 |
((idlwave-look-at idlwave-begin-block-reg t) |
((idlwave-look-at idlwave-begin-unit-reg t) |
2874 |
(+ (idlwave-current-statement-indent) |
(+ (idlwave-current-statement-indent) |
2875 |
idlwave-block-indent)) |
idlwave-main-block-indent)) |
2876 |
((idlwave-look-at idlwave-end-block-reg t) |
;; Begin block |
2877 |
(- (idlwave-current-statement-indent) |
((idlwave-look-at idlwave-begin-block-reg t) |
2878 |
idlwave-end-offset |
(+ (idlwave-min-current-statement-indent) |
2879 |
idlwave-block-indent)) |
idlwave-block-indent)) |
2880 |
((idlwave-current-statement-indent)))))) |
;; End Block |
2881 |
|
((idlwave-look-at idlwave-end-block-reg t) |
2882 |
|
(progn |
2883 |
|
;; Match to the *beginning* of the block opener |
2884 |
|
(goto-char beg-prev-pos) |
2885 |
|
(idlwave-block-jump-out -1 'nomark) ; go to begin block |
2886 |
|
(idlwave-min-current-statement-indent))) |
2887 |
|
;; idlwave-end-offset |
2888 |
|
;; idlwave-block-indent)) |
2889 |
|
|
2890 |
|
;; Default to current indent |
2891 |
|
((idlwave-current-statement-indent)))))) |
2892 |
;; adjust the indentation based on the current statement |
;; adjust the indentation based on the current statement |
2893 |
(cond |
(cond |
2894 |
;; End block |
;; End block |
2897 |
(the-indent))))))) |
(the-indent))))))) |
2898 |
|
|
2899 |
;; |
;; |
2900 |
;; Parentheses balacing/indent |
;; Parentheses indent |
2901 |
;; |
;; |
2902 |
|
|
2903 |
(defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) |
(defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) |
2904 |
"Calculate the continuation indent inside a paren group. |
"Calculate the continuation indent inside a paren group. |
2905 |
Returns a cons-cell with (open . indent), where open is the |
Returns a cons-cell with (open . indent), where open is the |
2906 |
location of the open paren" |
location of the open paren" |
2907 |
(let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) |
(let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) |
2908 |
;; Found an innermost open paren. |
;; Found an innermost open paren. |
2911 |
;; Line up with next word unless this is a closing paren. |
;; Line up with next word unless this is a closing paren. |
2912 |
(cons open |
(cons open |
2913 |
(cond |
(cond |
2914 |
|
;; Plain Kernighan-style nested indent |
2915 |
|
(idlwave-indent-parens-nested |
2916 |
|
(+ idlwave-continuation-indent (idlwave-current-indent))) |
2917 |
|
|
2918 |
;; This is a closed paren - line up under open paren. |
;; This is a closed paren - line up under open paren. |
2919 |
(close-exp |
(close-exp |
2920 |
(current-column)) |
(current-column)) |
2921 |
;; Empty (or just comment) - just line up next to paren |
|
2922 |
|
;; Empty (or just comment) follows -- revert to basic indent |
2923 |
((progn |
((progn |
2924 |
;; Skip paren |
;; Skip paren |
2925 |
(forward-char 1) |
(forward-char 1) |
2926 |
(looking-at "[ \t$]*\\(;.*\\)?$")) |
(looking-at "[ \t$]*\\(;.*\\)?$")) |
2927 |
(current-column)) |
nil) |
2928 |
;; Line up with first word after blank space |
|
2929 |
|
;; Line up with first word after any blank space |
2930 |
((progn |
((progn |
2931 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
2932 |
(current-column)))))))) |
(current-column)))))))) |
2933 |
|
|
2934 |
(defun idlwave-calculate-cont-indent () |
(defun idlwave-calculate-cont-indent () |
2935 |
"Calculates the IDL continuation indent column from the previous statement. |
"Calculates the IDL continuation indent column from the previous |
2936 |
Note that here previous statement means the beginning of the current |
statement. Note that here previous statement usually means the |
2937 |
statement if this statement is a continuation of the previous line." |
beginning of the current statement if this statement is a continuation |
2938 |
|
of the previous line. Various special types of continuations, |
2939 |
|
including assignments, routine definitions, and parenthetical |
2940 |
|
groupings, are treated separately." |
2941 |
(save-excursion |
(save-excursion |
2942 |
(let* (open |
(let* ((case-fold-search t) |
|
(case-fold-search t) |
|
2943 |
(end-reg (progn (beginning-of-line) (point))) |
(end-reg (progn (beginning-of-line) (point))) |
2944 |
(close-exp (progn (skip-chars-forward " \t") (looking-at "\\s)"))) |
(beg-last-statement (save-excursion (idlwave-previous-statement) |
2945 |
; (beg-reg (progn (idlwave-previous-statement) (point))) |
(point))) |
2946 |
(beg-reg (progn ;; Use substatement indent unless it's this line |
(beg-reg (progn (idlwave-start-of-substatement 'pre) |
2947 |
(idlwave-start-of-substatement 'pre) |
(if (eq (line-beginning-position) end-reg) |
2948 |
(if (eq (line-beginning-position) end-reg) |
(goto-char beg-last-statement) |
2949 |
(idlwave-previous-statement)) |
(point)))) |
2950 |
(point))) |
(basic-indent (+ (idlwave-min-current-statement-indent end-reg) |
2951 |
(cur-indent (idlwave-current-indent)) |
idlwave-continuation-indent)) |
2952 |
(else-cont (and (goto-char end-reg) (looking-at "[ \t]*else"))) |
fancy-nonparen-indent fancy-paren-indent) |
2953 |
(basic-indent ;; The basic, non-fancy indent |
(cond |
2954 |
(+ cur-indent idlwave-continuation-indent)) |
;; Align then with its matching if, etc. |
2955 |
(fancy-nonparen-indent ;; A smarter indent for routine/assignments |
((let ((matchers '(("\\<if\\>" . "[ \t]*then") |
2956 |
;; Try without parens first: |
("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else") |
2957 |
(progn |
("\\<\\(for\\|while\\)\\>" . "[ \t]*do") |
2958 |
(goto-char beg-reg) |
("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . |
2959 |
(while (idlwave-look-at "&")) ; skip over continued statements |
"[ \t]*until") |
2960 |
(cond |
("\\<case\\>" . "[ \t]*of"))) |
2961 |
;; A continued Procedure call or definition |
match cont-re) |
2962 |
((progn |
(goto-char end-reg) |
2963 |
(idlwave-look-at "^[ \t]*\\(pro\\|function\\)") ;skip over |
(and |
2964 |
(looking-at "[ \t]*\\([a-zA-Z0-9$_]+[ \t]*->[ \t]*\\)?[a-zA-Z][:a-zA-Z0-9$_]*[ \t]*\\(,\\)[ \t]*")) |
(setq cont-re |
2965 |
(goto-char (match-end 0)) |
(catch 'exit |
2966 |
;; Comment only, or blank line with "$"? Align with , |
(while (setq match (car matchers)) |
2967 |
(if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) |
(if (looking-at (cdr match)) |
2968 |
(goto-char (match-end 2))) |
(throw 'exit (car match))) |
2969 |
(current-column)) |
(setq matchers (cdr matchers))))) |
2970 |
|
(idlwave-find-key cont-re -1 'nomark beg-last-statement))) |
2971 |
;; Continued assignment (with =), |
(if (looking-at "end") ;; that one's special |
2972 |
((looking-at "[ \t]*[][().a-zA-Z0-9$_]+[ \t]*\\(=\\)[ \t]*") |
(- (idlwave-current-indent) |
2973 |
(goto-char (match-end 0)) |
(+ idlwave-block-indent idlwave-end-offset)) |
2974 |
;; Comment only? Align with = |
(idlwave-current-indent))) |
2975 |
(if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) |
|
2976 |
(progn |
;; Indent in from the previous line for continuing statements |
2977 |
(goto-char (match-end 1)) |
((let ((matchers '("\\<then\\>" |
2978 |
(if idlwave-surround-by-blank |
"\\<do\\>" |
2979 |
(1+ (current-column)) |
"\\<repeat\\>" |
2980 |
(current-column))) |
"\\<else\\>")) |
2981 |
(current-column)))))) |
match) |
2982 |
(fancy-nonparen-indent-allowed |
(catch 'exit |
2983 |
(and fancy-nonparen-indent |
(goto-char end-reg) |
2984 |
(< (- fancy-nonparen-indent basic-indent) |
(if (/= (forward-line -1) 0) |
2985 |
idlwave-max-extra-continuation-indent))) |
(throw 'exit nil)) |
2986 |
(fancy-paren-indent-cons ;; A smarter indent for paren groups |
(while (setq match (car matchers)) |
2987 |
;; Look for any enclosing parens |
(if (looking-at (concat ".*" match "[ \t]*\\$[ \t]*" |
2988 |
(idlwave-calculate-paren-indent beg-reg end-reg close-exp)) |
"\\(;.*\\)?$")) |
2989 |
(fancy-paren-open (car fancy-paren-indent-cons)) |
(throw 'exit t)) |
2990 |
(fancy-paren-indent (cdr fancy-paren-indent-cons)) |
(setq matchers (cdr matchers))))) |
2991 |
(fancy-paren-indent-allowed |
(+ idlwave-continuation-indent (idlwave-current-indent))) |
2992 |
(and fancy-paren-indent |
|
2993 |
(or idlwave-indent-to-open-paren ;; override |
;; Parenthetical indent, either traditional or Kernighan style |
2994 |
(< (- fancy-paren-indent basic-indent) |
((setq fancy-paren-indent |
2995 |
idlwave-max-extra-continuation-indent)))) |
(let* ((end-reg end-reg) |
2996 |
fancy-enclosing-paren-indent) |
(close-exp (progn |
2997 |
(cond |
(goto-char end-reg) |
2998 |
;; else continuations are always standard |
(skip-chars-forward " \t") |
2999 |
(else-cont |
(looking-at "\\s)"))) |
3000 |
cur-indent) |
indent-cons) |
3001 |
|
(catch 'loop |
3002 |
;; an allowed parenthesis-indent |
(while (setq indent-cons (idlwave-calculate-paren-indent |
3003 |
(fancy-paren-indent-allowed |
beg-reg end-reg close-exp)) |
3004 |
|
;; First permitted containing paren |
3005 |
|
(if (or |
3006 |
|
idlwave-indent-to-open-paren |
3007 |
|
idlwave-indent-parens-nested |
3008 |
|
(null (cdr indent-cons)) |
3009 |
|
(< (- (cdr indent-cons) basic-indent) |
3010 |
|
idlwave-max-extra-continuation-indent)) |
3011 |
|
(throw 'loop (cdr indent-cons))) |
3012 |
|
(setq end-reg (car indent-cons)))))) |
3013 |
fancy-paren-indent) |
fancy-paren-indent) |
3014 |
|
|
3015 |
;; a disallowed paren indent nested inside one or more other |
;; A continued assignment, or procedure call/definition |
3016 |
;; parens: indent relative to the first allowed enclosing paren |
((and |
3017 |
;; set, if any... if it's actually a greater indent, just use |
(> idlwave-max-extra-continuation-indent 0) |
3018 |
;; the fancy-paren-indent anyway. |
(setq fancy-nonparen-indent |
3019 |
((and fancy-paren-indent |
(progn |
3020 |
(not fancy-paren-indent-allowed) |
(goto-char beg-reg) |
3021 |
(setq fancy-enclosing-paren-indent |
(while (idlwave-look-at "&")) ; skip continued statements |
3022 |
(let ((enclose-open fancy-paren-open) |
(cond |
3023 |
enclose-indent-cons |
;; A continued Procedure call or definition |
3024 |
enclose-indent) |
((progn |
3025 |
(catch 'loop |
(idlwave-look-at "^[ \t]*\\(pro\\|function\\)") ;skip over |
3026 |
(while (setq enclose-indent-cons |
(looking-at "[ \t]*\\([a-zA-Z0-9.$_]+[ \t]*->[ \t]*\\)?[a-zA-Z][:a-zA-Z0-9$_]*[ \t]*\\(,\\)[ \t]*")) |
3027 |
(idlwave-calculate-paren-indent |
(goto-char (match-end 0)) |
3028 |
beg-reg (max (1- enclose-open) beg-reg) |
;; Comment only, or blank line with "$"? Basic indent. |
3029 |
nil) |
(if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) |
3030 |
enclose-open (car enclose-indent-cons) |
nil |
3031 |
enclose-indent (cdr enclose-indent-cons)) |
(current-column))) |
3032 |
(if (< (- enclose-indent basic-indent) |
|
3033 |
idlwave-max-extra-continuation-indent) |
;; Continued assignment (with =): |
3034 |
(throw 'loop enclose-indent))))))) |
((catch 'assign ; |
3035 |
(min fancy-paren-indent |
(while (looking-at "[^=\n\r]*\\(=\\)[ \t]*") |
3036 |
(+ fancy-enclosing-paren-indent idlwave-continuation-indent))) |
(goto-char (match-end 0)) |
3037 |
|
(if (null (idlwave-what-function beg-reg)) |
3038 |
;; a disallowed paren indent inside another type: indent relative |
(throw 'assign t)))) |
3039 |
((and fancy-paren-indent |
(unless (or |
3040 |
(not fancy-paren-indent-allowed) |
(idlwave-in-quote) |
3041 |
fancy-nonparen-indent-allowed ) |
(looking-at "[ \t$]*\\(;.*\\)?$") ; use basic |
3042 |
(+ fancy-nonparen-indent idlwave-continuation-indent)) |
(save-excursion |
3043 |
|
(goto-char beg-last-statement) |
3044 |
;; an allowed nonparen-only indent |
(eq (caar (idlwave-statement-type)) 'for))) |
3045 |
(fancy-nonparen-indent-allowed |
(current-column)))))) |
3046 |
fancy-nonparen-indent) |
(< (- fancy-nonparen-indent basic-indent) |
3047 |
|
idlwave-max-extra-continuation-indent)) |
3048 |
;; everything else |
(if fancy-paren-indent ;calculated but disallowed paren indent |
3049 |
(t |
(+ fancy-nonparen-indent idlwave-continuation-indent) |
3050 |
basic-indent))))) |
fancy-nonparen-indent)) |
3051 |
|
|
3052 |
|
;; Basic indent, by default |
3053 |
|
(t basic-indent))))) |
3054 |
|
|
3055 |
|
|
3056 |
|
|
3057 |
(defun idlwave-find-key (key-re &optional dir nomark limit) |
(defun idlwave-find-key (key-re &optional dir nomark limit) |
3058 |
"Move to next match of the regular expression KEY-RE. |
"Move to next match of the regular expression KEY-RE. |
3072 |
(catch 'exit |
(catch 'exit |
3073 |
(while (funcall search-func key-re limit t) |
(while (funcall search-func key-re limit t) |
3074 |
(if (not (idlwave-quoted)) |
(if (not (idlwave-quoted)) |
3075 |
(throw 'exit (setq found (match-beginning 0)))))))) |
(throw 'exit (setq found (match-beginning 0))) |
3076 |
|
(if (or (and (> dir 0) (eobp)) |
3077 |
|
(and (< dir 0) (bobp))) |
3078 |
|
(throw 'exit nil))))))) |
3079 |
(if found |
(if found |
3080 |
(progn |
(progn |
3081 |
(if (not nomark) (push-mark)) |
(if (not nomark) (push-mark)) |
3096 |
(let* ((here (point)) |
(let* ((here (point)) |
3097 |
(case-fold-search t) |
(case-fold-search t) |
3098 |
(limit (if (>= dir 0) (point-max) (point-min))) |
(limit (if (>= dir 0) (point-max) (point-min))) |
3099 |
(block-limit (if (>= dir 0) |
(block-limit (if (>= dir 0) |
3100 |
idlwave-begin-block-reg |
idlwave-begin-block-reg |
3101 |
idlwave-end-block-reg)) |
idlwave-end-block-reg)) |
3102 |
found |
found |
3107 |
(idlwave-find-key |
(idlwave-find-key |
3108 |
idlwave-begin-unit-reg dir t limit) |
idlwave-begin-unit-reg dir t limit) |
3109 |
(end-of-line) |
(end-of-line) |
3110 |
(idlwave-find-key |
(idlwave-find-key |
3111 |
idlwave-end-unit-reg dir t limit))) |
idlwave-end-unit-reg dir t limit))) |
3112 |
limit))) |
limit))) |
3113 |
(if (>= dir 0) (end-of-line)) ;Make sure we are in current block |
(if (>= dir 0) (end-of-line)) ;Make sure we are in current block |
3120 |
(if (not found) (goto-char unit-limit) |
(if (not found) (goto-char unit-limit) |
3121 |
(if (>= dir 0) (forward-word 1))))) |
(if (>= dir 0) (forward-word 1))))) |
3122 |
|
|
3123 |
(defun idlwave-current-statement-indent () |
(defun idlwave-min-current-statement-indent (&optional end-reg) |
3124 |
|
"The minimum indent in the current statement." |
3125 |
|
(idlwave-beginning-of-statement) |
3126 |
|
(if (not (idlwave-is-continuation-line)) |
3127 |
|
(idlwave-current-indent) |
3128 |
|
(let ((min (idlwave-current-indent)) comm-or-empty) |
3129 |
|
(while (and (= (forward-line 1) 0) |
3130 |
|
(or (setq comm-or-empty (idlwave-is-comment-or-empty-line)) |
3131 |
|
(idlwave-is-continuation-line)) |
3132 |
|
(or (null end-reg) (< (point) end-reg))) |
3133 |
|
(unless comm-or-empty (setq min (min min (idlwave-current-indent))))) |
3134 |
|
(if (or comm-or-empty (and end-reg (>= (point) end-reg))) |
3135 |
|
min |
3136 |
|
(min min (idlwave-current-indent)))))) |
3137 |
|
|
3138 |
|
(defun idlwave-current-statement-indent (&optional last-line) |
3139 |
"Return indentation of the current statement. |
"Return indentation of the current statement. |
3140 |
If in a statement, moves to beginning of statement before finding indent." |
If in a statement, moves to beginning of statement before finding indent." |
3141 |
(idlwave-beginning-of-statement) |
(if last-line |
3142 |
|
(idlwave-end-of-statement) |
3143 |
|
(idlwave-beginning-of-statement)) |
3144 |
(idlwave-current-indent)) |
(idlwave-current-indent)) |
3145 |
|
|
3146 |
(defun idlwave-current-indent () |
(defun idlwave-current-indent () |
3158 |
Blank or comment-only lines following regular continuation lines (with |
Blank or comment-only lines following regular continuation lines (with |
3159 |
`$') count as continuations too." |
`$') count as continuations too." |
3160 |
(save-excursion |
(save-excursion |
3161 |
(or |
(or |
3162 |
(idlwave-look-at "\\<\\$") |
(idlwave-look-at "\\<\\$") |
3163 |
(catch 'loop |
(catch 'loop |
3164 |
(while (and (looking-at "^[ \t]*\\(;.*\\)?$") |
(while (and (looking-at "^[ \t]*\\(;.*\\)?$") |
3165 |
(eq (forward-line -1) 0)) |
(eq (forward-line -1) 0)) |
3166 |
(if (idlwave-look-at "\\<\\$") (throw 'loop t))))))) |
(if (idlwave-look-at "\\<\\$") (throw 'loop t))))))) |
3167 |
|
|
3259 |
(beginning-of-line) (point)) |
(beginning-of-line) (point)) |
3260 |
(point)))) |
(point)))) |
3261 |
"[^;]")) |
"[^;]")) |
3262 |
|
|
3263 |
;; Mark the beginning and end of the paragraph |
;; Mark the beginning and end of the paragraph |
3264 |
(goto-char bcl) |
(goto-char bcl) |
3265 |
(while (and (looking-at fill-prefix-reg) |
(while (and (looking-at fill-prefix-reg) |
3323 |
(insert (make-string diff ?\ )))) |
(insert (make-string diff ?\ )))) |
3324 |
(forward-line -1)) |
(forward-line -1)) |
3325 |
) |
) |
3326 |
|
|
3327 |
;; No hang. Instead find minimum indentation of paragraph |
;; No hang. Instead find minimum indentation of paragraph |
3328 |
;; after first line. |
;; after first line. |
3329 |
;; For the following while statement, since START is at the |
;; For the following while statement, since START is at the |
3355 |
t) |
t) |
3356 |
(current-column)) |
(current-column)) |
3357 |
indent)) |
indent)) |
3358 |
|
|
3359 |
;; try to keep point at its original place |
;; try to keep point at its original place |
3360 |
(goto-char here) |
(goto-char here) |
3361 |
|
|
3404 |
(current-column))))) |
(current-column))))) |
3405 |
|
|
3406 |
(defun idlwave-auto-fill () |
(defun idlwave-auto-fill () |
3407 |
"Called to break lines in auto fill mode. |
"Called to break lines in auto fill mode. |
3408 |
Only fills comment lines if `idlwave-fill-comment-line-only' is non-nil. |
Only fills non-comment lines if `idlwave-fill-comment-line-only' is |
3409 |
Places a continuation character at the end of the line |
non-nil. Places a continuation character at the end of the line if |
3410 |
if not in a comment. Splits strings with IDL concatenation operator |
not in a comment. Splits strings with IDL concatenation operator `+' |
3411 |
`+' if `idlwave-auto-fill-split-string is non-nil." |
if `idlwave-auto-fill-split-string' is non-nil." |
3412 |
(if (<= (current-column) fill-column) |
(if (<= (current-column) fill-column) |
3413 |
nil ; do not to fill |
nil ; do not to fill |
3414 |
(if (or (not idlwave-fill-comment-line-only) |
(if (or (not idlwave-fill-comment-line-only) |
3421 |
;; Prevent actions do-auto-fill which calls indent-line-function. |
;; Prevent actions do-auto-fill which calls indent-line-function. |
3422 |
(let (idlwave-do-actions |
(let (idlwave-do-actions |
3423 |
(paragraph-start ".") |
(paragraph-start ".") |
3424 |
(paragraph-separate ".")) |
(paragraph-separate ".") |
3425 |
|
(fill-nobreak-predicate |
3426 |
|
(if (and (idlwave-in-quote) |
3427 |
|
idlwave-auto-fill-split-string) |
3428 |
|
(lambda () ;; We'll need 5 spaces for " ' + $" |
3429 |
|
(<= (- fill-column (current-column)) 5) |
3430 |
|
)))) |
3431 |
(do-auto-fill)) |
(do-auto-fill)) |
3432 |
(save-excursion |
(save-excursion |
3433 |
(end-of-line 0) |
(end-of-line 0) |
3462 |
(if (save-excursion |
(if (save-excursion |
3463 |
(end-of-line 0) |
(end-of-line 0) |
3464 |
(idlwave-in-comment)) |
(idlwave-in-comment)) |
3465 |
;; Splitting a non-line comment. |
;; Splitting a non-full-line comment. |
3466 |
;; Insert the comment delimiter from split line |
;; Insert the comment delimiter from split line |
3467 |
(progn |
(progn |
3468 |
(save-excursion |
(save-excursion |
3519 |
;; update mode-line |
;; update mode-line |
3520 |
(set-buffer-modified-p (buffer-modified-p)))) |
(set-buffer-modified-p (buffer-modified-p)))) |
3521 |
|
|
3522 |
|
;(defun idlwave-fill-routine-call () |
3523 |
|
; "Fill a routine definition or statement, indenting appropriately." |
3524 |
|
; (let ((where (idlwave-where))))) |
3525 |
|
|
3526 |
|
|
3527 |
(defun idlwave-doc-header (&optional nomark ) |
(defun idlwave-doc-header (&optional nomark ) |
3528 |
"Insert a documentation header at the beginning of the unit. |
"Insert a documentation header at the beginning of the unit. |
3529 |
Inserts the value of the variable idlwave-file-header. Sets mark before |
Inserts the value of the variable idlwave-file-header. Sets mark before |
3555 |
(insert (current-time-string)) |
(insert (current-time-string)) |
3556 |
(insert ", " (user-full-name)) |
(insert ", " (user-full-name)) |
3557 |
(if (boundp 'user-mail-address) |
(if (boundp 'user-mail-address) |
3558 |
(insert " <" user-mail-address ">") |
(insert " <" user-mail-address ">") |
3559 |
(insert " <" (user-login-name) "@" (system-name) ">")) |
(insert " <" (user-login-name) "@" (system-name) ">")) |
3560 |
;; Remove extra spaces from line |
;; Remove extra spaces from line |
3561 |
(idlwave-fill-paragraph) |
(idlwave-fill-paragraph) |
3581 |
(setq end (match-end 0))) |
(setq end (match-end 0))) |
3582 |
(progn |
(progn |
3583 |
(goto-char beg) |
(goto-char beg) |
3584 |
(if (re-search-forward |
(if (re-search-forward |
3585 |
(concat idlwave-doc-modifications-keyword ":") |
(concat idlwave-doc-modifications-keyword ":") |
3586 |
end t) |
end t) |
3587 |
(end-of-line) |
(end-of-line) |
3641 |
(while (< endq start) |
(while (< endq start) |
3642 |
;; Find string start |
;; Find string start |
3643 |
;; Don't find an octal constant beginning with a double quote |
;; Don't find an octal constant beginning with a double quote |
3644 |
(if (re-search-forward "\"[^0-7]\\|'\\|\"$" eol 'lim) |
(if (re-search-forward "[\"']" eol 'lim) |
3645 |
;; Find the string end. |
;; Find the string end. |
3646 |
;; In IDL, two consecutive delimiters after the start of a |
;; In IDL, two consecutive delimiters after the start of a |
3647 |
;; string act as an |
;; string act as an |
3679 |
(not (idlwave-in-quote)) |
(not (idlwave-in-quote)) |
3680 |
(save-excursion |
(save-excursion |
3681 |
(forward-char) |
(forward-char) |
3682 |
(re-search-backward (concat "\\(" idlwave-idl-keywords |
(re-search-backward (concat "\\(" idlwave-idl-keywords |
3683 |
"\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t))))) |
"\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t))))) |
3684 |
|
|
3685 |
|
|
3725 |
(indent-region beg end nil)) |
(indent-region beg end nil)) |
3726 |
(if (stringp prompt) |
(if (stringp prompt) |
3727 |
(message prompt))))) |
(message prompt))))) |
3728 |
|
|
3729 |
(defun idlwave-rw-case (string) |
(defun idlwave-rw-case (string) |
3730 |
"Make STRING have the case required by `idlwave-reserved-word-upcase'." |
"Make STRING have the case required by `idlwave-reserved-word-upcase'." |
3731 |
(if idlwave-reserved-word-upcase |
(if idlwave-reserved-word-upcase |
3743 |
(defun idlwave-case () |
(defun idlwave-case () |
3744 |
"Build skeleton IDL case statement." |
"Build skeleton IDL case statement." |
3745 |
(interactive) |
(interactive) |
3746 |
(idlwave-template |
(idlwave-template |
3747 |
(idlwave-rw-case "case") |
(idlwave-rw-case "case") |
3748 |
(idlwave-rw-case " of\n\nendcase") |
(idlwave-rw-case " of\n\nendcase") |
3749 |
"Selector expression")) |
"Selector expression")) |
3751 |
(defun idlwave-switch () |
(defun idlwave-switch () |
3752 |
"Build skeleton IDL switch statement." |
"Build skeleton IDL switch statement." |
3753 |
(interactive) |
(interactive) |
3754 |
(idlwave-template |
(idlwave-template |
3755 |
(idlwave-rw-case "switch") |
(idlwave-rw-case "switch") |
3756 |
(idlwave-rw-case " of\n\nendswitch") |
(idlwave-rw-case " of\n\nendswitch") |
3757 |
"Selector expression")) |
"Selector expression")) |
3759 |
(defun idlwave-for () |
(defun idlwave-for () |
3760 |
"Build skeleton for loop statment." |
"Build skeleton for loop statment." |
3761 |
(interactive) |
(interactive) |
3762 |
(idlwave-template |
(idlwave-template |
3763 |
(idlwave-rw-case "for") |
(idlwave-rw-case "for") |
3764 |
(idlwave-rw-case " do begin\n\nendfor") |
(idlwave-rw-case " do begin\n\nendfor") |
3765 |
"Loop expression")) |
"Loop expression")) |
3774 |
|
|
3775 |
(defun idlwave-procedure () |
(defun idlwave-procedure () |
3776 |
(interactive) |
(interactive) |
3777 |
(idlwave-template |
(idlwave-template |
3778 |
(idlwave-rw-case "pro") |
(idlwave-rw-case "pro") |
3779 |
(idlwave-rw-case "\n\nreturn\nend") |
(idlwave-rw-case "\n\nreturn\nend") |
3780 |
"Procedure name")) |
"Procedure name")) |
3781 |
|
|
3782 |
(defun idlwave-function () |
(defun idlwave-function () |
3783 |
(interactive) |
(interactive) |
3784 |
(idlwave-template |
(idlwave-template |
3785 |
(idlwave-rw-case "function") |
(idlwave-rw-case "function") |
3786 |
(idlwave-rw-case "\n\nreturn\nend") |
(idlwave-rw-case "\n\nreturn\nend") |
3787 |
"Function name")) |
"Function name")) |
3795 |
|
|
3796 |
(defun idlwave-while () |
(defun idlwave-while () |
3797 |
(interactive) |
(interactive) |
3798 |
(idlwave-template |
(idlwave-template |
3799 |
(idlwave-rw-case "while") |
(idlwave-rw-case "while") |
3800 |
(idlwave-rw-case " do begin\n\nendwhile") |
(idlwave-rw-case " do begin\n\nendwhile") |
3801 |
"Entry condition")) |
"Entry condition")) |
3844 |
buf))) |
buf))) |
3845 |
|
|
3846 |
(defun idlwave-kill-autoloaded-buffers () |
(defun idlwave-kill-autoloaded-buffers () |
3847 |
"Cleanup by killing buffers created automatically by IDLWAVE. |
"Kill buffers created automatically by IDLWAVE. |
3848 |
Function prompts for a letter to identify the buffers to kill. |
Function prompts for a letter to identify the buffers to kill. |
3849 |
Possible letters are: |
Possible letters are: |
3850 |
|
|
3874 |
(defun idlwave-count-outlawed-buffers (tag) |
(defun idlwave-count-outlawed-buffers (tag) |
3875 |
"How many outlawed buffers have tag TAG?" |
"How many outlawed buffers have tag TAG?" |
3876 |
(length (delq nil |
(length (delq nil |
3877 |
(mapcar |
(mapcar |
3878 |
(lambda (x) (eq (cdr x) tag)) |
(lambda (x) (eq (cdr x) tag)) |
3879 |
idlwave-outlawed-buffers)))) |
idlwave-outlawed-buffers)))) |
3880 |
|
|
3881 |
(defun idlwave-do-kill-autoloaded-buffers (&rest reasons) |
(defun idlwave-do-kill-autoloaded-buffers (&rest reasons) |
3889 |
(memq (cdr entry) reasons)) |
(memq (cdr entry) reasons)) |
3890 |
(kill-buffer (car entry)) |
(kill-buffer (car entry)) |
3891 |
(incf cnt) |
(incf cnt) |
3892 |
(setq idlwave-outlawed-buffers |
(setq idlwave-outlawed-buffers |
3893 |
(delq entry idlwave-outlawed-buffers))) |
(delq entry idlwave-outlawed-buffers))) |
3894 |
(setq idlwave-outlawed-buffers |
(setq idlwave-outlawed-buffers |
3895 |
(delq entry idlwave-outlawed-buffers)))) |
(delq entry idlwave-outlawed-buffers)))) |
3896 |
(message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) |
(message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) |
3897 |
|
|
3903 |
(entry (assq buf idlwave-outlawed-buffers))) |
(entry (assq buf idlwave-outlawed-buffers))) |
3904 |
;; Revoke license |
;; Revoke license |
3905 |
(if entry |
(if entry |
3906 |
(setq idlwave-outlawed-buffers |
(setq idlwave-outlawed-buffers |
3907 |
(delq entry idlwave-outlawed-buffers))) |
(delq entry idlwave-outlawed-buffers))) |
3908 |
;; Remove this function from the hook. |
;; Remove this function from the hook. |
3909 |
(remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) |
(remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) |
3918 |
(if (file-regular-p |
(if (file-regular-p |
3919 |
(setq efile (expand-file-name file dir))) |
(setq efile (expand-file-name file dir))) |
3920 |
(throw 'exit efile)))))) |
(throw 'exit efile)))))) |
3921 |
|
|
3922 |
(defun idlwave-expand-lib-file-name (file) |
(defun idlwave-expand-lib-file-name (file) |
3923 |
;; Find FILE on the scanned lib path and return a buffer visiting it |
;; Find FILE on the scanned lib path and return a buffer visiting it |
3924 |
(cond |
;; This is for, e.g., finding source with no user catalog |
3925 |
|
(cond |
3926 |
((null file) nil) |
((null file) nil) |
|
((string-match "\\`\\({\\([0-9]+\\)}/\\)\\(.*\\)" file) |
|
|
(expand-file-name (match-string 3 file) |
|
|
(car (nth (1- (string-to-int (match-string 2 file))) |
|
|
idlwave-path-alist)))) |
|
3927 |
((file-name-absolute-p file) file) |
((file-name-absolute-p file) file) |
3928 |
(t (idlwave-locate-lib-file file)))) |
(t (idlwave-locate-lib-file file)))) |
3929 |
|
|
3937 |
(interactive) |
(interactive) |
3938 |
(let (directory directories cmd append status numdirs dir getsubdirs |
(let (directory directories cmd append status numdirs dir getsubdirs |
3939 |
buffer save_buffer files numfiles item errbuf) |
buffer save_buffer files numfiles item errbuf) |
3940 |
|
|
3941 |
;; |
;; |
3942 |
;; Read list of directories |
;; Read list of directories |
3943 |
(setq directory (read-string "Tag Directories: " ".")) |
(setq directory (read-string "Tag Directories: " ".")) |
3988 |
(progn |
(progn |
3989 |
(message (concat "Tagging " item "...")) |
(message (concat "Tagging " item "...")) |
3990 |
(setq errbuf (get-buffer-create "*idltags-error*")) |
(setq errbuf (get-buffer-create "*idltags-error*")) |
3991 |
(setq status |
(setq status (+ status |
3992 |
(+ status |
(if (eq 0 (call-process |
3993 |
(if (eq 0 (call-process "sh" nil errbuf nil "-c" |
"sh" nil errbuf nil "-c" |
3994 |
(concat cmd append item))) |
(concat cmd append item))) |
3995 |
0 |
0 |
3996 |
1))) |
1))) |
3997 |
;; |
;; |
3998 |
;; Append additional tags |
;; Append additional tags |
3999 |
(setq append " --append ") |
(setq append " --append ") |
4003 |
(setq numfiles (1+ numfiles)) |
(setq numfiles (1+ numfiles)) |
4004 |
(setq item (nth numfiles files)) |
(setq item (nth numfiles files)) |
4005 |
))) |
))) |
4006 |
|
|
4007 |
(setq numdirs (1+ numdirs)) |
(setq numdirs (1+ numdirs)) |
4008 |
(setq dir (nth numdirs directories))) |
(setq dir (nth numdirs directories))) |
4009 |
(progn |
(progn |
4010 |
(setq numdirs (1+ numdirs)) |
(setq numdirs (1+ numdirs)) |
4011 |
(setq dir (nth numdirs directories))))) |
(setq dir (nth numdirs directories))))) |
4012 |
|
|
4013 |
(setq errbuf (get-buffer-create "*idltags-error*")) |
(setq errbuf (get-buffer-create "*idltags-error*")) |
4014 |
(if (= status 0) |
(if (= status 0) |
4015 |
(kill-buffer errbuf)) |
(kill-buffer errbuf)) |
4032 |
;; skip blank lines |
;; skip blank lines |
4033 |
(skip-chars-forward " \t\n") |
(skip-chars-forward " \t\n") |
4034 |
(if (looking-at (concat "[ \t]*\\(" comment-start "+\\)")) |
(if (looking-at (concat "[ \t]*\\(" comment-start "+\\)")) |
4035 |
(comment-region beg end |
(if (fboundp 'uncomment-region) |
4036 |
(- (length (buffer-substring |
(uncomment-region beg end) |
4037 |
(match-beginning 1) |
(comment-region beg end |
4038 |
(match-end 1))))) |
(- (length (buffer-substring |
4039 |
(comment-region beg end))))) |
(match-beginning 1) |
4040 |
|
(match-end 1)))))) |
4041 |
|
(comment-region beg end))))) |
4042 |
|
|
4043 |
|
|
4044 |
;; ---------------------------------------------------------------------------- |
;; ---------------------------------------------------------------------------- |
4054 |
;; For the completion and routine info function, we want to normalize |
;; For the completion and routine info function, we want to normalize |
4055 |
;; the case of procedure names etc. We do this by "interning" these |
;; the case of procedure names etc. We do this by "interning" these |
4056 |
;; string is a hand-crafted way. Hashes are used to map the downcase |
;; string is a hand-crafted way. Hashes are used to map the downcase |
4057 |
;; version of the strings to the cased versions. Since these cased |
;; version of the strings to the cased versions. Most *-sint-* |
4058 |
;; versions are really lisp objects, we can use `eq' to search, which |
;; variables consist of *two* hashes, a buffer+shell, followed by a |
4059 |
;; is a large performance boost. |
;; system hash. The former is re-scanned, and the latter takes case |
4060 |
;; All new strings need to be "sinterned". We do this as early as |
;; precedence. |
4061 |
;; possible after getting these strings from completion or buffer |
;; |
4062 |
;; substrings. So most of the code can simply assume to deal with |
;; Since these cased versions are really lisp objects, we can use `eq' |
4063 |
;; "sinterned" strings. The only exception is that the functions |
;; to search, which is a large performance boost. All new strings |
4064 |
;; which scan whole buffers for routine information do not intern the |
;; need to be "sinterned". We do this as early as possible after |
4065 |
;; grabbed strings. This is only done afterwards. Therefore in these |
;; getting these strings from completion or buffer substrings. So |
4066 |
;; functions it is *not* safe to assume the strings can be compared |
;; most of the code can simply assume to deal with "sinterned" |
4067 |
;; with `eq' and be fed into the routine assq functions. |
;; strings. The only exception is that the functions which scan whole |
4068 |
|
;; buffers for routine information do not intern the grabbed strings. |
4069 |
|
;; This is only done afterwards. Therefore in these functions it is |
4070 |
|
;; *not* safe to assume the strings can be compared with `eq' and be |
4071 |
|
;; fed into the routine assq functions. |
4072 |
|
|
4073 |
;; Here we define the hashing functions. |
;; Here we define the hashing functions. |
4074 |
|
|
4077 |
(defvar idlwave-sint-keywords '(nil)) |
(defvar idlwave-sint-keywords '(nil)) |
4078 |
(defvar idlwave-sint-methods '(nil)) |
(defvar idlwave-sint-methods '(nil)) |
4079 |
(defvar idlwave-sint-classes '(nil)) |
(defvar idlwave-sint-classes '(nil)) |
4080 |
(defvar idlwave-sint-files '(nil)) |
(defvar idlwave-sint-dirs '(nil)) |
4081 |
|
(defvar idlwave-sint-libnames '(nil)) |
4082 |
|
|
4083 |
(defun idlwave-reset-sintern (&optional what) |
(defun idlwave-reset-sintern (&optional what) |
4084 |
"Reset all sintern hashes." |
"Reset all sintern hashes." |
4085 |
;; Make sure the hash functions are accessible. |
;; Make sure the hash functions are accessible. |
4086 |
(if (or (not (fboundp 'gethash)) |
(if (or (not (fboundp 'gethash)) |
4087 |
(not (fboundp 'puthash))) |
(not (fboundp 'puthash))) |
4088 |
(progn |
(progn |
4089 |
(require 'cl) |
(require 'cl) |
4090 |
(or (fboundp 'puthash) |
(or (fboundp 'puthash) |
4091 |
(defalias 'puthash 'cl-puthash)))) |
(defalias 'puthash 'cl-puthash)))) |
4104 |
;; Reset the system & library hash |
;; Reset the system & library hash |
4105 |
(loop for entry in entries |
(loop for entry in entries |
4106 |
for var = (car entry) for size = (nth 1 entry) |
for var = (car entry) for size = (nth 1 entry) |
4107 |
do (setcdr (symbol-value var) |
do (setcdr (symbol-value var) |
4108 |
(make-hash-table ':size size ':test 'equal))) |
(make-hash-table ':size size ':test 'equal))) |
4109 |
(setq idlwave-sint-files nil)) |
(setq idlwave-sint-dirs nil |
4110 |
|
idlwave-sint-libnames nil)) |
4111 |
|
|
4112 |
(when (or (eq what t) (eq what 'bufsh) |
(when (or (eq what t) (eq what 'bufsh) |
4113 |
(null (car idlwave-sint-routines))) |
(null (car idlwave-sint-routines))) |
4114 |
;; Reset the buffer & shell hash |
;; Reset the buffer & shell hash |
4115 |
(loop for entry in entries |
(loop for entry in entries |
4116 |
for var = (car entry) for size = (nth 1 entry) |
for var = (car entry) for size = (nth 1 entry) |
4117 |
do (setcar (symbol-value var) |
do (setcar (symbol-value var) |
4118 |
(make-hash-table ':size size ':test 'equal)))))) |
(make-hash-table ':size size ':test 'equal)))))) |
4119 |
|
|
4120 |
(defun idlwave-sintern-routine-or-method (name &optional class set) |
(defun idlwave-sintern-routine-or-method (name &optional class set) |
4157 |
(set (idlwave-sintern-set name 'class idlwave-sint-classes set)) |
(set (idlwave-sintern-set name 'class idlwave-sint-classes set)) |
4158 |
(name))) |
(name))) |
4159 |
|
|
4160 |
(defun idlwave-sintern-file (name &optional set) |
(defun idlwave-sintern-dir (dir &optional set) |
4161 |
(car (or (member name idlwave-sint-files) |
(car (or (member dir idlwave-sint-dirs) |
4162 |
(setq idlwave-sint-files (cons name idlwave-sint-files))))) |
(setq idlwave-sint-dirs (cons dir idlwave-sint-dirs))))) |
4163 |
|
(defun idlwave-sintern-libname (name &optional set) |
4164 |
|
(car (or (member name idlwave-sint-libnames) |
4165 |
|
(setq idlwave-sint-libnames (cons name idlwave-sint-libnames))))) |
4166 |
|
|
4167 |
(defun idlwave-sintern-set (name type tables set) |
(defun idlwave-sintern-set (name type tables set) |
4168 |
(let* ((func (or (cdr (assq type idlwave-completion-case)) |
(let* ((func (or (cdr (assq type idlwave-completion-case)) |
4172 |
(puthash (downcase name) iname table) |
(puthash (downcase name) iname table) |
4173 |
iname)) |
iname)) |
4174 |
|
|
4175 |
(defun idlwave-sintern-rinfo-list (list &optional set) |
(defun idlwave-sintern-keyword-list (kwd-list &optional set) |
4176 |
"Sintern all strings in the rinfo LIST. With optional parameter SET: |
"Sintern a set of keywords (file (key . link) (key2 . link2) ...)" |
4177 |
also set new patterns. Probably this will always have to be t." |
(mapcar (lambda(x) |
4178 |
(let (entry name type class kwds res source call olh new) |
(setcar x (idlwave-sintern-keyword (car x) set))) |
4179 |
|
(cdr kwd-list)) |
4180 |
|
kwd-list) |
4181 |
|
|
4182 |
|
(defun idlwave-sintern-rinfo-list (list &optional set default-dir) |
4183 |
|
"Sintern all strings in the rinfo LIST. With optional parameter |
4184 |
|
SET: also set new patterns. Probably this will always have to be t. |
4185 |
|
If DEFAULT-DIR is passed, it is used as the base of the directory" |
4186 |
|
(let (entry name type class kwds res source call new) |
4187 |
(while list |
(while list |
4188 |
(setq entry (car list) |
(setq entry (car list) |
4189 |
list (cdr list) |
list (cdr list) |
4192 |
class (nth 2 entry) |
class (nth 2 entry) |
4193 |
source (nth 3 entry) |
source (nth 3 entry) |
4194 |
call (nth 4 entry) |
call (nth 4 entry) |
4195 |
kwds (nth 5 entry) |
kwds (nthcdr 5 entry)) |
4196 |
olh (nth 6 entry)) |
|
4197 |
(setq kwds (mapcar (lambda (x) |
;; The class and name |
|
(list (idlwave-sintern-keyword (car x) set))) |
|
|
kwds)) |
|
4198 |
(if class |
(if class |
4199 |
(progn |
(progn |
4200 |
(if (symbolp class) (setq class (symbol-name class))) |
(if (symbolp class) (setq class (symbol-name class))) |
4201 |
(setq class (idlwave-sintern-class class set)) |
(setq class (idlwave-sintern-class class set)) |
4202 |
(setq name (idlwave-sintern-method name set))) |
(setq name (idlwave-sintern-method name set))) |
4203 |
(setq name (idlwave-sintern-routine name set))) |
(setq name (idlwave-sintern-routine name set))) |
4204 |
(if (stringp (cdr source)) |
|
4205 |
(setcdr source (idlwave-sintern-file (cdr source) t))) |
;; The source |
4206 |
(setq new (if olh |
(let ((source-type (car source)) |
4207 |
(list name type class source call kwds olh) |
(source-file (nth 1 source)) |
4208 |
(list name type class source call kwds))) |
(source-dir (if default-dir |
4209 |
(setq res (cons new res))) |
(file-name-as-directory default-dir) |
4210 |
|
(nth 2 source))) |
4211 |
|
(source-lib (nth 3 source))) |
4212 |
|
(if (stringp source-dir) |
4213 |
|
(setq source-dir (idlwave-sintern-dir source-dir set))) |
4214 |
|
(if (stringp source-lib) |
4215 |
|
(setq source-lib (idlwave-sintern-libname source-lib set))) |
4216 |
|
(setq source (list source-type source-file source-dir source-lib))) |
4217 |
|
|
4218 |
|
;; The keywords |
4219 |
|
(setq kwds (mapcar (lambda (x) |
4220 |
|
(idlwave-sintern-keyword-list x set)) |
4221 |
|
kwds)) |
4222 |
|
|
4223 |
|
;; Build a canonicalized list |
4224 |
|
(setq new (nconc (list name type class source call) kwds) |
4225 |
|
res (cons new res))) |
4226 |
(nreverse res))) |
(nreverse res))) |
4227 |
|
|
4228 |
;; Creating new sintern tables |
;; Creating new sintern tables |
4261 |
"Holds the routine-info obtained by asking the shell.") |
"Holds the routine-info obtained by asking the shell.") |
4262 |
(defvar idlwave-unresolved-routines nil |
(defvar idlwave-unresolved-routines nil |
4263 |
"Holds the unresolved routine-info obtained by asking the shell.") |
"Holds the unresolved routine-info obtained by asking the shell.") |
4264 |
(defvar idlwave-library-routines nil |
(defvar idlwave-user-catalog-routines nil |
4265 |
"Holds the procedure routine-info from the library scan.") |
"Holds the procedure routine-info from the user scan.") |
4266 |
|
(defvar idlwave-library-catalog-routines nil |
4267 |
|
"Holds the procedure routine-info from the library catalog files.") |
4268 |
(defvar idlwave-path-alist nil |
(defvar idlwave-path-alist nil |
4269 |
"Alist with !PATH directories and a flag if the dir has been scanned.") |
"Alist with !PATH directories and zero or more flags if the dir has |
4270 |
|
been scanned in a user catalog ('user) or discovered in a library |
4271 |
|
catalog \('lib).") |
4272 |
(defvar idlwave-true-path-alist nil |
(defvar idlwave-true-path-alist nil |
4273 |
"Like `idlwave-path-alist', but with true filenames.") |
"Like `idlwave-path-alist', but with true filenames.") |
4274 |
(defvar idlwave-routines nil |
(defvar idlwave-routines nil |
4275 |
"Holds the combinded procedure routine-info.") |
"Holds the combinded procedure/function/method routine-info.") |
4276 |
(defvar idlwave-class-alist nil |
(defvar idlwave-class-alist nil |
4277 |
"Holds the class names known to IDLWAVE.") |
"Holds the class names known to IDLWAVE.") |
4278 |
(defvar idlwave-class-history nil |
(defvar idlwave-class-history nil |
4343 |
(condition-case nil |
(condition-case nil |
4344 |
(kill-process idlwave-catalog-process) |
(kill-process idlwave-catalog-process) |
4345 |
(error nil)))) |
(error nil)))) |
4346 |
(if (or (not idlwave-libinfo-file) |
(if (or (not idlwave-user-catalog-file) |
4347 |
(not (stringp idlwave-libinfo-file)) |
(not (stringp idlwave-user-catalog-file)) |
4348 |
(not (file-regular-p idlwave-libinfo-file))) |
(not (file-regular-p idlwave-user-catalog-file))) |
4349 |
(error "No catalog has been produced yet")) |
(error "No catalog has been produced yet")) |
4350 |
(let* ((emacs (expand-file-name (invocation-name) (invocation-directory))) |
(let* ((emacs (expand-file-name (invocation-name) (invocation-directory))) |
4351 |
(args (list "-batch" |
(args (list "-batch" |
4352 |
"-l" (expand-file-name "~/.emacs") |
"-l" (expand-file-name "~/.emacs") |
4353 |
"-l" "idlwave" |
"-l" "idlwave" |
4354 |
"-f" "idlwave-rescan-catalog-directories")) |
"-f" "idlwave-rescan-catalog-directories")) |
4355 |
(process (apply 'start-process "idlcat" |
(process (apply 'start-process "idlcat" |
4356 |
nil emacs args))) |
nil emacs args))) |
4357 |
(setq idlwave-catalog-process process) |
(setq idlwave-catalog-process process) |
4358 |
(set-process-sentinel |
(set-process-sentinel |
4359 |
process |
process |
4360 |
(lambda (pro why) |
(lambda (pro why) |
4361 |
(when (string-match "finished" why) |
(when (string-match "finished" why) |
4367 |
(message "Background job started to update catalog file"))) |
(message "Background job started to update catalog file"))) |
4368 |
|
|
4369 |
|
|
4370 |
|
;; Format for all routine info user catalog, library catalogs, etc.: |
4371 |
|
;; |
4372 |
|
;; ("ROUTINE" type class |
4373 |
|
;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | |
4374 |
|
;; (buffer pro_file dir) | (compiled pro_file dir) |
4375 |
|
;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...))) |
4376 |
|
;; |
4377 |
|
;; DIR will be supplied dynamically while loading library catalogs, |
4378 |
|
;; and is sinterned to save space, as is LIBNAME. PRO_FILE can be a |
4379 |
|
;; complete filepath, in which case DIR is unnecessary. HELPFILE can |
4380 |
|
;; be nil, as can LINK1, etc., if no HTML help is available. |
4381 |
|
|
4382 |
|
|
4383 |
(defvar idlwave-load-rinfo-idle-timer) |
(defvar idlwave-load-rinfo-idle-timer) |
4384 |
(defun idlwave-update-routine-info (&optional arg dont-concentrate) |
(defun idlwave-update-routine-info (&optional arg no-concatenate) |
4385 |
"Update the internal routine-info lists. |
"Update the internal routine-info lists. |
4386 |
These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info]) |
These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info]) |
4387 |
and by `idlwave-complete' (\\[idlwave-complete]) to provide information |
and by `idlwave-complete' (\\[idlwave-complete]) to provide information |
4398 |
When an IDL shell is running, this command also queries the IDL program |
When an IDL shell is running, this command also queries the IDL program |
4399 |
for currently compiled routines. |
for currently compiled routines. |
4400 |
|
|
|
???Document what DONT-CONCENTRATE means??? |
|
|
|
|
4401 |
With prefix ARG, also reload the system and library lists. |
With prefix ARG, also reload the system and library lists. |
4402 |
With two prefix ARG's, also rescans the library tree. |
With two prefix ARG's, also rescans the chosen user catalog tree. |
4403 |
With three prefix args, dispatch asynchronous process to do the update." |
With three prefix args, dispatch asynchronous process to do the update. |
4404 |
|
|
4405 |
|
If NO-CONCATENATE is non-nil, don't pre-concatenate the routine info |
4406 |
|
lists, but instead wait for the shell query to complete and |
4407 |
|
asynchronously finish updating routine info. This is set |
4408 |
|
automatically when called interactively. When you need routine |
4409 |
|
information updated immediately, leave NO-CONCATENATE nil." |
4410 |
(interactive "P\np") |
(interactive "P\np") |
4411 |
;; Stop any idle processing |
;; Stop any idle processing |
4412 |
(if (or (and (fboundp 'itimerp) |
(if (or (and (fboundp 'itimerp) |
4419 |
;; Start a background process which updates the catalog. |
;; Start a background process which updates the catalog. |
4420 |
(idlwave-rescan-asynchronously)) |
(idlwave-rescan-asynchronously)) |
4421 |
((equal arg '(16)) |
((equal arg '(16)) |
4422 |
;; Update the catalog now, and wait for it. |
;; Update the user catalog now, and wait for them. |
4423 |
(idlwave-create-libinfo-file t)) |
(idlwave-create-user-catalog-file t)) |
4424 |
(t |
(t |
4425 |
(let* ((load (or arg |
(let* ((load (or arg |
4426 |
idlwave-buffer-case-takes-precedence |
idlwave-buffer-case-takes-precedence |
4428 |
;; The override-idle means, even if the idle timer has done some |
;; The override-idle means, even if the idle timer has done some |
4429 |
;; preparing work, load and renormalize everything anyway. |
;; preparing work, load and renormalize everything anyway. |
4430 |
(override-idle (or arg idlwave-buffer-case-takes-precedence))) |
(override-idle (or arg idlwave-buffer-case-takes-precedence))) |
4431 |
|
|
4432 |
(setq idlwave-buffer-routines nil |
(setq idlwave-buffer-routines nil |
4433 |
idlwave-compiled-routines nil |
idlwave-compiled-routines nil |
4434 |
idlwave-unresolved-routines nil) |
idlwave-unresolved-routines nil) |
4439 |
(idlwave-reset-sintern (cond (load t) |
(idlwave-reset-sintern (cond (load t) |
4440 |
((null idlwave-system-routines) t) |
((null idlwave-system-routines) t) |
4441 |
(t 'bufsh)))) |
(t 'bufsh)))) |
4442 |
|
|
4443 |
(if idlwave-buffer-case-takes-precedence |
(if idlwave-buffer-case-takes-precedence |
4444 |
;; We can safely scan the buffer stuff first |
;; We can safely scan the buffer stuff first |
4445 |
(progn |
(progn |
4454 |
(idlwave-shell-is-running))) |
(idlwave-shell-is-running))) |
4455 |
(ask-shell (and shell-is-running |
(ask-shell (and shell-is-running |
4456 |
idlwave-query-shell-for-routine-info))) |
idlwave-query-shell-for-routine-info))) |
4457 |
|
|
4458 |
|
;; Load the library catalogs again, first re-scanning the path |
4459 |
|
(when arg |
4460 |
|
(if shell-is-running |
4461 |
|
(idlwave-shell-send-command idlwave-shell-path-query |
4462 |
|
'(progn |
4463 |
|
(idlwave-shell-get-path-info) |
4464 |
|
(idlwave-scan-library-catalogs)) |
4465 |
|
'hide) |
4466 |
|
(idlwave-scan-library-catalogs))) |
4467 |
|
|
4468 |
(if (or (not ask-shell) |
(if (or (not ask-shell) |
4469 |
(not dont-concentrate)) |
(not no-concatenate)) |
4470 |
;; 1. If we are not going to ask the shell, we need to do the |
;; 1. If we are not going to ask the shell, we need to do the |
4471 |
;; concatenation now. |
;; concatenation now. |
4472 |
;; 2. When this function is called non-interactively, it means |
;; 2. When this function is called non-interactively, it |
4473 |
;; that someone needs routine info *now*. The shell update |
;; means that someone needs routine info *now*. The |
4474 |
;; causes the concatenation *delayed*, so not in time for |
;; shell update causes the concatenation to be |
4475 |
;; the current command. Therefore, we do a concatenation |
;; *delayed*, so not in time for the current command. |
4476 |
;; now, even though the shell might do it again. |
;; Therefore, we do a concatenation now, even though |
4477 |
(idlwave-concatenate-rinfo-lists nil t)) |
;; the shell might do it again. |
4478 |
|
(idlwave-concatenate-rinfo-lists nil 'run-hooks)) |
4479 |
|
|
4480 |
(when ask-shell |
(when ask-shell |
4481 |
;; Ask the shell about the routines it knows. |
;; Ask the shell about the routines it knows of. |
4482 |
(message "Querying the shell") |
(message "Querying the shell") |
4483 |
(idlwave-shell-update-routine-info nil t))))))) |
(idlwave-shell-update-routine-info nil t))))))) |
4484 |
|
|
4485 |
(defvar idlwave-load-rinfo-steps-done (make-vector 5 nil)) |
|
4486 |
|
(defvar idlwave-load-rinfo-steps-done (make-vector 6 nil)) |
4487 |
(defvar idlwave-load-rinfo-idle-timer nil) |
(defvar idlwave-load-rinfo-idle-timer nil) |
4488 |
(defun idlwave-start-load-rinfo-timer () |
(defun idlwave-start-load-rinfo-timer () |
4489 |
(if (or (and (fboundp 'itimerp) |
(if (or (and (fboundp 'itimerp) |
4491 |
(and (fboundp 'timerp) |
(and (fboundp 'timerp) |
4492 |
(timerp idlwave-load-rinfo-idle-timer))) |
(timerp idlwave-load-rinfo-idle-timer))) |
4493 |
(cancel-timer idlwave-load-rinfo-idle-timer)) |
(cancel-timer idlwave-load-rinfo-idle-timer)) |
4494 |
(setq idlwave-load-rinfo-steps-done (make-vector 5 nil)) |
(setq idlwave-load-rinfo-steps-done (make-vector 6 nil)) |
4495 |
(setq idlwave-load-rinfo-idle-timer nil) |
(setq idlwave-load-rinfo-idle-timer nil) |
4496 |
(if (and idlwave-init-rinfo-when-idle-after |
(if (and idlwave-init-rinfo-when-idle-after |
4497 |
(numberp idlwave-init-rinfo-when-idle-after) |
(numberp idlwave-init-rinfo-when-idle-after) |
4505 |
nil 'idlwave-load-rinfo-next-step))) |
nil 'idlwave-load-rinfo-next-step))) |
4506 |
(error nil)))) |
(error nil)))) |
4507 |
|
|
|
|
|
|
|
|
4508 |
(defun idlwave-load-rinfo-next-step () |
(defun idlwave-load-rinfo-next-step () |
4509 |
(let ((inhibit-quit t) |
(let ((inhibit-quit t) |
4510 |
(arr idlwave-load-rinfo-steps-done)) |
(arr idlwave-load-rinfo-steps-done)) |
4511 |
(if (catch 'exit |
(when (catch 'exit |
4512 |
(when (not (aref arr 0)) |
(when (not (aref arr 0)) |
4513 |
(message "Loading idlw-rinfo.el in idle time...") |
(message "Loading idlw-rinfo.el in idle time...") |
4514 |
(load "idlw-rinfo" 'noerror 'nomessage) |
(load "idlw-rinfo" 'noerror 'nomessage) |
4525 |
(aset arr 1 t) |
(aset arr 1 t) |
4526 |
(throw 'exit t)) |
(throw 'exit t)) |
4527 |
(when (not (aref arr 2)) |
(when (not (aref arr 2)) |
4528 |
(when (and (stringp idlwave-libinfo-file) |
(when (and (stringp idlwave-user-catalog-file) |
4529 |
(file-regular-p idlwave-libinfo-file)) |
(file-regular-p idlwave-user-catalog-file)) |
4530 |
|
(message "Loading user catalog in idle time...") |
4531 |
(condition-case nil |
(condition-case nil |
4532 |
|
(load-file idlwave-user-catalog-file) |
4533 |
|
(error (throw 'exit nil))) |
4534 |
|
;; Check for the old style catalog and warn |
4535 |
|
(if (and |
4536 |
|
(boundp 'idlwave-library-routines) |
4537 |
|
idlwave-library-routines) |
4538 |
(progn |
(progn |
4539 |
(message "Loading library catalog in idle time...") |
(setq idlwave-library-routines nil) |
4540 |
(load-file idlwave-libinfo-file) |
(ding) |
4541 |
(message "Loading library catalog in idle time...done") |
(message "Outdated user catalog: %s... recreate" |
4542 |
(aset arr 2 t) |
idlwave-user-catalog-file)) |
4543 |
(throw 'exit t)) |
(message "Loading user catalog in idle time...done")) |
4544 |
(error (throw 'exit nil))))) |
(aset arr 2 t) |
4545 |
|
(throw 'exit t))) |
4546 |
(when (not (aref arr 3)) |
(when (not (aref arr 3)) |
4547 |
(when idlwave-library-routines |
(when idlwave-user-catalog-routines |
4548 |
(message "Normalizing idlwave-library-routines in idle time...") |
(message "Normalizing user catalog routines in idle time...") |
4549 |
(setq idlwave-library-routines (idlwave-sintern-rinfo-list |
(setq idlwave-user-catalog-routines |
4550 |
idlwave-library-routines 'sys)) |
(idlwave-sintern-rinfo-list |
4551 |
(message "Normalizing idlwave-library-routines in idle time...done")) |
idlwave-user-catalog-routines 'sys)) |
4552 |
|
(message |
4553 |
|
"Normalizing user catalog routines in idle time...done")) |
4554 |
(aset arr 3 t) |
(aset arr 3 t) |
4555 |
(throw 'exit t)) |
(throw 'exit t)) |
4556 |
(when (not (aref arr 4)) |
(when (not (aref arr 4)) |
4557 |
|
(idlwave-scan-library-catalogs |
4558 |
|
"Loading and normalizing library catalogs in idle time...") |
4559 |
|
(aset arr 4 t) |
4560 |
|
(throw 'exit t)) |
4561 |
|
(when (not (aref arr 5)) |
4562 |
(message "Finishing initialization in idle time...") |
(message "Finishing initialization in idle time...") |
4563 |
(idlwave-routines) |
(idlwave-routines) |
4564 |
(message "Finishing initialization in idle time...done") |
(message "Finishing initialization in idle time...done") |
4565 |
(throw 'exit nil))) |
(throw 'exit nil))) |
4566 |
(progn |
;; restart the timer |
4567 |
;; restart the timer |
(if (sit-for 1) |
4568 |
(if (sit-for 1) |
(idlwave-load-rinfo-next-step) |
4569 |
(idlwave-load-rinfo-next-step) |
(setq idlwave-load-rinfo-idle-timer |
4570 |
(setq idlwave-load-rinfo-idle-timer |
(run-with-idle-timer |
4571 |
(run-with-idle-timer |
idlwave-init-rinfo-when-idle-after |
4572 |
idlwave-init-rinfo-when-idle-after |
nil 'idlwave-load-rinfo-next-step)))))) |
|
nil 'idlwave-load-rinfo-next-step))) |
|
|
)))) |
|
4573 |
|
|
4574 |
(defun idlwave-load-system-rinfo (&optional force) |
(defun idlwave-load-system-rinfo (&optional force) |
4575 |
;; Load and case-treat the system and lib info files. |
;; Load and case-treat the system and catalog files. |
4576 |
(when (or force (not (aref idlwave-load-rinfo-steps-done 0))) |
(when (or force (not (aref idlwave-load-rinfo-steps-done 0))) |
4577 |
(load "idlw-rinfo" 'noerror 'nomessage)) |
(load "idlw-rinfo" 'noerror 'nomessage)) |
4578 |
(when (or force (not (aref idlwave-load-rinfo-steps-done 1))) |
(when (or force (not (aref idlwave-load-rinfo-steps-done 1))) |
4583 |
(setq idlwave-routines (copy-sequence idlwave-system-routines)) |
(setq idlwave-routines (copy-sequence idlwave-system-routines)) |
4584 |
(setq idlwave-last-system-routine-info-cons-cell |
(setq idlwave-last-system-routine-info-cons-cell |
4585 |
(nthcdr (1- (length idlwave-routines)) idlwave-routines)) |
(nthcdr (1- (length idlwave-routines)) idlwave-routines)) |
4586 |
(when (and (stringp idlwave-libinfo-file) |
(when (and (stringp idlwave-user-catalog-file) |
4587 |
(file-regular-p idlwave-libinfo-file)) |
(file-regular-p idlwave-user-catalog-file)) |
4588 |
(condition-case nil |
(condition-case nil |
4589 |
(progn |
(when (or force (not (aref idlwave-load-rinfo-steps-done 2))) |
4590 |
(when (or force (not (aref idlwave-load-rinfo-steps-done 2))) |
(load-file idlwave-user-catalog-file)) |
4591 |
(load-file idlwave-libinfo-file)) |
(error nil)) |
4592 |
(setq idlwave-true-path-alist nil) |
(when (boundp 'idlwave-library-routines) |
4593 |
(when (or force (not (aref idlwave-load-rinfo-steps-done 3))) |
(setq idlwave-library-routines nil) |
4594 |
(message "Normalizing idlwave-library-routines...") |
(error "Outdated user catalog: %s... recreate" idlwave-user-catalog-file)) |
4595 |
(setq idlwave-library-routines (idlwave-sintern-rinfo-list |
(setq idlwave-true-path-alist nil) |
4596 |
idlwave-library-routines 'sys)) |
(when (or force (not (aref idlwave-load-rinfo-steps-done 3))) |
4597 |
(message "Normalizing idlwave-library-routines...done"))) |
(message "Normalizing user catalog routines...") |
4598 |
(error nil))) |
(setq idlwave-user-catalog-routines |
4599 |
|
(idlwave-sintern-rinfo-list |
4600 |
|
idlwave-user-catalog-routines 'sys)) |
4601 |
|
(message "Normalizing user catalog routines...done"))) |
4602 |
|
(when (or force (not (aref idlwave-load-rinfo-steps-done 4))) |
4603 |
|
(idlwave-scan-library-catalogs |
4604 |
|
"Loading and normalizing library catalogs...")) |
4605 |
(run-hooks 'idlwave-after-load-rinfo-hook)) |
(run-hooks 'idlwave-after-load-rinfo-hook)) |
4606 |
|
|
4607 |
|
|
4608 |
(defun idlwave-update-buffer-routine-info () |
(defun idlwave-update-buffer-routine-info () |
4609 |
(let (res) |
(let (res) |
4610 |
(cond |
(cond |
4611 |
((eq idlwave-scan-all-buffers-for-routine-info t) |
((eq idlwave-scan-all-buffers-for-routine-info t) |
4612 |
;; Scan all buffers, current buffer last |
;; Scan all buffers, current buffer last |
4613 |
(message "Scanning all buffers...") |
(message "Scanning all buffers...") |
4614 |
(setq res (idlwave-get-routine-info-from-buffers |
(setq res (idlwave-get-routine-info-from-buffers |
4615 |
(reverse (buffer-list))))) |
(reverse (buffer-list))))) |
4616 |
((null idlwave-scan-all-buffers-for-routine-info) |
((null idlwave-scan-all-buffers-for-routine-info) |
4617 |
;; Don't scan any buffers |
;; Don't scan any buffers |
4624 |
(setq res (idlwave-get-routine-info-from-buffers |
(setq res (idlwave-get-routine-info-from-buffers |
4625 |
(list (current-buffer)))))))) |
(list (current-buffer)))))))) |
4626 |
;; Put the result into the correct variable |
;; Put the result into the correct variable |
4627 |
(setq idlwave-buffer-routines |
(setq idlwave-buffer-routines |
4628 |
(idlwave-sintern-rinfo-list res t)))) |
(idlwave-sintern-rinfo-list res 'set)))) |
4629 |
|
|
4630 |
(defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook) |
(defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook) |
4631 |
"Put the different sources for routine information together." |
"Put the different sources for routine information together." |
4632 |
;; The sequence here is important because earlier definitions shadow |
;; The sequence here is important because earlier definitions shadow |
4633 |
;; later ones. We assume that if things in the buffers are newer |
;; later ones. We assume that if things in the buffers are newer |
4634 |
;; then in the shell of the system, it is meant to be different. |
;; then in the shell of the system, they are meant to be different. |
|
|
|
4635 |
(setcdr idlwave-last-system-routine-info-cons-cell |
(setcdr idlwave-last-system-routine-info-cons-cell |
4636 |
(append idlwave-buffer-routines |
(append idlwave-buffer-routines |
4637 |
idlwave-compiled-routines |
idlwave-compiled-routines |
4638 |
idlwave-library-routines)) |
idlwave-library-catalog-routines |
4639 |
|
idlwave-user-catalog-routines)) |
4640 |
(setq idlwave-class-alist nil) |
(setq idlwave-class-alist nil) |
4641 |
|
|
4642 |
;; Give a message with information about the number of routines we have. |
;; Give a message with information about the number of routines we have. |
4643 |
(unless quiet |
(unless quiet |
4644 |
(message |
(message |
4645 |
"Routine info updated: buffer(%d) compiled(%d) catalog(%d) system(%d)" |
"Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)" |
4646 |
(length idlwave-buffer-routines) |
(length idlwave-buffer-routines) |
4647 |
(length idlwave-compiled-routines) |
(length idlwave-compiled-routines) |
4648 |
(length idlwave-library-routines) |
(length idlwave-library-catalog-routines) |
4649 |
|
(length idlwave-user-catalog-routines) |
4650 |
(length idlwave-system-routines))) |
(length idlwave-system-routines))) |
4651 |
(if run-hook |
(if run-hook |
4652 |
(run-hooks 'idlwave-update-rinfo-hook))) |
(run-hooks 'idlwave-update-rinfo-hook))) |
4659 |
(when (and (setq class (nth 2 x)) |
(when (and (setq class (nth 2 x)) |
4660 |
(not (assq class idlwave-class-alist))) |
(not (assq class idlwave-class-alist))) |
4661 |
(push (list class) idlwave-class-alist))) |
(push (list class) idlwave-class-alist))) |
4662 |
idlwave-class-alist))) |
idlwave-class-alist))) |
4663 |
|
|
4664 |
;; Three functions for the hooks |
;; Three functions for the hooks |
4665 |
(defun idlwave-save-buffer-update () |
(defun idlwave-save-buffer-update () |
4670 |
(idlwave-update-current-buffer-info 'find-file)) |
(idlwave-update-current-buffer-info 'find-file)) |
4671 |
|
|
4672 |
(defun idlwave-update-current-buffer-info (why) |
(defun idlwave-update-current-buffer-info (why) |
4673 |
"Undate idlwave-routines for current buffer. Can run from after-save-hook." |
"Update idlwave-routines for current buffer. Can run from after-save-hook." |
4674 |
(when (and (eq major-mode 'idlwave-mode) |
(when (and (eq major-mode 'idlwave-mode) |
4675 |
(or (eq t idlwave-auto-routine-info-updates) |
(or (eq t idlwave-auto-routine-info-updates) |
4676 |
(memq why idlwave-auto-routine-info-updates)) |
(memq why idlwave-auto-routine-info-updates)) |
4692 |
|
|
4693 |
(defun idlwave-replace-buffer-routine-info (file new) |
(defun idlwave-replace-buffer-routine-info (file new) |
4694 |
"Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." |
"Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." |
4695 |
(let ((list idlwave-buffer-routines) |
(let ((list idlwave-buffer-routines) |
4696 |
found) |
found) |
4697 |
(while list |
(while list |
4698 |
;; The following test uses eq to make sure it works correctly |
;; The following test uses eq to make sure it works correctly |
4699 |
;; when two buffers visit the same file. Then the file names |
;; when two buffers visit the same file. Then the file names |
4700 |
;; will be equal, but not eq. |
;; will be equal, but not eq. |
4701 |
(if (eq (cdr (nth 3 (car list))) file) |
(if (eq (idlwave-routine-source-file (nth 3 (car list))) file) |
4702 |
(progn |
(progn |
4703 |
(setcar list nil) |
(setcar list nil) |
4704 |
(setq found t)) |
(setq found t)) |
4705 |
(if found |
(if found |
4706 |
;; End of that section reached. Jump. |
;; End of that section reached. Jump. |
4707 |
(setq list nil))) |
(setq list nil))) |
4708 |
(setq list (cdr list))) |
(setq list (cdr list))) |
4709 |
(setq idlwave-buffer-routines |
(setq idlwave-buffer-routines |
4735 |
(save-restriction |
(save-restriction |
4736 |
(widen) |
(widen) |
4737 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4738 |
(while (re-search-forward |
(while (re-search-forward |
4739 |
"^[ \t]*\\(pro\\|function\\)[ \t]" nil t) |
"^[ \t]*\\(pro\\|function\\)[ \t]" nil t) |
4740 |
(setq string (buffer-substring-no-properties |
(setq string (buffer-substring-no-properties |
4741 |
(match-beginning 0) |
(match-beginning 0) |
4742 |
(progn |
(progn |
4743 |
(idlwave-end-of-statement) |
(idlwave-end-of-statement) |
4744 |
(point)))) |
(point)))) |
4745 |
(setq entry (idlwave-parse-definition string)) |
(setq entry (idlwave-parse-definition string)) |
4777 |
(push (match-string 1 string) args))) |
(push (match-string 1 string) args))) |
4778 |
;; Normalize and sort. |
;; Normalize and sort. |
4779 |
(setq args (nreverse args)) |
(setq args (nreverse args)) |
4780 |
(setq keywords (sort keywords (lambda (a b) |
(setq keywords (sort keywords (lambda (a b) |
4781 |
(string< (downcase a) (downcase b))))) |
(string< (downcase a) (downcase b))))) |
4782 |
;; Make and return the entry |
;; Make and return the entry |
4783 |
;; We don't know which argument are optional, so this information |
;; We don't know which argument are optional, so this information |
4786 |
(if (equal type "pro") 'pro 'fun) |
(if (equal type "pro") 'pro 'fun) |
4787 |
class |
class |
4788 |
(cond ((not (boundp 'idlwave-scanning-lib)) |
(cond ((not (boundp 'idlwave-scanning-lib)) |
4789 |
(cons 'buffer (buffer-file-name))) |
(list 'buffer (buffer-file-name))) |
4790 |
; ((string= (downcase |
; ((string= (downcase |
4791 |
; (file-name-sans-extension |
; (file-name-sans-extension |
4792 |
; (file-name-nondirectory (buffer-file-name)))) |
; (file-name-nondirectory (buffer-file-name)))) |
4793 |
; (downcase name)) |
; (downcase name)) |
4794 |
; (list 'lib)) |
; (list 'lib)) |
4795 |
; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) |
; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) |
4796 |
(t (cons 'lib (concat idlwave-scanning-lib-dir |
(t (list 'user (file-name-nondirectory (buffer-file-name)) |
4797 |
(file-name-nondirectory (buffer-file-name)))))) |
idlwave-scanning-lib-dir "UserLib"))) |
4798 |
(concat |
(concat |
4799 |
(if (string= type "function") "Result = " "") |
(if (string= type "function") "Result = " "") |
4800 |
(if class "Obj ->[%s::]" "") |
(if class "Obj ->[%s::]" "") |
4801 |
"%s" |
"%s" |
4805 |
(mapconcat 'identity args ", ") |
(mapconcat 'identity args ", ") |
4806 |
(if (string= type "function") ")" "")))) |
(if (string= type "function") ")" "")))) |
4807 |
(if keywords |
(if keywords |
4808 |
(mapcar 'list keywords) |
(cons nil (mapcar 'list keywords)) ;No help file |
4809 |
nil)))) |
nil)))) |
4810 |
|
|
|
;;----- Scanning the library ------------------- |
|
4811 |
|
|
4812 |
(defvar idlwave-sys-dir nil |
;;----- Scanning the user catalog ------------------- |
|
"Internal variable.") |
|
4813 |
|
|
4814 |
(defun idlwave-sys-dir () |
(defun idlwave-sys-dir () |
4815 |
"Return the syslib directory, or a dummy that never matches." |
"Return the syslib directory, or a dummy that never matches." |
4816 |
(or idlwave-sys-dir |
(if (string= idlwave-system-directory "") |
4817 |
"@@@@@@@@")) |
"@@@@@@@@" |
4818 |
|
idlwave-system-directory)) |
4819 |
|
|
4820 |
|
|
4821 |
(defvar idlwave-shell-path-query) |
(defvar idlwave-shell-path-query) |
4822 |
(defun idlwave-create-libinfo-file (&optional arg) |
(defun idlwave-create-user-catalog-file (&optional arg) |
4823 |
"Scan all files on selected dirs of IDL search path for routine information. |
"Scan all files on selected dirs of IDL search path for routine information. |
4824 |
A widget checklist will allow you to choose the directories. |
|
4825 |
Write the result as a file `idlwave-libinfo-file'. When this file exists, |
A widget checklist will allow you to choose the directories. Write |
4826 |
will be automatically loaded to give routine information about library |
the result as a file `idlwave-user-catalog-file'. When this file |
4827 |
routines. |
exists, will be automatically loaded to give routine information about |
4828 |
With ARG, just rescan the same directories as last time - so no widget |
library routines. With ARG, just rescan the same directories as last |
4829 |
will pop up." |
time - so no widget will pop up." |
4830 |
(interactive "P") |
(interactive "P") |
4831 |
;; Make sure the file is loaded if it exists. |
;; Make sure the file is loaded if it exists. |
4832 |
(if (and (stringp idlwave-libinfo-file) |
(if (and (stringp idlwave-user-catalog-file) |
4833 |
(file-regular-p idlwave-libinfo-file)) |
(file-regular-p idlwave-user-catalog-file)) |
4834 |
(condition-case nil |
(condition-case nil |
4835 |
(load-file idlwave-libinfo-file) |
(load-file idlwave-user-catalog-file) |
4836 |
(error nil))) |
(error nil))) |
4837 |
;; Make sure the file name makes sense |
;; Make sure the file name makes sense |
4838 |
(unless (and (stringp idlwave-libinfo-file) |
(unless (and (stringp idlwave-user-catalog-file) |
4839 |
(> (length idlwave-libinfo-file) 0) |
(> (length idlwave-user-catalog-file) 0) |
4840 |
(file-accessible-directory-p |
(file-accessible-directory-p |
4841 |
(file-name-directory idlwave-libinfo-file)) |
(file-name-directory idlwave-user-catalog-file)) |
4842 |
(not (string= "" (file-name-nondirectory |
(not (string= "" (file-name-nondirectory |
4843 |
idlwave-libinfo-file)))) |
idlwave-user-catalog-file)))) |
4844 |
(error "`idlwave-libinfo-file' does not point to file in accessible directory")) |
(error "`idlwave-user-catalog-file' does not point to a file in an accessible directory")) |
4845 |
|
|
4846 |
(cond |
(cond |
|
((and arg idlwave-path-alist |
|
|
(consp (car idlwave-path-alist)) |
|
|
idlwave-sys-dir) |
|
4847 |
;; Rescan the known directories |
;; Rescan the known directories |
4848 |
(idlwave-scan-lib-files |
((and arg idlwave-path-alist |
4849 |
idlwave-sys-dir |
(consp (car idlwave-path-alist))) |
4850 |
idlwave-path-alist)) |
(idlwave-scan-user-lib-files idlwave-path-alist)) |
4851 |
|
|
4852 |
|
;; Expand the directories from library-path and run the widget |
4853 |
(idlwave-library-path |
(idlwave-library-path |
4854 |
;; Get the directories from that variable |
(idlwave-display-user-catalog-widget |
4855 |
(idlwave-display-libinfo-widget |
(if idlwave-true-path-alist |
4856 |
idlwave-system-directory |
;; Propagate any flags on the existing path-alist |
4857 |
(idlwave-expand-path idlwave-library-path) |
(mapcar (lambda (x) |
4858 |
(delq nil (mapcar (lambda (x) (if (consp x) (if (cdr x) (car x) nil) x)) |
(let ((path-entry (assoc (file-truename x) |
4859 |
idlwave-path-alist)))) |
idlwave-true-path-alist))) |
4860 |
|
(if path-entry |
4861 |
|
(cons x (cdr path-entry)) |
4862 |
|
(list x)))) |
4863 |
|
(idlwave-expand-path idlwave-library-path)) |
4864 |
|
(mapcar 'list (idlwave-expand-path idlwave-library-path))))) |
4865 |
|
|
4866 |
|
;; Ask the shell for the path and then run the widget |
4867 |
(t |
(t |
|
;; Ask the shell for the path and run the widget |
|
4868 |
(message "Asking the shell for IDL path...") |
(message "Asking the shell for IDL path...") |
4869 |
(require 'idlw-shell) |
(require 'idlw-shell) |
4870 |
(idlwave-shell-send-command idlwave-shell-path-query |
(idlwave-shell-send-command idlwave-shell-path-query |
4871 |
'(idlwave-libinfo-command-hook nil) |
'(idlwave-user-catalog-command-hook nil) |
4872 |
'hide)))) |
'hide)))) |
4873 |
|
|
4874 |
(defun idlwave-libinfo-command-hook (&optional arg) |
|
4875 |
;; Command hook used by `idlwave-create-libinfo-file'. |
;; Parse shell path information and select among it. |
4876 |
|
(defun idlwave-user-catalog-command-hook (&optional arg) |
4877 |
|
;; Command hook used by `idlwave-create-user-catalog-file'. |
4878 |
(if arg |
(if arg |
4879 |
;; Scan immediately |
;; Scan immediately |
4880 |
(idlwave-scan-lib-files |
(idlwave-scan-user-lib-files idlwave-path-alist) |
4881 |
idlwave-sys-dir |
;; Set the path and display the widget |
4882 |
idlwave-path-alist) |
(idlwave-shell-get-path-info 'no-write) ; set to something path-alist |
4883 |
;; Display the widget |
(idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load) |
4884 |
(let* ((rpl (idlwave-shell-path-filter)) |
(idlwave-display-user-catalog-widget idlwave-path-alist))) |
4885 |
(sysdir (car rpl)) |
|
4886 |
(dirs (cdr rpl))) |
(defconst idlwave-user-catalog-widget-help-string |
4887 |
(idlwave-display-libinfo-widget |
"This is the front-end to the creation of the IDLWAVE user catalog. |
4888 |
sysdir dirs |
Please select the directories on IDL's search path from which you |
4889 |
(delq nil (mapcar (lambda (x) (if (cdr x) (car x) nil)) |
would like to extract routine information, to be stored in the file: |
|
idlwave-path-alist)))))) |
|
|
|
|
|
(defconst idlwave-libinfo-widget-help-string |
|
|
"This is the front-end to the creation of IDLWAVE library catalog. |
|
|
Please select below the directories on IDL's search path from which you |
|
|
would like to extract routine information, which will be stored in the file |
|
4890 |
|
|
4891 |
%s |
%s |
4892 |
|
|
4893 |
If this is not the correct file, first set variable `idlwave-libinfo-file'. |
If this is not the correct file, first set variable |
4894 |
Then call this command again. |
`idlwave-user-catalog-file', and call this command again. |
4895 |
|
|
4896 |
For writing code, you need to include the directories which contain the |
N.B. Many libraries include pre-scanned catalog files |
4897 |
routines you use. If IDLWAVE should be able to analyse routine shadowing |
\(\".idlwave_catalog\"). These are marked with \"[LIB]\", and need |
4898 |
it is best to scan all directories. |
not be scanned. You can scan your own libraries off-line using the |
4899 |
|
perl script `idlwave_catalog'. |
4900 |
|
|
4901 |
After selecting the directories, choose [Scan & Save] to scan the library |
After selecting the directories, choose [Scan & Save] to scan the library |
4902 |
directories and save the routine info. |
directories and save the routine info. |
4904 |
|
|
4905 |
(defvar idlwave-widget) |
(defvar idlwave-widget) |
4906 |
(defvar widget-keymap) |
(defvar widget-keymap) |
4907 |
(defun idlwave-display-libinfo-widget (sysdir dirs selected-dirs) |
(defun idlwave-display-user-catalog-widget (dirs-list) |
4908 |
"Create the widget to select IDL search path directories for scanning." |
"Create the widget to select IDL search path directories for scanning." |
4909 |
(interactive) |
(interactive) |
4910 |
(require 'widget) |
(require 'widget) |
4911 |
(require 'wid-edit) |
(require 'wid-edit) |
4912 |
(unless dirs |
(unless dirs-list |
4913 |
(error "Don't know IDL's search path")) |
(error "Don't know IDL's search path")) |
4914 |
|
|
|
;; Allow only those directories to be selected which are in the path. |
|
|
(setq selected-dirs (delq nil (mapcar (lambda (x) |
|
|
(if (member x dirs) x nil)) |
|
|
selected-dirs))) |
|
4915 |
(kill-buffer (get-buffer-create "*IDLWAVE Widget*")) |
(kill-buffer (get-buffer-create "*IDLWAVE Widget*")) |
4916 |
(switch-to-buffer (get-buffer-create "*IDLWAVE Widget*")) |
(switch-to-buffer (get-buffer-create "*IDLWAVE Widget*")) |
4917 |
(kill-all-local-variables) |
(kill-all-local-variables) |
4918 |
(make-local-variable 'idlwave-widget) |
(make-local-variable 'idlwave-widget) |
4919 |
(widget-insert (format idlwave-libinfo-widget-help-string |
(widget-insert (format idlwave-user-catalog-widget-help-string |
4920 |
idlwave-libinfo-file)) |
idlwave-user-catalog-file)) |
4921 |
|
|
4922 |
(widget-create 'push-button |
(widget-create 'push-button |
4923 |
:notify 'idlwave-widget-scan-lib-files |
:notify 'idlwave-widget-scan-user-lib-files |
4924 |
"Scan & Save") |
"Scan & Save") |
4925 |
(widget-insert " ") |
(widget-insert " ") |
4926 |
(widget-create 'push-button |
(widget-create 'push-button |
4927 |
:notify (lambda (&rest ignore) |
:notify 'idlwave-delete-user-catalog-file |
|
(kill-buffer (current-buffer))) |
|
|
"Quit") |
|
|
(widget-insert " ") |
|
|
(widget-create 'push-button |
|
|
:notify 'idlwave-delete-libinfo-file |
|
4928 |
"Delete File") |
"Delete File") |
4929 |
(widget-insert " ") |
(widget-insert " ") |
4930 |
(widget-create 'push-button |
(widget-create 'push-button |
4931 |
:notify '(lambda (&rest ignore) |
:notify |
4932 |
(idlwave-display-libinfo-widget |
'(lambda (&rest ignore) |
4933 |
(widget-get idlwave-widget :sysdir) |
(let ((path-list (widget-get idlwave-widget :path-dirs))) |
4934 |
(widget-get idlwave-widget :path-dirs) |
(mapcar (lambda (x) |
4935 |
(widget-get idlwave-widget :path-dirs))) |
(unless (memq 'lib (cdr x)) |
4936 |
"Select All") |
(idlwave-path-alist-add-flag x 'user))) |
4937 |
|
path-list) |
4938 |
|
(idlwave-display-user-catalog-widget path-list))) |
4939 |
|
"Select All Non-Lib") |
4940 |
(widget-insert " ") |
(widget-insert " ") |
4941 |
(widget-create 'push-button |
(widget-create 'push-button |
4942 |
:notify '(lambda (&rest ignore) |
:notify |
4943 |
(idlwave-display-libinfo-widget |
'(lambda (&rest ignore) |
4944 |
(widget-get idlwave-widget :sysdir) |
(let ((path-list (widget-get idlwave-widget :path-dirs))) |
4945 |
(widget-get idlwave-widget :path-dirs) |
(mapcar (lambda (x) |
4946 |
nil)) |
(idlwave-path-alist-remove-flag x 'user)) |
4947 |
|
path-list) |
4948 |
|
(idlwave-display-user-catalog-widget path-list))) |
4949 |
"Deselect All") |
"Deselect All") |
4950 |
|
(widget-insert " ") |
4951 |
|
(widget-create 'push-button |
4952 |
|
:notify (lambda (&rest ignore) |
4953 |
|
(kill-buffer (current-buffer))) |
4954 |
|
"Quit") |
4955 |
(widget-insert "\n\n") |
(widget-insert "\n\n") |
4956 |
|
|
4957 |
(widget-insert "Select Directories\n") |
(widget-insert "Select Directories: \n") |
4958 |
|
|
4959 |
(setq idlwave-widget |
(setq idlwave-widget |
4960 |
(apply 'widget-create |
(apply 'widget-create |
4961 |
'checklist |
'checklist |
4962 |
:value selected-dirs |
:value (delq nil (mapcar (lambda (x) |
4963 |
|
(if (memq 'user (cdr x)) |
4964 |
|
(car x))) |
4965 |
|
dirs-list)) |
4966 |
:greedy t |
:greedy t |
4967 |
:tag "List of directories" |
:tag "List of directories" |
4968 |
(mapcar (lambda (x) (list 'item x)) dirs))) |
(mapcar (lambda (x) |
4969 |
(widget-put idlwave-widget :path-dirs dirs) |
(list 'item |
4970 |
(widget-put idlwave-widget :sysdir sysdir) |
(if (memq 'lib (cdr x)) |
4971 |
|
(concat "[LIB] " (car x) ) |
4972 |
|
(car x)))) dirs-list))) |
4973 |
|
(widget-put idlwave-widget :path-dirs dirs-list) |
4974 |
(widget-insert "\n") |
(widget-insert "\n") |
4975 |
(use-local-map widget-keymap) |
(use-local-map widget-keymap) |
4976 |
(widget-setup) |
(widget-setup) |
4977 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4978 |
(delete-other-windows)) |
(delete-other-windows)) |
4979 |
|
|
4980 |
(defun idlwave-delete-libinfo-file (&rest ignore) |
(defun idlwave-delete-user-catalog-file (&rest ignore) |
4981 |
(if (yes-or-no-p |
(if (yes-or-no-p |
4982 |
(format "Delete file %s " idlwave-libinfo-file)) |
(format "Delete file %s " idlwave-user-catalog-file)) |
4983 |
(progn |
(progn |
4984 |
(delete-file idlwave-libinfo-file) |
(delete-file idlwave-user-catalog-file) |
4985 |
(message "%s has been deleted" idlwave-libinfo-file)))) |
(message "%s has been deleted" idlwave-user-catalog-file)))) |
4986 |
|
|
4987 |
(defun idlwave-widget-scan-lib-files (&rest ignore) |
(defun idlwave-widget-scan-user-lib-files (&rest ignore) |
4988 |
;; Call `idlwave-scan-lib-files' with data taken from the widget. |
;; Call `idlwave-scan-user-lib-files' with data taken from the widget. |
4989 |
(let* ((widget idlwave-widget) |
(let* ((widget idlwave-widget) |
4990 |
(selected-dirs (widget-value widget)) |
(selected-dirs (widget-value widget)) |
4991 |
(sysdir (widget-get widget :sysdir)) |
(path-alist (widget-get widget :path-dirs)) |
4992 |
(path-dirs (widget-get widget :path-dirs)) |
(this-path-alist path-alist) |
4993 |
(path-dir-alist |
dir-entry) |
4994 |
(mapcar (lambda (x) (cons x (if (member x selected-dirs) t nil))) |
(while (setq dir-entry (pop this-path-alist)) |
4995 |
path-dirs))) |
(if (member |
4996 |
(idlwave-scan-lib-files sysdir path-dir-alist))) |
(if (memq 'lib (cdr dir-entry)) |
4997 |
|
(concat "[LIB] " (car dir-entry)) |
4998 |
|
(car dir-entry)) |
4999 |
|
selected-dirs) |
5000 |
|
(idlwave-path-alist-add-flag dir-entry 'user) |
5001 |
|
(idlwave-path-alist-remove-flag dir-entry 'user))) |
5002 |
|
(idlwave-scan-user-lib-files path-alist))) |
5003 |
|
|
5004 |
(defvar font-lock-mode) |
(defvar font-lock-mode) |
5005 |
(defun idlwave-scan-lib-files (sysdir path-alist) |
(defun idlwave-scan-user-lib-files (path-alist) |
5006 |
;; Scan the files in PATH-ALIST and store the info in a file |
;; Scan the PRO files in PATH-ALIST and store the info in the user catalog |
5007 |
(let* ((idlwave-scanning-lib t) |
(let* ((idlwave-scanning-lib t) |
5008 |
(idlwave-scanning-lib-dir "") |
(idlwave-scanning-lib-dir "") |
|
(dircnt (1+ (length path-alist))) |
|
5009 |
(idlwave-completion-case nil) |
(idlwave-completion-case nil) |
5010 |
dirs-alist dir files file) |
dirs-alist dir files file) |
5011 |
(setq idlwave-library-routines nil) |
(setq idlwave-user-catalog-routines nil |
5012 |
(setq idlwave-path-alist path-alist) |
idlwave-path-alist path-alist ; for library-path instead |
5013 |
(setq idlwave-true-path-alist nil) |
idlwave-true-path-alist nil) |
5014 |
(setq idlwave-sys-dir sysdir) |
(if idlwave-auto-write-paths (idlwave-write-paths)) |
5015 |
(save-excursion |
(save-excursion |
5016 |
(set-buffer (get-buffer-create "*idlwave-scan.pro*")) |
(set-buffer (get-buffer-create "*idlwave-scan.pro*")) |
5017 |
(idlwave-mode) |
(idlwave-mode) |
5018 |
(setq dirs-alist (reverse path-alist)) |
(setq dirs-alist (reverse path-alist)) |
5019 |
(while (setq dir (pop dirs-alist)) |
(while (setq dir (pop dirs-alist)) |
5020 |
(decf dircnt) |
(when (memq 'user (cdr dir)) ; Has it marked for scan? |
|
(when (cdr dir) |
|
|
;; Has the flag of scanned directories |
|
5021 |
(setq dir (car dir)) |
(setq dir (car dir)) |
5022 |
(setq idlwave-scanning-lib-dir (format "{%d}/" dircnt)) |
(setq idlwave-scanning-lib-dir dir) |
5023 |
(when (file-directory-p dir) |
(when (file-directory-p dir) |
5024 |
(setq files (directory-files dir 'full "\\.[pP][rR][oO]\\'")) |
(setq files (directory-files dir 'full "\\.[pP][rR][oO]\\'")) |
5025 |
(while (setq file (pop files)) |
(while (setq file (pop files)) |
5029 |
(message "Scanning %s..." file) |
(message "Scanning %s..." file) |
5030 |
(erase-buffer) |
(erase-buffer) |
5031 |
(insert-file-contents file 'visit) |
(insert-file-contents file 'visit) |
5032 |
(setq idlwave-library-routines |
(setq idlwave-user-catalog-routines |
5033 |
(append (idlwave-get-routine-info-from-buffers |
(append (idlwave-get-routine-info-from-buffers |
5034 |
(list (current-buffer))) |
(list (current-buffer))) |
5035 |
idlwave-library-routines))) |
idlwave-user-catalog-routines))))))))) |
5036 |
)))))) |
(message "Creating user catalog file...") |
|
;; Sorting is not necessary since we sort each time before a routine |
|
|
;; is used. So we don't do it here - the catalog file looks nicer |
|
|
;; when it is unsorted. |
|
|
;;(message "Sorting...") |
|
|
;;(setq idlwave-library-routines |
|
|
;;(sort idlwave-library-routines 'idlwave-routine-entry-compare)) |
|
|
;;(message "Sorting...done") |
|
|
(message "Creating libinfo file...") |
|
5037 |
(kill-buffer "*idlwave-scan.pro*") |
(kill-buffer "*idlwave-scan.pro*") |
5038 |
(kill-buffer (get-buffer-create "*IDLWAVE Widget*")) |
(kill-buffer (get-buffer-create "*IDLWAVE Widget*")) |
5039 |
(let ((font-lock-maximum-size 0) |
(let ((font-lock-maximum-size 0) |
5040 |
(auto-mode-alist nil)) |
(auto-mode-alist nil)) |
5041 |
(find-file idlwave-libinfo-file)) |
(find-file idlwave-user-catalog-file)) |
5042 |
(if (and (boundp 'font-lock-mode) |
(if (and (boundp 'font-lock-mode) |
5043 |
font-lock-mode) |
font-lock-mode) |
5044 |
(font-lock-mode 0)) |
(font-lock-mode 0)) |
5045 |
(erase-buffer) |
(erase-buffer) |
5046 |
(insert ";; IDLWAVE libinfo file\n") |
(insert ";; IDLWAVE user catalog file\n") |
5047 |
(insert (format ";; Created %s\n\n" (current-time-string))) |
(insert (format ";; Created %s\n\n" (current-time-string))) |
5048 |
|
|
|
;; Define the variable which knows the value of "!DIR" |
|
|
(insert (format "\n(setq idlwave-sys-dir \"%s\")\n" |
|
|
idlwave-sys-dir)) |
|
|
|
|
|
;; Define the variable which contains a list of all scanned directories |
|
|
(insert "\n(setq idlwave-path-alist\n '(") |
|
|
(mapcar (lambda (x) |
|
|
(insert (format "\n (\"%s\" . %s)" (car x) (cdr x)))) |
|
|
path-alist) |
|
|
(insert "))\n") |
|
|
|
|
5049 |
;; Define the routine info list |
;; Define the routine info list |
5050 |
(insert "\n(setq idlwave-library-routines\n '(") |
(insert "\n(setq idlwave-user-catalog-routines\n '(") |
5051 |
(let ((standard-output (current-buffer))) |
(let ((standard-output (current-buffer))) |
5052 |
(mapcar (lambda (x) |
(mapcar (lambda (x) |
5053 |
(insert "\n ") |
(insert "\n ") |
5054 |
(prin1 x) |
(prin1 x) |
5055 |
(goto-char (point-max))) |
(goto-char (point-max))) |
5056 |
; (insert (with-output-to-string (prin1 x)))) |
idlwave-user-catalog-routines)) |
|
idlwave-library-routines)) |
|
5057 |
(insert (format "))\n\n;;; %s ends here\n" |
(insert (format "))\n\n;;; %s ends here\n" |
5058 |
(file-name-nondirectory idlwave-libinfo-file))) |
(file-name-nondirectory idlwave-user-catalog-file))) |
5059 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5060 |
;; Save the buffer |
;; Save the buffer |
5061 |
(save-buffer 0) |
(save-buffer 0) |
5062 |
(kill-buffer (current-buffer))) |
(kill-buffer (current-buffer))) |
5063 |
(message "Creating libinfo file...done") |
(message "Creating user catalog file...done") |
5064 |
(message "Info for %d routines saved in %s" |
(message "Info for %d routines saved in %s" |
5065 |
(length idlwave-library-routines) |
(length idlwave-user-catalog-routines) |
5066 |
idlwave-libinfo-file) |
idlwave-user-catalog-file) |
5067 |
(sit-for 2) |
(sit-for 2) |
5068 |
(idlwave-update-routine-info t)) |
(idlwave-update-routine-info t)) |
5069 |
|
|
5070 |
|
(defun idlwave-read-paths () |
5071 |
|
(if (and (stringp idlwave-path-file) |
5072 |
|
(file-regular-p idlwave-path-file)) |
5073 |
|
(condition-case nil |
5074 |
|
(load idlwave-path-file t t t) |
5075 |
|
(error nil)))) |
5076 |
|
|
5077 |
|
(defun idlwave-write-paths () |
5078 |
|
(interactive) |
5079 |
|
(when (and idlwave-path-alist idlwave-system-directory) |
5080 |
|
(let ((font-lock-maximum-size 0) |
5081 |
|
(auto-mode-alist nil)) |
5082 |
|
(find-file idlwave-path-file)) |
5083 |
|
(if (and (boundp 'font-lock-mode) |
5084 |
|
font-lock-mode) |
5085 |
|
(font-lock-mode 0)) |
5086 |
|
(erase-buffer) |
5087 |
|
(insert ";; IDLWAVE paths\n") |
5088 |
|
(insert (format ";; Created %s\n\n" (current-time-string))) |
5089 |
|
;; Define the variable which knows the value of "!DIR" |
5090 |
|
(insert (format "\n(setq idlwave-system-directory \"%s\")\n" |
5091 |
|
idlwave-system-directory)) |
5092 |
|
|
5093 |
|
;; Define the variable which contains a list of all scanned directories |
5094 |
|
(insert "\n(setq idlwave-path-alist\n '(") |
5095 |
|
(let ((standard-output (current-buffer))) |
5096 |
|
(mapcar (lambda (x) |
5097 |
|
(insert "\n ") |
5098 |
|
(prin1 x) |
5099 |
|
(goto-char (point-max))) |
5100 |
|
idlwave-path-alist)) |
5101 |
|
(insert "))\n") |
5102 |
|
(save-buffer 0) |
5103 |
|
(kill-buffer (current-buffer)))) |
5104 |
|
|
5105 |
|
|
5106 |
(defun idlwave-expand-path (path &optional default-dir) |
(defun idlwave-expand-path (path &optional default-dir) |
5107 |
;; Expand parts of path starting with '+' recursively into directory list. |
;; Expand parts of path starting with '+' recursively into directory list. |
5108 |
;; Relative recursive path elements are expanded relative to DEFAULT-DIR. |
;; Relative recursive path elements are expanded relative to DEFAULT-DIR. |
5129 |
(when (file-directory-p dir) |
(when (file-directory-p dir) |
5130 |
(setq files (nreverse (directory-files dir t "[^.]"))) |
(setq files (nreverse (directory-files dir t "[^.]"))) |
5131 |
(while (setq file (pop files)) |
(while (setq file (pop files)) |
5132 |
(if (file-directory-p file) |
(if (file-directory-p file) |
5133 |
(push (file-name-as-directory file) path))) |
(push (file-name-as-directory file) path))) |
5134 |
(push dir path1))) |
(push dir path1))) |
5135 |
path1)) |
path1)) |
5136 |
|
|
5137 |
;;----- Asking the shell ------------------- |
|
5138 |
|
;;----- Scanning the library catalogs ------------------ |
5139 |
|
|
5140 |
|
(defun idlwave-scan-library-catalogs (&optional message-base no-load) |
5141 |
|
"Scan for library catalog files (.idlwave_catalog) and ingest. |
5142 |
|
|
5143 |
|
All directories on `idlwave-path-alist' (or `idlwave-library-path' |
5144 |
|
instead, if present) are searched. Print MESSAGE-BASE along with the |
5145 |
|
libraries being loaded, if passed, and skip loading/normalizing if |
5146 |
|
NO-LOAD is non-nil. The variable `idlwave-use-library-catalogs' can |
5147 |
|
be set to nil to disable library catalog scanning." |
5148 |
|
(when idlwave-use-library-catalogs |
5149 |
|
(let ((dirs |
5150 |
|
(if idlwave-library-path |
5151 |
|
(idlwave-expand-path idlwave-library-path) |
5152 |
|
(mapcar 'car idlwave-path-alist))) |
5153 |
|
(old-libname "") |
5154 |
|
dir-entry dir flags catalog all-routines) |
5155 |
|
(if message-base (message message-base)) |
5156 |
|
(while (setq dir (pop dirs)) |
5157 |
|
(catch 'continue |
5158 |
|
(when (file-readable-p |
5159 |
|
(setq catalog (expand-file-name ".idlwave_catalog" dir))) |
5160 |
|
(unless no-load |
5161 |
|
(setq idlwave-library-catalog-routines nil) |
5162 |
|
;; Load the catalog file |
5163 |
|
(condition-case nil |
5164 |
|
(load catalog t t t) |
5165 |
|
(error (throw 'continue t))) |
5166 |
|
(when (and |
5167 |
|
message-base |
5168 |
|
(not (string= idlwave-library-catalog-libname |
5169 |
|
old-libname))) |
5170 |
|
(message (concat message-base |
5171 |
|
idlwave-library-catalog-libname)) |
5172 |
|
(setq old-libname idlwave-library-catalog-libname)) |
5173 |
|
(when idlwave-library-catalog-routines |
5174 |
|
(setq all-routines |
5175 |
|
(append |
5176 |
|
(idlwave-sintern-rinfo-list |
5177 |
|
idlwave-library-catalog-routines 'sys dir) |
5178 |
|
all-routines)))) |
5179 |
|
|
5180 |
|
;; Add a 'lib flag if on path-alist |
5181 |
|
(when (and idlwave-path-alist |
5182 |
|
(setq dir-entry (assoc dir idlwave-path-alist))) |
5183 |
|
(idlwave-path-alist-add-flag dir-entry 'lib))))) |
5184 |
|
(unless no-load (setq idlwave-library-catalog-routines all-routines)) |
5185 |
|
(if message-base (message (concat message-base "done")))))) |
5186 |
|
|
5187 |
|
;;----- Communicating with the Shell ------------------- |
5188 |
|
|
5189 |
;; First, here is the idl program which can be used to query IDL for |
;; First, here is the idl program which can be used to query IDL for |
5190 |
;; defined routines. |
;; defined routines. |
5191 |
(defconst idlwave-routine-info.pro |
(defconst idlwave-routine-info.pro |
5192 |
" |
" |
5193 |
;; START OF IDLWAVE SUPPORT ROUTINES |
;; START OF IDLWAVE SUPPORT ROUTINES |
5194 |
pro idlwave_print_info_entry,name,func=func,separator=sep |
pro idlwave_print_info_entry,name,func=func,separator=sep |
5195 |
;; See if it's an object method |
;; See if it's an object method |
5196 |
if name eq '' then return |
if name eq '' then return |
5197 |
func = keyword_set(func) |
func = keyword_set(func) |
5198 |
methsep = strpos(name,'::') |
methsep = strpos(name,'::') |
5199 |
meth = methsep ne -1 |
meth = methsep ne -1 |
5200 |
|
|
5201 |
;; Get routine info |
;; Get routine info |
5202 |
pars = routine_info(name,/parameters,functions=func) |
pars = routine_info(name,/parameters,functions=func) |
5203 |
source = routine_info(name,/source,functions=func) |
source = routine_info(name,/source,functions=func) |
5205 |
nkw = pars.num_kw_args |
nkw = pars.num_kw_args |
5206 |
if nargs gt 0 then args = pars.args |
if nargs gt 0 then args = pars.args |
5207 |
if nkw gt 0 then kwargs = pars.kw_args |
if nkw gt 0 then kwargs = pars.kw_args |
5208 |
|
|
5209 |
;; Trim the class, and make the name |
;; Trim the class, and make the name |
5210 |
if meth then begin |
if meth then begin |
5211 |
class = strmid(name,0,methsep) |
class = strmid(name,0,methsep) |
5212 |
name = strmid(name,methsep+2,strlen(name)-1) |
name = strmid(name,methsep+2,strlen(name)-1) |
5213 |
if nargs gt 0 then begin |
if nargs gt 0 then begin |
5214 |
;; remove the self argument |
;; remove the self argument |
5215 |
wh = where(args ne 'SELF',nargs) |
wh = where(args ne 'SELF',nargs) |
5216 |
if nargs gt 0 then args = args(wh) |
if nargs gt 0 then args = args[wh] |
5217 |
endif |
endif |
5218 |
endif else begin |
endif else begin |
5219 |
;; No class, just a normal routine. |
;; No class, just a normal routine. |
5220 |
class = \"\" |
class = \"\" |
5221 |
endelse |
endelse |
5222 |
|
|
5223 |
;; Calling sequence |
;; Calling sequence |
5224 |
cs = \"\" |
cs = \"\" |
5225 |
if func then cs = 'Result = ' |
if func then cs = 'Result = ' |
5228 |
if func then cs = cs + '(' else if nargs gt 0 then cs = cs + ', ' |
if func then cs = cs + '(' else if nargs gt 0 then cs = cs + ', ' |
5229 |
if nargs gt 0 then begin |
if nargs gt 0 then begin |
5230 |
for j=0,nargs-1 do begin |
for j=0,nargs-1 do begin |
5231 |
cs = cs + args(j) |
cs = cs + args[j] |
5232 |
if j lt nargs-1 then cs = cs + ', ' |
if j lt nargs-1 then cs = cs + ', ' |
5233 |
endfor |
endfor |
5234 |
end |
end |
5237 |
kwstring = '' |
kwstring = '' |
5238 |
if nkw gt 0 then begin |
if nkw gt 0 then begin |
5239 |
for j=0,nkw-1 do begin |
for j=0,nkw-1 do begin |
5240 |
kwstring = kwstring + ' ' + kwargs(j) |
kwstring = kwstring + ' ' + kwargs[j] |
5241 |
endfor |
endfor |
5242 |
endif |
endif |
5243 |
|
|
5244 |
ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])(func) |
ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func] |
5245 |
|
|
5246 |
print,ret + ': ' + name + sep + class + sep + source(0).path $ |
print,ret + ': ' + name + sep + class + sep + source[0].path $ |
5247 |
+ sep + cs + sep + kwstring |
+ sep + cs + sep + kwstring |
5248 |
end |
end |
5249 |
|
|
5250 |
pro idlwave_routine_info |
pro idlwave_routine_info |
5251 |
|
on_error,1 |
5252 |
sep = '<@>' |
sep = '<@>' |
5253 |
print,'>>>BEGIN OF IDLWAVE ROUTINE INFO (\"' + sep + '\" IS THE SEPARATOR)' |
print,'>>>BEGIN OF IDLWAVE ROUTINE INFO (\"' + sep + '\" IS THE SEPARATOR)' |
5254 |
all = routine_info() |
all = routine_info() |
5255 |
for i=0,n_elements(all)-1 do $ |
for i=0,n_elements(all)-1 do $ |
5256 |
idlwave_print_info_entry,all(i),separator=sep |
idlwave_print_info_entry,all[i],separator=sep |
5257 |
all = routine_info(/functions) |
all = routine_info(/functions) |
5258 |
for i=0,n_elements(all)-1 do $ |
for i=0,n_elements(all)-1 do $ |
5259 |
idlwave_print_info_entry,all(i),/func,separator=sep |
idlwave_print_info_entry,all[i],/func,separator=sep |
5260 |
print,'>>>END OF IDLWAVE ROUTINE INFO' |
print,'>>>END OF IDLWAVE ROUTINE INFO' |
5261 |
end |
end |
5262 |
|
|
5263 |
pro idlwave_get_sysvars |
pro idlwave_get_sysvars |
5264 |
forward_function strjoin,strtrim,strsplit |
on_error,1 |
5265 |
catch,error_status |
catch,error_status |
5266 |
if error_status ne 0 then begin |
if error_status ne 0 then begin |
5267 |
print, 'Cannot get info about system variables' |
print, 'Cannot get info about system variables' |
5282 |
if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single) |
if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single) |
5283 |
end |
end |
5284 |
;; END OF IDLWAVE SUPPORT ROUTINES |
;; END OF IDLWAVE SUPPORT ROUTINES |
5285 |
" |
" |
5286 |
"The idl programs to get info from the shell.") |
"The idl programs to get info from the shell.") |
5287 |
|
|
5288 |
(defvar idlwave-idlwave_routine_info-compiled nil |
(defvar idlwave-idlwave_routine_info-compiled nil |
5290 |
|
|
5291 |
(defvar idlwave-shell-temp-pro-file) |
(defvar idlwave-shell-temp-pro-file) |
5292 |
(defvar idlwave-shell-temp-rinfo-save-file) |
(defvar idlwave-shell-temp-rinfo-save-file) |
5293 |
(defun idlwave-shell-update-routine-info (&optional quiet run-hooks preempt) |
(defun idlwave-shell-update-routine-info (&optional quiet run-hooks wait) |
5294 |
"Query the shell for routine_info of compiled modules and update the lists." |
"Query the shell for routine_info of compiled modules and update the lists." |
5295 |
;; Save and compile the procedure. The compiled procedure is then |
;; Save and compile the procedure. The compiled procedure is then |
5296 |
;; saved into an IDL SAVE file, to allow for fast RESTORE. |
;; saved into an IDL SAVE file, to allow for fast RESTORE. |
5305 |
(erase-buffer) |
(erase-buffer) |
5306 |
(insert idlwave-routine-info.pro) |
(insert idlwave-routine-info.pro) |
5307 |
(save-buffer 0)) |
(save-buffer 0)) |
5308 |
(idlwave-shell-send-command |
(idlwave-shell-send-command |
5309 |
(concat ".run " idlwave-shell-temp-pro-file) |
(concat ".run " idlwave-shell-temp-pro-file) |
5310 |
nil 'hide) |
nil 'hide wait) |
5311 |
; (message "SENDING SAVE") ; ???????????????????????? |
; (message "SENDING SAVE") ; ???????????????????????? |
5312 |
(idlwave-shell-send-command |
(idlwave-shell-send-command |
5313 |
(format "save,'idlwave_routine_info','idlwave_print_info_entry',FILE='%s',/ROUTINES" |
(format "save,'idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" |
5314 |
(idlwave-shell-temp-file 'rinfo)) |
(idlwave-shell-temp-file 'rinfo)) |
5315 |
nil 'hide)) |
nil 'hide wait)) |
5316 |
|
|
5317 |
;; Restore and execute the procedure, analyze the output |
;; Restore and execute the procedure, analyze the output |
5318 |
; (message "SENDING RESTORE & EXECUTE") ; ???????????????????????? |
; (message "SENDING RESTORE & EXECUTE") ; ???????????????????????? |
5322 |
`(progn |
`(progn |
5323 |
(idlwave-shell-routine-info-filter) |
(idlwave-shell-routine-info-filter) |
5324 |
(idlwave-concatenate-rinfo-lists ,quiet ,run-hooks)) |
(idlwave-concatenate-rinfo-lists ,quiet ,run-hooks)) |
5325 |
'hide preempt)) |
'hide wait)) |
5326 |
|
|
5327 |
;; --------------------------------------------------------------------------- |
;; --------------------------------------------------------------------------- |
5328 |
;; |
;; |
5329 |
;; Completion and displaying routine calling sequences |
;; Completion and displaying routine calling sequences |
5330 |
|
|
5331 |
(defvar idlwave-completion-help-info nil) |
(defvar idlwave-completion-help-info nil) |
5332 |
|
(defvar idlwave-completion-help-links nil) |
5333 |
(defvar idlwave-current-obj_new-class nil) |
(defvar idlwave-current-obj_new-class nil) |
5334 |
(defvar idlwave-complete-special nil) |
(defvar idlwave-complete-special nil) |
5335 |
|
|
5374 |
As a special case, the universal argument C-u forces completion of |
As a special case, the universal argument C-u forces completion of |
5375 |
function names in places where the default would be a keyword. |
function names in places where the default would be a keyword. |
5376 |
|
|
5377 |
|
Two prefix argument, C-u C-u, prompts for a regexp by which to limit |
5378 |
|
completion. |
5379 |
|
|
5380 |
For Lisp programmers only: |
For Lisp programmers only: |
5381 |
When we force a keyword, optional argument MODULE can contain the module name. |
When we force a keyword, optional argument MODULE can contain the module name. |
5382 |
When we force a method or a method keyword, CLASS can specify the class." |
When we force a method or a method keyword, CLASS can specify the class." |
5384 |
(idlwave-routines) |
(idlwave-routines) |
5385 |
(let* ((where-list |
(let* ((where-list |
5386 |
(if (and arg |
(if (and arg |
5387 |
(or (integerp arg) |
(or (and (integerp arg) (not (equal arg '(16)))) |
5388 |
(symbolp arg))) |
(symbolp arg))) |
5389 |
(idlwave-make-force-complete-where-list arg module class) |
(idlwave-make-force-complete-where-list arg module class) |
5390 |
(idlwave-where))) |
(idlwave-where))) |
5391 |
(what (nth 2 where-list)) |
(what (nth 2 where-list)) |
5392 |
(idlwave-force-class-query (equal arg '(4)))) |
(idlwave-force-class-query (equal arg '(4))) |
5393 |
|
(completion-regexp-list |
5394 |
|
(if (equal arg '(16)) |
5395 |
|
(list (read-string (concat "Completion Regexp: ")))))) |
5396 |
|
|
5397 |
(if (and module (string-match "::" module)) |
(if (and module (string-match "::" module)) |
5398 |
(setq class (substring module 0 (match-beginning 0)) |
(setq class (substring module 0 (match-beginning 0)) |
5399 |
module (substring module (match-end 0)))) |
module (substring module (match-end 0)))) |
5406 |
(setq this-command last-command) |
(setq this-command last-command) |
5407 |
(idlwave-scroll-completions)) |
(idlwave-scroll-completions)) |
5408 |
|
|
5409 |
;; Check for any special completion functions |
;; Complete a filename in quotes |
|
((and idlwave-complete-special |
|
|
(idlwave-call-special idlwave-complete-special))) |
|
|
|
|
5410 |
((and (idlwave-in-quote) |
((and (idlwave-in-quote) |
5411 |
(not (eq what 'class))) |
(not (eq what 'class))) |
5412 |
(idlwave-complete-filename)) |
(idlwave-complete-filename)) |
5413 |
|
|
5414 |
|
;; Check for any special completion functions |
5415 |
|
((and idlwave-complete-special |
5416 |
|
(idlwave-call-special idlwave-complete-special))) |
5417 |
|
|
5418 |
((null what) |
((null what) |
5419 |
(error "Nothing to complete here")) |
(error "Nothing to complete here")) |
5420 |
|
|
5421 |
|
;; Complete a class |
5422 |
((eq what 'class) |
((eq what 'class) |
5423 |
(setq idlwave-completion-help-info '(class)) |
(setq idlwave-completion-help-info '(class)) |
5424 |
(idlwave-complete-class)) |
(idlwave-complete-class)) |
5431 |
(idlwave-all-class-inherits class-selector))) |
(idlwave-all-class-inherits class-selector))) |
5432 |
(isa (concat "procedure" (if class-selector "-method" ""))) |
(isa (concat "procedure" (if class-selector "-method" ""))) |
5433 |
(type-selector 'pro)) |
(type-selector 'pro)) |
5434 |
(setq idlwave-completion-help-info |
(setq idlwave-completion-help-info |
5435 |
(list 'routine nil type-selector class-selector nil super-classes)) |
(list 'routine nil type-selector class-selector nil super-classes)) |
5436 |
(idlwave-complete-in-buffer |
(idlwave-complete-in-buffer |
5437 |
'procedure (if class-selector 'method 'routine) |
'procedure (if class-selector 'method 'routine) |
5439 |
(format "Select a %s name%s" |
(format "Select a %s name%s" |
5440 |
isa |
isa |
5441 |
(if class-selector |
(if class-selector |
5442 |
(format " (class is %s)" |
(format " (class is %s)" |
5443 |
(if (eq class-selector t) |
(if (eq class-selector t) |
5444 |
"unknown" class-selector)) |
"unknown" class-selector)) |
5445 |
"")) |
"")) |
5446 |
isa |
isa |
5447 |
'idlwave-attach-method-classes))) |
'idlwave-attach-method-classes 'idlwave-add-file-link-selector))) |
5448 |
|
|
5449 |
((eq what 'function) |
((eq what 'function) |
5450 |
;; Complete a function name |
;; Complete a function name |
5454 |
(idlwave-all-class-inherits class-selector))) |
(idlwave-all-class-inherits class-selector))) |
5455 |
(isa (concat "function" (if class-selector "-method" ""))) |
(isa (concat "function" (if class-selector "-method" ""))) |
5456 |
(type-selector 'fun)) |
(type-selector 'fun)) |
5457 |
(setq idlwave-completion-help-info |
(setq idlwave-completion-help-info |
5458 |
(list 'routine nil type-selector class-selector nil super-classes)) |
(list 'routine nil type-selector class-selector nil super-classes)) |
5459 |
(idlwave-complete-in-buffer |
(idlwave-complete-in-buffer |
5460 |
'function (if class-selector 'method 'routine) |
'function (if class-selector 'method 'routine) |
5462 |
(format "Select a %s name%s" |
(format "Select a %s name%s" |
5463 |
isa |
isa |
5464 |
(if class-selector |
(if class-selector |
5465 |
(format " (class is %s)" |
(format " (class is %s)" |
5466 |
(if (eq class-selector t) |
(if (eq class-selector t) |
5467 |
"unknown" class-selector)) |
"unknown" class-selector)) |
5468 |
"")) |
"")) |
5469 |
isa |
isa |
5470 |
'idlwave-attach-method-classes))) |
'idlwave-attach-method-classes 'idlwave-add-file-link-selector))) |
5471 |
|
|
5472 |
((and (memq what '(procedure-keyword function-keyword)) |
((and (memq what '(procedure-keyword function-keyword)) ; Special Case |
5473 |
(equal arg '(4))) |
(equal arg '(4))) |
5474 |
(idlwave-complete 3)) |
(idlwave-complete 3)) |
5475 |
|
|
5485 |
(isa (format "procedure%s-keyword" (if class "-method" ""))) |
(isa (format "procedure%s-keyword" (if class "-method" ""))) |
5486 |
(entry (idlwave-best-rinfo-assq |
(entry (idlwave-best-rinfo-assq |
5487 |
name 'pro class (idlwave-routines))) |
name 'pro class (idlwave-routines))) |
5488 |
(list (nth 5 entry))) |
(list (idlwave-entry-keywords entry 'do-link))) |
5489 |
(unless (or entry (eq class t)) |
(unless (or entry (eq class t)) |
5490 |
(error "Nothing known about procedure %s" |
(error "Nothing known about procedure %s" |
5491 |
(idlwave-make-full-name class name))) |
(idlwave-make-full-name class name))) |
5492 |
(setq list (idlwave-fix-keywords name 'pro class list)) |
(setq list (idlwave-fix-keywords name 'pro class list super-classes)) |
5493 |
(unless list (error (format "No keywords available for procedure %s" |
(unless list (error (format "No keywords available for procedure %s" |
5494 |
(idlwave-make-full-name class name)))) |
(idlwave-make-full-name class name)))) |
5495 |
(setq idlwave-completion-help-info |
(setq idlwave-completion-help-info |
5496 |
(list 'keyword name type-selector class-selector nil super-classes)) |
(list 'keyword name type-selector class-selector entry super-classes)) |
5497 |
(idlwave-complete-in-buffer |
(idlwave-complete-in-buffer |
5498 |
'keyword 'keyword list nil |
'keyword 'keyword list nil |
5499 |
(format "Select keyword for procedure %s%s" |
(format "Select keyword for procedure %s%s" |
5500 |
(idlwave-make-full-name class name) |
(idlwave-make-full-name class name) |
5501 |
(if (or (member '("_EXTRA") list) |
(if (or (member '("_EXTRA") list) |
5502 |
(member '("_REF_EXTRA") list)) |
(member '("_REF_EXTRA") list)) |
5503 |
" (note _EXTRA)" "")) |
" (note _EXTRA)" "")) |
5504 |
isa |
isa |
5505 |
'idlwave-attach-keyword-classes))) |
'idlwave-attach-keyword-classes))) |
5516 |
(isa (format "function%s-keyword" (if class "-method" ""))) |
(isa (format "function%s-keyword" (if class "-method" ""))) |
5517 |
(entry (idlwave-best-rinfo-assq |
(entry (idlwave-best-rinfo-assq |
5518 |
name 'fun class (idlwave-routines))) |
name 'fun class (idlwave-routines))) |
5519 |
(list (nth 5 entry)) |
(list (idlwave-entry-keywords entry 'do-link)) |
5520 |
msg-name) |
msg-name) |
5521 |
(unless (or entry (eq class t)) |
(unless (or entry (eq class t)) |
5522 |
(error "Nothing known about function %s" |
(error "Nothing known about function %s" |
5523 |
(idlwave-make-full-name class name))) |
(idlwave-make-full-name class name))) |
5524 |
(setq list (idlwave-fix-keywords name 'fun class list)) |
(setq list (idlwave-fix-keywords name 'fun class list super-classes)) |
5525 |
;; OBJ_NEW: Messages mention the proper Init method |
;; OBJ_NEW: Messages mention the proper Init method |
5526 |
(setq msg-name (if (and (null class) |
(setq msg-name (if (and (null class) |
5527 |
(string= (upcase name) "OBJ_NEW")) |
(string= (upcase name) "OBJ_NEW")) |
5530 |
(idlwave-make-full-name class name))) |
(idlwave-make-full-name class name))) |
5531 |
(unless list (error (format "No keywords available for function %s" |
(unless list (error (format "No keywords available for function %s" |
5532 |
msg-name))) |
msg-name))) |
5533 |
(setq idlwave-completion-help-info |
(setq idlwave-completion-help-info |
5534 |
(list 'keyword name type-selector class-selector nil super-classes)) |
(list 'keyword name type-selector class-selector nil super-classes)) |
5535 |
(idlwave-complete-in-buffer |
(idlwave-complete-in-buffer |
5536 |
'keyword 'keyword list nil |
'keyword 'keyword list nil |
5537 |
(format "Select keyword for function %s%s" msg-name |
(format "Select keyword for function %s%s" msg-name |
5538 |
(if (or (member '("_EXTRA") list) |
(if (or (member '("_EXTRA") list) |
5539 |
(member '("_REF_EXTRA") list)) |
(member '("_REF_EXTRA") list)) |
5540 |
" (note _EXTRA)" "")) |
" (note _EXTRA)" "")) |
5541 |
isa |
isa |
5542 |
'idlwave-attach-keyword-classes))) |
'idlwave-attach-keyword-classes))) |
5545 |
|
|
5546 |
(defvar idlwave-complete-special nil |
(defvar idlwave-complete-special nil |
5547 |
"List of special completion functions. |
"List of special completion functions. |
5548 |
These functions are called for each completion. Each function must check |
These functions are called for each completion. Each function must |
5549 |
if its own special completion context is present. If yes, it should |
check if its own special completion context is present. If yes, it |
5550 |
use `idlwave-complete-in-buffer' to do some completion and return t. |
should use `idlwave-complete-in-buffer' to do some completion and |
5551 |
If such a function returns t, *no further* attempts to complete |
return t. If such a function returns t, *no further* attempts to |
5552 |
other contexts will be done. If the function returns nil, other completions |
complete other contexts will be done. If the function returns nil, |
5553 |
will be tried.") |
other completions will be tried.") |
5554 |
|
|
5555 |
(defun idlwave-call-special (functions &rest args) |
(defun idlwave-call-special (functions &rest args) |
5556 |
(let ((funcs functions) |
(let ((funcs functions) |
5574 |
("class"))) |
("class"))) |
5575 |
(module (idlwave-sintern-routine-or-method module class)) |
(module (idlwave-sintern-routine-or-method module class)) |
5576 |
(class (idlwave-sintern-class class)) |
(class (idlwave-sintern-class class)) |
5577 |
(what (cond |
(what (cond |
5578 |
((equal what 0) |
((equal what 0) |
5579 |
(setq what |
(setq what |
5580 |
(intern (completing-read |
(intern (completing-read |
5581 |
"Complete what? " what-list nil t)))) |
"Complete what? " what-list nil t)))) |
5582 |
((integerp what) |
((integerp what) |
5583 |
(setq what (intern (car (nth (1- what) what-list))))) |
(setq what (intern (car (nth (1- what) what-list))))) |
5599 |
(super-classes nil) |
(super-classes nil) |
5600 |
(type-selector 'pro) |
(type-selector 'pro) |
5601 |
(pro (or module |
(pro (or module |
5602 |
(idlwave-completing-read |
(idlwave-completing-read |
5603 |
"Procedure: " (idlwave-routines) 'idlwave-selector)))) |
"Procedure: " (idlwave-routines) 'idlwave-selector)))) |
5604 |
(setq pro (idlwave-sintern-routine pro)) |
(setq pro (idlwave-sintern-routine pro)) |
5605 |
(list nil-list nil-list 'procedure-keyword |
(list nil-list nil-list 'procedure-keyword |
5613 |
(super-classes nil) |
(super-classes nil) |
5614 |
(type-selector 'fun) |
(type-selector 'fun) |
5615 |
(func (or module |
(func (or module |
5616 |
(idlwave-completing-read |
(idlwave-completing-read |
5617 |
"Function: " (idlwave-routines) 'idlwave-selector)))) |
"Function: " (idlwave-routines) 'idlwave-selector)))) |
5618 |
(setq func (idlwave-sintern-routine func)) |
(setq func (idlwave-sintern-routine func)) |
5619 |
(list nil-list nil-list 'function-keyword |
(list nil-list nil-list 'function-keyword |
5653 |
|
|
5654 |
((eq what 'class) |
((eq what 'class) |
5655 |
(list nil-list nil-list 'class nil-list nil)) |
(list nil-list nil-list 'class nil-list nil)) |
5656 |
|
|
5657 |
(t (error "Illegal value for WHAT"))))) |
(t (error "Illegal value for WHAT"))))) |
5658 |
|
|
5659 |
(defun idlwave-completing-read (&rest args) |
(defun idlwave-completing-read (&rest args) |
5676 |
(stringp idlwave-shell-default-directory) |
(stringp idlwave-shell-default-directory) |
5677 |
(file-directory-p idlwave-shell-default-directory)) |
(file-directory-p idlwave-shell-default-directory)) |
5678 |
idlwave-shell-default-directory |
idlwave-shell-default-directory |
5679 |
default-directory))) |
default-directory))) |
5680 |
(comint-dynamic-complete-filename))) |
(comint-dynamic-complete-filename))) |
5681 |
|
|
5682 |
(defun idlwave-make-full-name (class name) |
(defun idlwave-make-full-name (class name) |
5685 |
|
|
5686 |
(defun idlwave-rinfo-assoc (name type class list) |
(defun idlwave-rinfo-assoc (name type class list) |
5687 |
"Like `idlwave-rinfo-assq', but sintern strings first." |
"Like `idlwave-rinfo-assq', but sintern strings first." |
5688 |
(idlwave-rinfo-assq |
(idlwave-rinfo-assq |
5689 |
(idlwave-sintern-routine-or-method name class) |
(idlwave-sintern-routine-or-method name class) |
5690 |
type (idlwave-sintern-class class) list)) |
type (idlwave-sintern-class class) list)) |
5691 |
|
|
5701 |
(setq list (cdr (memq match list))))))) |
(setq list (cdr (memq match list))))))) |
5702 |
|
|
5703 |
(defun idlwave-rinfo-assq-any-class (name type class list) |
(defun idlwave-rinfo-assq-any-class (name type class list) |
5704 |
|
;; Return the first matching method on the inheritance list |
5705 |
(let* ((classes (cons class (idlwave-all-class-inherits class))) |
(let* ((classes (cons class (idlwave-all-class-inherits class))) |
5706 |
class rtn) |
class rtn) |
5707 |
(while classes |
(while classes |
5709 |
(setq classes nil))) |
(setq classes nil))) |
5710 |
rtn)) |
rtn)) |
5711 |
|
|
5712 |
(defun idlwave-best-rinfo-assq (name type class list) |
(defun idlwave-best-rinfo-assq (name type class list &optional with-file |
5713 |
"Like `idlwave-rinfo-assq', but get all twins and sort, then return first." |
keep-system) |
5714 |
|
"Like `idlwave-rinfo-assq', but get all twins and sort, then return first. |
5715 |
|
If WITH-FILE is passed, find the best rinfo entry with a file |
5716 |
|
included. If KEEP-SYSTEM is set, don't prune system for compiled |
5717 |
|
syslib files." |
5718 |
(let ((twins (idlwave-routine-twins |
(let ((twins (idlwave-routine-twins |
5719 |
(idlwave-rinfo-assq-any-class name type class list) |
(idlwave-rinfo-assq-any-class name type class list) |
5720 |
list)) |
list)) |
5721 |
syslibp) |
syslibp) |
5722 |
(when (> (length twins) 1) |
(when (> (length twins) 1) |
5723 |
(setq twins (sort twins 'idlwave-routine-entry-compare-twins)) |
(setq twins (sort twins 'idlwave-routine-entry-compare-twins)) |
5724 |
(if (and (eq 'system (car (nth 3 (car twins)))) |
(if (and (null keep-system) |
5725 |
|
(eq 'system (car (nth 3 (car twins)))) |
5726 |
(setq syslibp (idlwave-any-syslib (cdr twins))) |
(setq syslibp (idlwave-any-syslib (cdr twins))) |
5727 |
(not (equal 1 syslibp))) |
(not (equal 1 syslibp))) |
5728 |
;; Its a syslib, so we need to remove the system entry |
;; Its a compiled syslib, so we need to remove the system entry |
5729 |
(setq twins (cdr twins)))) |
(setq twins (cdr twins))) |
5730 |
|
(if with-file |
5731 |
|
(setq twins (delq nil |
5732 |
|
(mapcar (lambda (x) |
5733 |
|
(if (nth 1 (nth 3 x)) x)) |
5734 |
|
twins))))) |
5735 |
(car twins))) |
(car twins))) |
5736 |
|
|
5737 |
(defun idlwave-best-rinfo-assoc (name type class list) |
(defun idlwave-best-rinfo-assoc (name type class list &optional with-file |
5738 |
|
keep-system) |
5739 |
"Like `idlwave-best-rinfo-assq', but sintern strings first." |
"Like `idlwave-best-rinfo-assq', but sintern strings first." |
5740 |
(idlwave-best-rinfo-assq |
(idlwave-best-rinfo-assq |
5741 |
(idlwave-sintern-routine-or-method name class) |
(idlwave-sintern-routine-or-method name class) |
5742 |
type (idlwave-sintern-class class) list)) |
type (idlwave-sintern-class class) list with-file keep-system)) |
5743 |
|
|
5744 |
(defun idlwave-any-syslib (entries) |
(defun idlwave-any-syslib (entries) |
5745 |
"Does the entry list ENTRIES contain a syslib entry? |
"Does the entry list ENTRIES contain a syslib entry? |
5748 |
(catch 'exit |
(catch 'exit |
5749 |
(while entries |
(while entries |
5750 |
(incf cnt) |
(incf cnt) |
5751 |
(setq file (cdr (nth 3 (car entries)))) |
(setq file (idlwave-routine-source-file (nth 3 (car entries)))) |
5752 |
(if (and file |
(if (and file (idlwave-syslib-p file)) |
|
(idlwave-syslib-p |
|
|
(idlwave-expand-lib-file-name file))) |
|
5753 |
(throw 'exit cnt) |
(throw 'exit cnt) |
5754 |
(setq entries (cdr entries)))) |
(setq entries (cdr entries)))) |
5755 |
nil))) |
nil))) |
5785 |
nil |
nil |
5786 |
(let (rtn) |
(let (rtn) |
5787 |
(mapcar (lambda (x) |
(mapcar (lambda (x) |
5788 |
(and (nth 2 x) |
(and (nth 2 x) ; non-nil class |
5789 |
(or (not type) |
(or (not type) ; correct or unspecified type |
5790 |
(eq type (nth 1 x))) |
(eq type (nth 1 x))) |
5791 |
(assoc keyword (nth 5 x)) |
(assoc keyword (idlwave-entry-keywords x)) |
5792 |
(push (nth 2 x) rtn))) |
(push (nth 2 x) rtn))) |
5793 |
(idlwave-all-assq method (idlwave-routines))) |
(idlwave-all-assq method (idlwave-routines))) |
5794 |
(idlwave-uniquify rtn)))) |
(idlwave-uniquify rtn)))) |
5825 |
Must accept two arguments: `apos' and `info'") |
Must accept two arguments: `apos' and `info'") |
5826 |
|
|
5827 |
(defun idlwave-determine-class (info type) |
(defun idlwave-determine-class (info type) |
5828 |
;; Determine the class of a routine call. |
;; Determine the class of a routine call. |
5829 |
;; INFO is the `cw-list' structure as returned by idlwave-where. |
;; INFO is the `cw-list' structure as returned by idlwave-where. |
5830 |
;; The second element in this structure is the class. When nil, we |
;; The second element in this structure is the class. When nil, we |
5831 |
;; return nil. When t, try to get the class from text properties at |
;; return nil. When t, try to get the class from text properties at |
5845 |
(dassoc (cdr dassoc)) |
(dassoc (cdr dassoc)) |
5846 |
(t t))) |
(t t))) |
5847 |
(arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) |
(arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) |
5848 |
(is-self |
(is-self |
5849 |
(and arrow |
(and arrow |
5850 |
(save-excursion (goto-char apos) |
(save-excursion (goto-char apos) |
5851 |
(forward-word -1) |
(forward-word -1) |
5866 |
(setq class (or (nth 2 (idlwave-current-routine)) class))) |
(setq class (or (nth 2 (idlwave-current-routine)) class))) |
5867 |
|
|
5868 |
;; Before prompting, try any special class determination routines |
;; Before prompting, try any special class determination routines |
5869 |
(when (and (eq t class) |
(when (and (eq t class) |
5870 |
idlwave-determine-class-special |
idlwave-determine-class-special |
5871 |
(not force-query)) |
(not force-query)) |
5872 |
(setq special-class |
(setq special-class |
5873 |
(idlwave-call-special idlwave-determine-class-special apos)) |
(idlwave-call-special idlwave-determine-class-special apos)) |
5874 |
(if special-class |
(if special-class |
5875 |
(setq class (idlwave-sintern-class special-class) |
(setq class (idlwave-sintern-class special-class) |
5876 |
store idlwave-store-inquired-class))) |
store idlwave-store-inquired-class))) |
5877 |
|
|
5878 |
;; Prompt for a class, if we need to |
;; Prompt for a class, if we need to |
5879 |
(when (and (eq class t) |
(when (and (eq class t) |
5880 |
(or force-query query)) |
(or force-query query)) |
5881 |
(setq class-alist |
(setq class-alist |
5882 |
(mapcar 'list (idlwave-all-method-classes (car info) type))) |
(mapcar 'list (idlwave-all-method-classes (car info) type))) |
5883 |
(setq class |
(setq class |
5884 |
(idlwave-sintern-class |
(idlwave-sintern-class |
5887 |
(error "No classes available with method %s" (car info))) |
(error "No classes available with method %s" (car info))) |
5888 |
((and (= (length class-alist) 1) (not force-query)) |
((and (= (length class-alist) 1) (not force-query)) |
5889 |
(car (car class-alist))) |
(car (car class-alist))) |
5890 |
(t |
(t |
5891 |
(setq store idlwave-store-inquired-class) |
(setq store idlwave-store-inquired-class) |
5892 |
(idlwave-completing-read |
(idlwave-completing-read |
5893 |
(format "Class%s: " (if (stringp (car info)) |
(format "Class%s: " (if (stringp (car info)) |
5894 |
(format " for %s method %s" |
(format " for %s method %s" |
5895 |
type (car info)) |
type (car info)) |
5901 |
;; We have a real class here |
;; We have a real class here |
5902 |
(when (and store arrow) |
(when (and store arrow) |
5903 |
(condition-case () |
(condition-case () |
5904 |
(add-text-properties |
(add-text-properties |
5905 |
apos (+ apos 2) |
apos (+ apos 2) |
5906 |
`(idlwave-class ,class face ,idlwave-class-arrow-face |
`(idlwave-class ,class face ,idlwave-class-arrow-face |
5907 |
rear-nonsticky t)) |
rear-nonsticky t)) |
5908 |
(error nil))) |
(error nil))) |
5909 |
(setf (nth 2 info) class)) |
(setf (nth 2 info) class)) |
5920 |
(and (eq (nth 1 a) type-selector) |
(and (eq (nth 1 a) type-selector) |
5921 |
(or (and (nth 2 a) (eq class-selector t)) |
(or (and (nth 2 a) (eq class-selector t)) |
5922 |
(eq (nth 2 a) class-selector) |
(eq (nth 2 a) class-selector) |
5923 |
(memq (nth 2 a) super-classes) |
(memq (nth 2 a) super-classes)))) |
5924 |
))) |
|
5925 |
|
(defun idlwave-add-file-link-selector (a) |
5926 |
|
;; Record a file link, if any, for the tested names during selection. |
5927 |
|
(let ((sel (idlwave-selector a)) file) |
5928 |
|
(if (and sel (setq file (idlwave-entry-has-help a))) |
5929 |
|
(push (cons (car a) file) idlwave-completion-help-links)) |
5930 |
|
sel)) |
5931 |
|
|
5932 |
|
|
5933 |
(defun idlwave-where () |
(defun idlwave-where () |
5934 |
"Find out where we are. |
"Find out where we are. |
5935 |
The return value is a list with the following stuff: |
The return value is a list with the following stuff: |
5936 |
\(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) |
\(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) |
5937 |
|
|
5938 |
PRO-LIST (PRO POINT CLASS ARROW) |
PRO-LIST (PRO POINT CLASS ARROW) |
5939 |
FUNC-LIST (FUNC POINT CLASS ARROW) |
FUNC-LIST (FUNC POINT CLASS ARROW) |
5940 |
COMPLETE-WHAT a symbol indicating what kind of completion makes sense here |
COMPLETE-WHAT a symbol indicating what kind of completion makes sense here |
5941 |
CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can |
CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can |
5942 |
be completed here. |
be completed here. |
5943 |
LAST-CHAR last relevant character before point (non-white non-comment, |
LAST-CHAR last relevant character before point (non-white non-comment, |
5944 |
not part of current identifier or leading slash). |
not part of current identifier or leading slash). |
5950 |
CLASS: What class has the routine (nil=no, t=is method, but class unknown) |
CLASS: What class has the routine (nil=no, t=is method, but class unknown) |
5951 |
ARROW: Location of the arrow" |
ARROW: Location of the arrow" |
5952 |
(idlwave-routines) |
(idlwave-routines) |
5953 |
(let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) |
(let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) |
5954 |
(bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) |
(bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) |
5955 |
(func-entry (idlwave-what-function bos)) |
(func-entry (idlwave-what-function bos)) |
5956 |
(func (car func-entry)) |
(func (car func-entry)) |
5965 |
(pro-point (or (nth 3 pro-entry) 0)) |
(pro-point (or (nth 3 pro-entry) 0)) |
5966 |
(last-char (idlwave-last-valid-char)) |
(last-char (idlwave-last-valid-char)) |
5967 |
(case-fold-search t) |
(case-fold-search t) |
5968 |
|
(match-string (buffer-substring bos (point))) |
5969 |
cw cw-mod cw-arrow cw-class cw-point) |
cw cw-mod cw-arrow cw-class cw-point) |
5970 |
(if (< func-point pro-point) (setq func nil)) |
(if (< func-point pro-point) (setq func nil)) |
5971 |
(cond |
(cond |
5972 |
((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" |
((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" |
5973 |
(buffer-substring bos (point))) |
match-string) |
5974 |
(setq cw 'class)) |
(setq cw 'class)) |
5975 |
((string-match |
((string-match |
5976 |
"\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" |
"\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" |
5977 |
(buffer-substring (if (> pro-point 0) pro-point bos) (point))) |
(if (> pro-point 0) |
5978 |
|
(buffer-substring pro-point (point)) |
5979 |
|
match-string)) |
5980 |
(setq cw 'procedure cw-class pro-class cw-point pro-point |
(setq cw 'procedure cw-class pro-class cw-point pro-point |
5981 |
cw-arrow pro-arrow)) |
cw-arrow pro-arrow)) |
5982 |
((string-match "\\`[ \t]*\\(pro\\|function\\)\\>" |
((string-match "\\`[ \t]*\\(pro\\|function\\)\\>" |
5983 |
(buffer-substring bos (point))) |
match-string) |
5984 |
nil) |
nil) |
5985 |
((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'" |
((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'" |
5986 |
(buffer-substring bos (point))) |
match-string) |
5987 |
(setq cw 'class)) |
(setq cw 'class)) |
5988 |
((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'" |
((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'" |
5989 |
(buffer-substring bos (point))) |
match-string) |
5990 |
(setq cw 'class)) |
(setq cw 'class)) |
5991 |
((and func |
((and func |
5992 |
(> func-point pro-point) |
(> func-point pro-point) |
5993 |
(= func-level 1) |
(= func-level 1) |
5994 |
(memq last-char '(?\( ?,))) |
(memq last-char '(?\( ?,))) |
6006 |
(t |
(t |
6007 |
(setq cw 'function) |
(setq cw 'function) |
6008 |
(save-excursion |
(save-excursion |
6009 |
(if (re-search-backward "->[ \t]*\\(\\([$a-zA-Z0-9_]+\\)::\\)?[$a-zA-Z0-9_]*\\=" bos t) |
(if (re-search-backward "->[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\s-*\\)?\\(\\([$a-zA-Z0-9_]+\\)::\\)?[$a-zA-Z0-9_]*\\=" bos t) |
6010 |
(setq cw-arrow (copy-marker (match-beginning 0)) |
(setq cw-arrow (copy-marker (match-beginning 0)) |
6011 |
cw-class (if (match-end 2) |
cw-class (if (match-end 4) |
6012 |
(idlwave-sintern-class (match-string 2)) |
(idlwave-sintern-class (match-string 4)) |
6013 |
t)))))) |
t)))))) |
6014 |
(list (list pro pro-point pro-class pro-arrow) |
(list (list pro pro-point pro-class pro-arrow) |
6015 |
(list func func-point func-class func-arrow) |
(list func func-point func-class func-arrow) |
6019 |
|
|
6020 |
(defun idlwave-this-word (&optional class) |
(defun idlwave-this-word (&optional class) |
6021 |
;; Grab the word around point. CLASS is for the `skip-chars=...' functions |
;; Grab the word around point. CLASS is for the `skip-chars=...' functions |
6022 |
(setq class (or class "a-zA-Z0-9$_")) |
(setq class (or class "a-zA-Z0-9$_.")) |
6023 |
(save-excursion |
(save-excursion |
6024 |
(buffer-substring-no-properties |
(buffer-substring |
6025 |
(progn (skip-chars-backward class) (point)) |
(progn (skip-chars-backward class) (point)) |
6026 |
(progn (skip-chars-forward class) (point))))) |
(progn (skip-chars-forward class) (point))))) |
6027 |
|
|
6034 |
;; searches to this point. |
;; searches to this point. |
6035 |
|
|
6036 |
(catch 'exit |
(catch 'exit |
6037 |
(let (pos |
(let (pos |
6038 |
func-point |
func-point |
6039 |
(cnt 0) |
(cnt 0) |
6040 |
func arrow-start class) |
func arrow-start class) |
6049 |
(setq pos (point)) |
(setq pos (point)) |
6050 |
(incf cnt) |
(incf cnt) |
6051 |
(when (and (= (following-char) ?\() |
(when (and (= (following-char) ?\() |
6052 |
(re-search-backward |
(re-search-backward |
6053 |
"\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" |
"\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" |
6054 |
bound t)) |
bound t)) |
6055 |
(setq func (match-string 2) |
(setq func (match-string 2) |
6056 |
func-point (goto-char (match-beginning 2)) |
func-point (goto-char (match-beginning 2)) |
6057 |
pos func-point) |
pos func-point) |
6058 |
(if (re-search-backward |
(if (re-search-backward |
6059 |
"->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) |
"->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) |
6060 |
(setq arrow-start (copy-marker (match-beginning 0)) |
(setq arrow-start (copy-marker (match-beginning 0)) |
6061 |
class (or (match-string 2) t))) |
class (or (match-string 2) t))) |
6062 |
(throw |
(throw |
6063 |
'exit |
'exit |
6064 |
(list |
(list |
6065 |
(idlwave-sintern-routine-or-method func class) |
(idlwave-sintern-routine-or-method func class) |
6066 |
(idlwave-sintern-class class) |
(idlwave-sintern-class class) |
6076 |
;; searches to this point. |
;; searches to this point. |
6077 |
(let ((pos (point)) pro-point |
(let ((pos (point)) pro-point |
6078 |
pro class arrow-start string) |
pro class arrow-start string) |
6079 |
(save-excursion |
(save-excursion |
6080 |
;;(idlwave-beginning-of-statement) |
;;(idlwave-beginning-of-statement) |
6081 |
(idlwave-start-of-substatement 'pre) |
(idlwave-start-of-substatement 'pre) |
6082 |
(setq string (buffer-substring (point) pos)) |
(setq string (buffer-substring (point) pos)) |
6083 |
(if (string-match |
(if (string-match |
6084 |
"\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) |
"\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) |
6085 |
(setq pro (match-string 1 string) |
(setq pro (match-string 1 string) |
6086 |
pro-point (+ (point) (match-beginning 1))) |
pro-point (+ (point) (match-beginning 1))) |
6087 |
(if (and (idlwave-skip-object) |
(if (and (idlwave-skip-object) |
6088 |
(setq string (buffer-substring (point) pos)) |
(setq string (buffer-substring (point) pos)) |
6089 |
(string-match |
(string-match |
6090 |
"\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\'\\)" string)) |
"\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" |
6091 |
|
string)) |
6092 |
(setq pro (if (match-beginning 4) |
(setq pro (if (match-beginning 4) |
6093 |
(match-string 4 string)) |
(match-string 4 string)) |
6094 |
pro-point (if (match-beginning 4) |
pro-point (if (match-beginning 4) |
6131 |
(throw 'exit nil)))) |
(throw 'exit nil)))) |
6132 |
(goto-char pos) |
(goto-char pos) |
6133 |
nil))) |
nil))) |
6134 |
|
|
6135 |
(defun idlwave-last-valid-char () |
(defun idlwave-last-valid-char () |
6136 |
"Return the last character before point which is not white or a comment |
"Return the last character before point which is not white or a comment |
6137 |
and also not part of the current identifier. Since we do this in |
and also not part of the current identifier. Since we do this in |
6166 |
"A mark pointing to the beginning of the completion string.") |
"A mark pointing to the beginning of the completion string.") |
6167 |
|
|
6168 |
(defun idlwave-complete-in-buffer (type stype list selector prompt isa |
(defun idlwave-complete-in-buffer (type stype list selector prompt isa |
6169 |
&optional prepare-display-function) |
&optional prepare-display-function |
6170 |
|
special-selector) |
6171 |
"Perform TYPE completion of word before point against LIST. |
"Perform TYPE completion of word before point against LIST. |
6172 |
SELECTOR is the PREDICATE argument for the completion function. Show |
SELECTOR is the PREDICATE argument for the completion function. Show |
6173 |
PROMPT in echo area. TYPE is one of 'function, 'procedure, |
PROMPT in echo area. TYPE is one of the intern types, e.g. 'function, |
6174 |
'class-tag, or 'keyword." |
'procedure, 'class-tag, 'keyword, 'sysvar, etc.. SPECIAL-SELECTOR is |
6175 |
|
used only once, for `all-completions', and can be used to, e.g., |
6176 |
|
accumulate information on matching completions." |
6177 |
(let* ((completion-ignore-case t) |
(let* ((completion-ignore-case t) |
6178 |
beg (end (point)) slash part spart completion all-completions |
beg (end (point)) slash part spart completion all-completions |
6179 |
dpart dcompletion) |
dpart dcompletion) |
6198 |
dpart (downcase part) |
dpart (downcase part) |
6199 |
spart (idlwave-sintern stype part) |
spart (idlwave-sintern stype part) |
6200 |
completion (try-completion part list selector) |
completion (try-completion part list selector) |
6201 |
dcompletion (if (stringp completion) (downcase completion))) |
dcompletion (if (stringp completion) (downcase completion)) |
6202 |
|
idlwave-completion-help-links nil) |
6203 |
(cond |
(cond |
6204 |
((null completion) |
((null completion) |
6205 |
;; nothing available. |
;; nothing available. |
6219 |
(idlwave-after-successful-completion type slash beg)) |
(idlwave-after-successful-completion type slash beg)) |
6220 |
t) |
t) |
6221 |
((or (eq completion t) |
((or (eq completion t) |
6222 |
(and (equal dpart dcompletion) |
(and (= 1 (length (setq all-completions |
|
(= 1 (length (setq all-completions |
|
6223 |
(idlwave-uniquify |
(idlwave-uniquify |
6224 |
(all-completions part list selector))))))) |
(all-completions part list |
6225 |
|
(or special-selector |
6226 |
|
selector)))))) |
6227 |
|
(equal dpart dcompletion))) |
6228 |
;; This is already complete |
;; This is already complete |
6229 |
(idlwave-after-successful-completion type slash beg) |
(idlwave-after-successful-completion type slash beg) |
6230 |
(message "%s is already the complete %s" part isa) |
(message "%s is already the complete %s" part isa) |
6231 |
nil) |
nil) |
6232 |
(t |
(t |
6233 |
;; We cannot add something - offer a list. |
;; We cannot add something - offer a list. |
6234 |
(message "Making completion list...") |
(message "Making completion list...") |
6235 |
|
|
6236 |
|
(unless idlwave-completion-help-links ; already set somewhere? |
6237 |
|
(mapcar (lambda (x) ; Pass link prop through to highlight-linked |
6238 |
|
(let ((link (get-text-property 0 'link (car x)))) |
6239 |
|
(if link |
6240 |
|
(push (cons (car x) link) |
6241 |
|
idlwave-completion-help-links)))) |
6242 |
|
list)) |
6243 |
(let* ((list all-completions) |
(let* ((list all-completions) |
6244 |
;; "complete" means, this is already a valid completion |
;; "complete" means, this is already a valid completion |
6245 |
(complete (memq spart all-completions)) |
(complete (memq spart all-completions)) |
6246 |
(completion-highlight-first-word-only t) ; XEmacs |
(completion-highlight-first-word-only t)) ; XEmacs |
6247 |
(completion-fixup-function ; Emacs |
; (completion-fixup-function ; Emacs |
6248 |
(lambda () (and (eq (preceding-char) ?>) |
; (lambda () (and (eq (preceding-char) ?>) |
6249 |
(re-search-backward " <" beg t))))) |
; (re-search-backward " <" beg t))))) |
6250 |
|
|
6251 |
(setq list (sort list (lambda (a b) |
(setq list (sort list (lambda (a b) |
6252 |
(string< (downcase a) (downcase b))))) |
(string< (downcase a) (downcase b))))) |
6253 |
(if prepare-display-function |
(if prepare-display-function |
6257 |
idlwave-complete-empty-string-as-lower-case) |
idlwave-complete-empty-string-as-lower-case) |
6258 |
(not idlwave-completion-force-default-case)) |
(not idlwave-completion-force-default-case)) |
6259 |
(setq list (mapcar (lambda (x) |
(setq list (mapcar (lambda (x) |
6260 |
(if (listp x) |
(if (listp x) |
6261 |
(setcar x (downcase (car x))) |
(setcar x (downcase (car x))) |
6262 |
(setq x (downcase x))) |
(setq x (downcase x))) |
6263 |
x) |
x) |
6277 |
(re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" |
(re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" |
6278 |
(- (point) 15) t) |
(- (point) 15) t) |
6279 |
(goto-char (point-min)) |
(goto-char (point-min)) |
6280 |
(re-search-forward |
(re-search-forward |
6281 |
"^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) |
"^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) |
6282 |
;; Yank the full class specification |
;; Yank the full class specification |
6283 |
(insert (match-string 2)) |
(insert (match-string 2)) |
6284 |
;; Do the completion |
;; Do the completion, using list gathered from `idlwave-routines' |
6285 |
(idlwave-complete-in-buffer 'class 'class (idlwave-class-alist) nil |
(idlwave-complete-in-buffer |
6286 |
"Select a class" "class"))) |
'class 'class (idlwave-class-alist) nil |
6287 |
|
"Select a class" "class" |
6288 |
|
'(lambda (list) ;; Push it to help-links if system help available |
6289 |
|
(mapcar (lambda (x) |
6290 |
|
(let* ((entry (idlwave-class-info x)) |
6291 |
|
(link (nth 1 (assq 'link entry)))) |
6292 |
|
(if link (push (cons x link) |
6293 |
|
idlwave-completion-help-links)) |
6294 |
|
x)) |
6295 |
|
list))))) |
6296 |
|
|
6297 |
(defun idlwave-attach-classes (list type show-classes) |
(defun idlwave-attach-classes (list type show-classes) |
6298 |
;; Attach the proper class list to a LIST of completion items. |
;; Attach the proper class list to a LIST of completion items. |
6301 |
;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. |
;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. |
6302 |
(if (or (null show-classes) ; don't want to see classes |
(if (or (null show-classes) ; don't want to see classes |
6303 |
(null class-selector) ; not a method call |
(null class-selector) ; not a method call |
6304 |
(and |
(and |
6305 |
(stringp class-selector) ; the class is already known |
(stringp class-selector) ; the class is already known |
6306 |
(not super-classes))) ; no possibilities for inheritance |
(not super-classes))) ; no possibilities for inheritance |
6307 |
;; In these cases, we do not have to do anything |
;; In these cases, we do not have to do anything |
6316 |
(max (abs show-classes)) |
(max (abs show-classes)) |
6317 |
(lmax (if do-dots (apply 'max (mapcar 'length list)))) |
(lmax (if do-dots (apply 'max (mapcar 'length list)))) |
6318 |
classes nclasses class-info space) |
classes nclasses class-info space) |
6319 |
(mapcar |
(mapcar |
6320 |
(lambda (x) |
(lambda (x) |
6321 |
;; get the classes |
;; get the classes |
6322 |
(if (eq type 'class-tag) |
(if (eq type 'class-tag) |
6323 |
;; Just one class for tags |
;; Just one class for tags |
6324 |
(setq classes |
(setq classes |
6325 |
(list |
(list |
6326 |
(idlwave-class-or-superclass-with-tag class-selector x))) |
(idlwave-class-or-superclass-with-tag class-selector x))) |
6327 |
;; Multiple classes for method of method-keyword |
;; Multiple classes for method or method-keyword |
6328 |
(setq classes |
(setq classes |
6329 |
(if (eq type 'kwd) |
(if (eq type 'kwd) |
6330 |
(idlwave-all-method-keyword-classes |
(idlwave-all-method-keyword-classes |
6331 |
method-selector x type-selector) |
method-selector x type-selector) |
6332 |
(idlwave-all-method-classes x type-selector))) |
(idlwave-all-method-classes x type-selector))) |
6333 |
(if inherit |
(if inherit |
6334 |
(setq classes |
(setq classes |
6335 |
(delq nil |
(delq nil |
6336 |
(mapcar (lambda (x) (if (memq x inherit) x nil)) |
(mapcar (lambda (x) (if (memq x inherit) x nil)) |
6337 |
classes))))) |
classes))))) |
6352 |
;; We do want properties |
;; We do want properties |
6353 |
(setq x (copy-sequence x)) |
(setq x (copy-sequence x)) |
6354 |
(put-text-property 0 (length x) |
(put-text-property 0 (length x) |
6355 |
'help-echo (mapconcat 'identity classes " ") |
'help-echo (mapconcat 'identity classes " ") |
6356 |
x)) |
x)) |
6357 |
(if class-info |
(if class-info |
6358 |
(list x class-info) |
(list x class-info) |
6359 |
x)) |
x)) |
6368 |
(defun idlwave-attach-class-tag-classes (list) |
(defun idlwave-attach-class-tag-classes (list) |
6369 |
;; Call idlwave-attach-classes with class structure tags |
;; Call idlwave-attach-classes with class structure tags |
6370 |
(idlwave-attach-classes list 'class-tag idlwave-completion-show-classes)) |
(idlwave-attach-classes list 'class-tag idlwave-completion-show-classes)) |
6371 |
|
|
6372 |
|
|
6373 |
;;---------------------------------------------------------------------- |
;;---------------------------------------------------------------------- |
6374 |
;;---------------------------------------------------------------------- |
;;---------------------------------------------------------------------- |
6389 |
((= 1 (length list)) |
((= 1 (length list)) |
6390 |
(setq rtn (car list))) |
(setq rtn (car list))) |
6391 |
((featurep 'xemacs) |
((featurep 'xemacs) |
6392 |
(if sort (setq list (sort list (lambda (a b) |
(if sort (setq list (sort list (lambda (a b) |
6393 |
(string< (upcase a) (upcase b)))))) |
(string< (upcase a) (upcase b)))))) |
6394 |
(setq menu |
(setq menu |
6395 |
(append (list title) |
(append (list title) |
6400 |
(setq resp (get-popup-menu-response menu)) |
(setq resp (get-popup-menu-response menu)) |
6401 |
(funcall (event-function resp) (event-object resp))) |
(funcall (event-function resp) (event-object resp))) |
6402 |
(t |
(t |
6403 |
(if sort (setq list (sort list (lambda (a b) |
(if sort (setq list (sort list (lambda (a b) |
6404 |
(string< (upcase a) (upcase b)))))) |
(string< (upcase a) (upcase b)))))) |
6405 |
(setq menu (cons title |
(setq menu (cons title |
6406 |
(list |
(list |
6491 |
(setq idlwave-before-completion-wconf (current-window-configuration))) |
(setq idlwave-before-completion-wconf (current-window-configuration))) |
6492 |
|
|
6493 |
(if (featurep 'xemacs) |
(if (featurep 'xemacs) |
6494 |
(idlwave-display-completion-list-xemacs |
(idlwave-display-completion-list-xemacs |
6495 |
list) |
list) |
6496 |
(idlwave-display-completion-list-emacs list)) |
(idlwave-display-completion-list-emacs list)) |
6497 |
|
|
6520 |
(if (and (eq major-mode 'idlwave-shell-mode) |
(if (and (eq major-mode 'idlwave-shell-mode) |
6521 |
(boundp 'font-lock-mode) |
(boundp 'font-lock-mode) |
6522 |
(not font-lock-mode)) |
(not font-lock-mode)) |
6523 |
;; Remove the fontification of the word before point |
;; For the shell, remove the fontification of the word before point |
6524 |
(let ((beg (save-excursion |
(let ((beg (save-excursion |
6525 |
(skip-chars-backward "a-zA-Z0-9_") |
(skip-chars-backward "a-zA-Z0-9_") |
6526 |
(point)))) |
(point)))) |
6540 |
idlwave-before-completion-wconf |
idlwave-before-completion-wconf |
6541 |
(set-window-configuration idlwave-before-completion-wconf))) |
(set-window-configuration idlwave-before-completion-wconf))) |
6542 |
|
|
6543 |
|
(defun idlwave-one-key-select (sym prompt delay) |
6544 |
|
"Make the user select an element from the alist in the variable SYM. |
6545 |
|
The keys of the alist are expected to be strings. The function returns the |
6546 |
|
car of the selected association. |
6547 |
|
To do this, PROMPT is displayed and and the user must hit a letter key to |
6548 |
|
select an entry. If the user does not reply within DELAY seconds, a help |
6549 |
|
window with the options is displayed automatically. |
6550 |
|
The key which is associated with each option is generated automatically. |
6551 |
|
First, the strings are checked for preselected keys, like in \"[P]rint\". |
6552 |
|
If these don't exist, a letter in the string is automatically selected." |
6553 |
|
(let* ((alist (symbol-value sym)) |
6554 |
|
(temp-buffer-show-hook (if (fboundp 'fit-window-to-buffer) |
6555 |
|
'(fit-window-to-buffer))) |
6556 |
|
keys-alist char) |
6557 |
|
;; First check the cache |
6558 |
|
(if (and (eq (symbol-value sym) (get sym :one-key-alist-last))) |
6559 |
|
(setq keys-alist (get sym :one-key-alist-cache)) |
6560 |
|
;; Need to make new list |
6561 |
|
(setq keys-alist (idlwave-make-one-key-alist alist)) |
6562 |
|
(put sym :one-key-alist-cache keys-alist) |
6563 |
|
(put sym :one-key-alist-last alist)) |
6564 |
|
;; Display prompt and wait for quick reply |
6565 |
|
(message "%s[%s]" prompt |
6566 |
|
(mapconcat (lambda(x) (char-to-string (car x))) |
6567 |
|
keys-alist "")) |
6568 |
|
(if (sit-for delay) |
6569 |
|
;; No quick reply: Show help |
6570 |
|
(save-window-excursion |
6571 |
|
(with-output-to-temp-buffer "*Completions*" |
6572 |
|
(mapcar (lambda(x) |
6573 |
|
(princ (nth 1 x)) |
6574 |
|
(princ "\n")) |
6575 |
|
keys-alist)) |
6576 |
|
(setq char (read-char))) |
6577 |
|
(setq char (read-char))) |
6578 |
|
(message nil) |
6579 |
|
;; Return the selected result |
6580 |
|
(nth 2 (assoc char keys-alist)))) |
6581 |
|
|
6582 |
|
;; Used for, e.g., electric debug super-examine. |
6583 |
|
(defun idlwave-make-one-key-alist (alist) |
6584 |
|
"Make an alist for single key selection." |
6585 |
|
(let ((l alist) keys-alist name start char help |
6586 |
|
(cnt 0) |
6587 |
|
(case-fold-search nil)) |
6588 |
|
(while l |
6589 |
|
(setq name (car (car l)) |
6590 |
|
l (cdr l)) |
6591 |
|
(catch 'exit |
6592 |
|
;; First check if the configuration predetermined a key |
6593 |
|
(if (string-match "\\[\\(.\\)\\]" name) |
6594 |
|
(progn |
6595 |
|
(setq char (string-to-char (downcase (match-string 1 name))) |
6596 |
|
help (format "%c: %s" char name) |
6597 |
|
keys-alist (cons (list char help name) keys-alist)) |
6598 |
|
(throw 'exit t))) |
6599 |
|
;; Then check for capital letters |
6600 |
|
(setq start 0) |
6601 |
|
(while (string-match "[A-Z]" name start) |
6602 |
|
(setq start (match-end 0) |
6603 |
|
char (string-to-char (downcase (match-string 0 name)))) |
6604 |
|
(if (not (assoc char keys-alist)) |
6605 |
|
(progn |
6606 |
|
(setq help (format "%c: %s" char |
6607 |
|
(replace-match |
6608 |
|
(concat "[" (match-string 0 name) "]") |
6609 |
|
t t name)) |
6610 |
|
keys-alist (cons (list char help name) keys-alist)) |
6611 |
|
(throw 'exit t)))) |
6612 |
|
;; Now check for lowercase letters |
6613 |
|
(setq start 0) |
6614 |
|
(while (string-match "[a-z]" name start) |
6615 |
|
(setq start (match-end 0) |
6616 |
|
char (string-to-char (match-string 0 name))) |
6617 |
|
(if (not (assoc char keys-alist)) |
6618 |
|
(progn |
6619 |
|
(setq help (format "%c: %s" char |
6620 |
|
(replace-match |
6621 |
|
(concat "[" (match-string 0 name) "]") |
6622 |
|
t t name)) |
6623 |
|
keys-alist (cons (list char help name) keys-alist)) |
6624 |
|
(throw 'exit t)))) |
6625 |
|
;; Bummer, nothing found! Use a stupid number |
6626 |
|
(setq char (string-to-char (int-to-string (setq cnt (1+ cnt)))) |
6627 |
|
help (format "%c: %s" char name) |
6628 |
|
keys-alist (cons (list char help name) keys-alist)))) |
6629 |
|
(nreverse keys-alist))) |
6630 |
|
|
6631 |
(defun idlwave-set-local (var value &optional buffer) |
(defun idlwave-set-local (var value &optional buffer) |
6632 |
"Set the buffer-local value of VAR in BUFFER to VALUE." |
"Set the buffer-local value of VAR in BUFFER to VALUE." |
6633 |
(save-excursion |
(save-excursion |
6692 |
(defun idlwave-make-modified-completion-map-emacs (old-map) |
(defun idlwave-make-modified-completion-map-emacs (old-map) |
6693 |
"Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." |
"Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." |
6694 |
(let ((new-map (copy-keymap old-map))) |
(let ((new-map (copy-keymap old-map))) |
6695 |
(substitute-key-definition |
(substitute-key-definition |
6696 |
'choose-completion 'idlwave-choose-completion new-map) |
'choose-completion 'idlwave-choose-completion new-map) |
6697 |
(substitute-key-definition |
(substitute-key-definition |
6698 |
'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) |
'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) |
6713 |
;;---------------------------------------------------------------------- |
;;---------------------------------------------------------------------- |
6714 |
|
|
6715 |
;;; ------------------------------------------------------------------------ |
;;; ------------------------------------------------------------------------ |
6716 |
;;; Sturucture parsing code, and code to manage class info |
;;; Stucture parsing code, and code to manage class info |
6717 |
|
|
6718 |
;; |
;; |
6719 |
;; - Go again over the documentation how to write a completion |
;; - Go again over the documentation how to write a completion |
6720 |
;; plugin. It is in self.el, but currently still very bad. |
;; plugin. It is in self.el, but currently still very bad. |
6721 |
;; This could be in a separate file in the distribution, or |
;; This could be in a separate file in the distribution, or |
6722 |
;; in an appendix for the manual. |
;; in an appendix for the manual. |
6723 |
|
|
6724 |
|
(defvar idlwave-struct-skip |
6725 |
|
"[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*" |
6726 |
|
"Regexp for skipping continued blank or comment-only lines in |
6727 |
|
structures") |
6728 |
|
|
6729 |
|
(defvar idlwave-struct-tag-regexp |
6730 |
|
(concat "[{,]" ;leading comma/brace |
6731 |
|
idlwave-struct-skip ; 4 groups |
6732 |
|
"\\([a-zA-Z][a-zA-Z0-9_]*\\)" ;the tag itself, group 5 |
6733 |
|
"[ \t]*:") ; the final colon |
6734 |
|
"Regexp for structure tags.") |
6735 |
|
|
6736 |
(defun idlwave-struct-tags () |
(defun idlwave-struct-tags () |
6737 |
"Return a list of all tags in the structure defined at point. |
"Return a list of all tags in the structure defined at point. |
6742 |
(end (cdr borders)) |
(end (cdr borders)) |
6743 |
tags) |
tags) |
6744 |
(goto-char beg) |
(goto-char beg) |
6745 |
(while (re-search-forward "[{,][ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*[ \t]*\\)?\\([a-zA-Z][a-zA-Z0-9_]*\\)[ \t]*:" end t) |
(save-restriction |
6746 |
;; Check if we are still on the top level of the structure. |
(narrow-to-region beg end) |
6747 |
(if (and (condition-case nil (progn (up-list -1) t) (error nil)) |
(while (re-search-forward idlwave-struct-tag-regexp end t) |
6748 |
(= (point) beg)) |
;; Check if we are still on the top level of the structure. |
6749 |
(push (match-string 5) tags)) |
(if (and (condition-case nil (progn (up-list -1) t) (error nil)) |
6750 |
(goto-char (match-end 0))) |
(= (point) beg)) |
6751 |
(nreverse tags)))) |
(push (match-string-no-properties 5) tags)) |
6752 |
|
(goto-char (match-end 0)))) |
6753 |
|
(nreverse tags)))) |
6754 |
|
|
6755 |
(defun idlwave-find-struct-tag (tag) |
(defun idlwave-find-struct-tag (tag) |
6756 |
"Find a given TAG in the structure defined at point." |
"Find a given TAG in the structure defined at point." |
6758 |
(beg (car borders)) |
(beg (car borders)) |
6759 |
(end (cdr borders)) |
(end (cdr borders)) |
6760 |
(case-fold-search t)) |
(case-fold-search t)) |
6761 |
(re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") |
(re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") |
6762 |
end t))) |
end t))) |
6763 |
|
|
6764 |
(defun idlwave-struct-inherits () |
(defun idlwave-struct-inherits () |
6771 |
(case-fold-search t) |
(case-fold-search t) |
6772 |
names) |
names) |
6773 |
(goto-char beg) |
(goto-char beg) |
6774 |
(while (re-search-forward "[{,][ \t]*\\(\\$.*\n[ \t]*\\)?inherits[ \t]*\\(\\$.*\n[ \t]*\\)?\\([a-zA-Z][a-zA-Z0-9_]*\\)" end t) |
(save-restriction |
6775 |
;; Check if we are still on the top level of the structure. |
(narrow-to-region beg end) |
6776 |
(if (and (condition-case nil (progn (up-list -1) t) (error nil)) |
(while (re-search-forward |
6777 |
(= (point) beg)) |
(concat "[{,]" ;leading comma/brace |
6778 |
(push (match-string 3) names)) |
idlwave-struct-skip ; 4 groups |
6779 |
(goto-char (match-end 0))) |
"inherits" ; The INHERITS tag |
6780 |
|
idlwave-struct-skip ; 4 more |
6781 |
|
"\\([a-zA-Z][a-zA-Z0-9_]*\\)") ; The super-group, #9 |
6782 |
|
end t) |
6783 |
|
;; Check if we are still on the top level of the structure. |
6784 |
|
(if (and (condition-case nil (progn (up-list -1) t) (error nil)) |
6785 |
|
(= (point) beg)) |
6786 |
|
(push (match-string-no-properties 9) names)) |
6787 |
|
(goto-char (match-end 0)))) |
6788 |
(nreverse names)))) |
(nreverse names)))) |
6789 |
|
|
6790 |
(defun idlwave-in-structure () |
(defun idlwave-in-structure () |
6791 |
"Return t if point is inside an IDL structure." |
"Return t if point is inside an IDL structure definition." |
6792 |
(let ((beg (point))) |
(let ((beg (point))) |
6793 |
(save-excursion |
(save-excursion |
6794 |
(if (not (or (idlwave-in-comment) (idlwave-in-quote))) |
(if (not (or (idlwave-in-comment) (idlwave-in-quote))) |
6808 |
(cons beg (point))))) |
(cons beg (point))))) |
6809 |
|
|
6810 |
(defun idlwave-find-structure-definition (&optional var name bound) |
(defun idlwave-find-structure-definition (&optional var name bound) |
6811 |
"Search forward for a structure definition. |
"Search forward for a structure definition. If VAR is non-nil, |
6812 |
If VAR is non-nil, search for a structure assigned to variable VAR. |
search for a structure assigned to variable VAR. If NAME is non-nil, |
6813 |
If NAME is non-nil, search for a named structure NAME. If BOUND is an |
search for a named structure NAME, if a string, or a generic named |
6814 |
integer, limit the search. If BOUND is the symbol `all', we search |
structure otherwise. If BOUND is an integer, limit the search. If |
6815 |
first back and then forward through the entire file. If BOUND is the |
BOUND is the symbol `all', we search first back and then forward |
6816 |
symbol `back' we search only backward." |
through the entire file. If BOUND is the symbol `back' we search only |
6817 |
|
backward." |
6818 |
(let* ((ws "[ \t]*\\(\\$.*\n[ \t]*\\)*") |
(let* ((ws "[ \t]*\\(\\$.*\n[ \t]*\\)*") |
6819 |
(case-fold-search t) |
(case-fold-search t) |
6820 |
(lim (if (integerp bound) bound nil)) |
(lim (if (integerp bound) bound nil)) |
6823 |
(concat "\\<" (regexp-quote (downcase var)) "\\>" ws) |
(concat "\\<" (regexp-quote (downcase var)) "\\>" ws) |
6824 |
"\\(\\)") |
"\\(\\)") |
6825 |
"=" ws "\\({\\)" |
"=" ws "\\({\\)" |
6826 |
(if name (concat ws "\\<" (downcase name) "[^a-zA-Z0-9_$]") "")))) |
(if name |
6827 |
|
(if (stringp name) |
6828 |
|
(concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") |
6829 |
|
;; Just a generic name |
6830 |
|
(concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ",")) |
6831 |
|
"")))) |
6832 |
(if (or (and (or (eq bound 'all) (eq bound 'back)) |
(if (or (and (or (eq bound 'all) (eq bound 'back)) |
6833 |
(re-search-backward re nil t)) |
(re-search-backward re nil t)) |
6834 |
(and (not (eq bound 'back)) (re-search-forward re lim t))) |
(and (not (eq bound 'back)) (re-search-forward re lim t))) |
6835 |
(goto-char (match-beginning 3))))) |
(progn |
6836 |
|
(goto-char (match-beginning 3)) |
6837 |
|
(match-string-no-properties 5))))) |
6838 |
|
|
6839 |
|
(defvar idlwave-class-info nil) |
6840 |
|
(defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo |
6841 |
|
(defvar idlwave-class-reset nil) ; to reset buffer-local classes |
6842 |
|
|
|
(defvar idlwave-class-info nil) |
|
|
(defvar idlwave-system-class-info nil) |
|
6843 |
(add-hook 'idlwave-update-rinfo-hook |
(add-hook 'idlwave-update-rinfo-hook |
6844 |
(lambda () (setq idlwave-class-info nil))) |
(lambda () (setq idlwave-class-reset t))) |
6845 |
(add-hook 'idlwave-after-load-rinfo-hook |
(add-hook 'idlwave-after-load-rinfo-hook |
6846 |
(lambda () (setq idlwave-class-info nil))) |
(lambda () (setq idlwave-class-info nil))) |
6847 |
|
|
6848 |
(defun idlwave-class-info (class) |
(defun idlwave-class-info (class) |
6849 |
(let (list entry) |
(let (list entry) |
6850 |
(unless idlwave-class-info |
(if idlwave-class-info |
6851 |
;; Info is nil, put in the system stuff. |
(if idlwave-class-reset |
6852 |
|
(setq |
6853 |
|
idlwave-class-reset nil |
6854 |
|
idlwave-class-info ; Remove any visited in a buffer |
6855 |
|
(delq nil (mapcar |
6856 |
|
(lambda (x) |
6857 |
|
(let ((filebuf |
6858 |
|
(idlwave-class-file-or-buffer |
6859 |
|
(or (cdr (assq 'found-in x)) (car x))))) |
6860 |
|
(if (cdr filebuf) |
6861 |
|
nil |
6862 |
|
x))) |
6863 |
|
idlwave-class-info)))) |
6864 |
|
;; Info is nil, put in the system stuff to start. |
6865 |
(setq idlwave-class-info idlwave-system-class-info) |
(setq idlwave-class-info idlwave-system-class-info) |
6866 |
(setq list idlwave-class-info) |
(setq list idlwave-class-info) |
6867 |
(while (setq entry (pop list)) |
(while (setq entry (pop list)) |
6868 |
(idlwave-sintern-class-info entry))) |
(idlwave-sintern-class-info entry))) |
6869 |
(setq class (idlwave-sintern-class class)) |
(setq class (idlwave-sintern-class class)) |
6870 |
(setq entry (assq class idlwave-class-info)) |
(or (assq class idlwave-class-info) |
6871 |
(unless entry |
(progn (idlwave-scan-class-info class) |
6872 |
(setq entry (idlwave-find-class-info class)) |
(assq class idlwave-class-info))))) |
|
(when entry |
|
|
;; Sintern and cache the info |
|
|
(idlwave-sintern-class-info entry) |
|
|
(push entry idlwave-class-info))) |
|
|
entry)) |
|
6873 |
|
|
6874 |
(defun idlwave-sintern-class-info (entry) |
(defun idlwave-sintern-class-info (entry) |
6875 |
"Sintern the class names in a class-info entry." |
"Sintern the class names in a class-info entry." |
6880 |
(setcdr inherits (mapcar (lambda (x) (idlwave-sintern-class x 'set)) |
(setcdr inherits (mapcar (lambda (x) (idlwave-sintern-class x 'set)) |
6881 |
(cdr inherits)))))) |
(cdr inherits)))))) |
6882 |
|
|
6883 |
(defun idlwave-find-class-definition (class) |
(defun idlwave-find-class-definition (class &optional all-hook alt-class) |
6884 |
(let ((case-fold-search t)) |
"Find class structure definition(s) |
6885 |
(if (re-search-forward |
If ALL-HOOK is set, find all named structure definitions in a given |
6886 |
(concat "^[ \t]*pro[ \t]+" (downcase class) "__define" "\\>") nil t) |
class__define routine, on which ALL-HOOK will be run. If ALT-CLASS is |
6887 |
;; FIXME: should we limit to end of pro here? |
set, look for the name__define pro, and inside of it, for the ALT-CLASS |
6888 |
(idlwave-find-structure-definition nil class)))) |
class/struct definition" |
6889 |
|
(let ((case-fold-search t) end-lim list name) |
6890 |
|
(when (re-search-forward |
6891 |
|
(concat "^[ \t]*pro[ \t]+" (downcase class) "__define" "\\>") nil t) |
6892 |
|
(if all-hook |
6893 |
|
(progn |
6894 |
|
;; For everything there |
6895 |
|
(setq end-lim (save-excursion (idlwave-end-of-subprogram) (point))) |
6896 |
|
(while (setq name |
6897 |
|
(idlwave-find-structure-definition nil t end-lim)) |
6898 |
|
(funcall all-hook name))) |
6899 |
|
(idlwave-find-structure-definition nil (or alt-class class)))))) |
6900 |
|
|
6901 |
|
|
6902 |
(defun idlwave-find-class-info (class) |
(defun idlwave-class-file-or-buffer (class) |
6903 |
"Find the __define procedure for a class structure and return info entry." |
"Find buffer visiting CLASS definition" |
6904 |
(let* ((pro (concat (downcase class) "__define")) |
(let* ((pro (concat (downcase class) "__define")) |
6905 |
(class (idlwave-sintern-class class)) |
(file (idlwave-routine-source-file |
6906 |
(idlwave-auto-routine-info-updates nil) |
(nth 3 (idlwave-rinfo-assoc pro 'pro nil |
6907 |
(file (cdr (nth 3 (idlwave-rinfo-assoc pro 'pro nil |
(idlwave-routines)))))) |
6908 |
(idlwave-routines))))) |
(cons file (if file (idlwave-get-buffer-visiting file))))) |
6909 |
buf) |
|
6910 |
(if (or (not file) |
|
6911 |
(not (file-regular-p |
(defun idlwave-scan-class-info (class) |
6912 |
(setq file (idlwave-expand-lib-file-name file))))) |
"Scan all class and named structure info in the class__define pro" |
6913 |
nil ; Cannot get info |
(let* ((idlwave-auto-routine-info-updates nil) |
6914 |
|
(filebuf (idlwave-class-file-or-buffer class)) |
6915 |
|
(file (car filebuf)) |
6916 |
|
(buf (cdr filebuf)) |
6917 |
|
(class (idlwave-sintern-class class))) |
6918 |
|
(if (or |
6919 |
|
(not file) |
6920 |
|
(and ;; neither a regular file nor a visited buffer |
6921 |
|
(not buf) |
6922 |
|
(not (file-regular-p file)))) |
6923 |
|
nil ; Cannot find the file/buffer to get any info |
6924 |
(save-excursion |
(save-excursion |
6925 |
(if (setq buf (idlwave-get-buffer-visiting file)) |
(if buf (set-buffer buf) |
6926 |
(set-buffer buf) |
;; Read the file in temporarily |
6927 |
(set-buffer (get-buffer-create " *IDLWAVE-tmp*")) |
(set-buffer (get-buffer-create " *IDLWAVE-tmp*")) |
6928 |
(erase-buffer) |
(erase-buffer) |
6929 |
(unless (eq major-mode 'idlwave-mode) |
(unless (eq major-mode 'idlwave-mode) |
6931 |
(insert-file-contents file)) |
(insert-file-contents file)) |
6932 |
(save-excursion |
(save-excursion |
6933 |
(goto-char 1) |
(goto-char 1) |
6934 |
(if (idlwave-find-class-definition class) |
(idlwave-find-class-definition class |
6935 |
(list class |
;; Scan all of the structures found there |
6936 |
(cons 'tags (idlwave-struct-tags)) |
(lambda (name) |
6937 |
(cons 'inherits (idlwave-struct-inherits))))))))) |
(let* ((this-class (idlwave-sintern-class name)) |
6938 |
|
(entry |
6939 |
|
(list this-class |
6940 |
|
(cons 'tags (idlwave-struct-tags)) |
6941 |
|
(cons 'inherits (idlwave-struct-inherits))))) |
6942 |
|
(if (not (eq this-class class)) |
6943 |
|
(setq entry (nconc entry (list (cons 'found-in class))))) |
6944 |
|
(idlwave-sintern-class-info entry) |
6945 |
|
(push entry idlwave-class-info))))))))) |
6946 |
|
|
6947 |
|
(defun idlwave-class-found-in (class) |
6948 |
|
"Return the FOUND-IN property of the class." |
6949 |
|
(cdr (assq 'found-in (idlwave-class-info class)))) |
6950 |
(defun idlwave-class-tags (class) |
(defun idlwave-class-tags (class) |
6951 |
"Return the native tags in CLASS." |
"Return the native tags in CLASS." |
6952 |
(cdr (assq 'tags (idlwave-class-info class)))) |
(cdr (assq 'tags (idlwave-class-info class)))) |
6954 |
"Return the direct superclasses of CLASS." |
"Return the direct superclasses of CLASS." |
6955 |
(cdr (assq 'inherits (idlwave-class-info class)))) |
(cdr (assq 'inherits (idlwave-class-info class)))) |
6956 |
|
|
6957 |
|
|
6958 |
(defun idlwave-all-class-tags (class) |
(defun idlwave-all-class-tags (class) |
6959 |
"Return a list of native and inherited tags in CLASS." |
"Return a list of native and inherited tags in CLASS." |
6960 |
(condition-case err |
(condition-case err |
6961 |
(apply 'append (mapcar 'idlwave-class-tags |
(apply 'append (mapcar 'idlwave-class-tags |
6962 |
(cons class (idlwave-all-class-inherits class)))) |
(cons class (idlwave-all-class-inherits class)))) |
6963 |
(error |
(error |
6964 |
(idlwave-class-tag-reset) |
(idlwave-class-tag-reset) |
6965 |
(error "%s" (error-message-string err))))) |
(error "%s" (error-message-string err))))) |
6966 |
|
|
6996 |
(nconc info (list (cons 'all-inherits all-inherits))) |
(nconc info (list (cons 'all-inherits all-inherits))) |
6997 |
all-inherits)))))) |
all-inherits)))))) |
6998 |
|
|
6999 |
|
(defun idlwave-entry-keywords (entry &optional record-link) |
7000 |
|
"Return the flat entry keywords alist from routine-info entry. |
7001 |
|
If RECORD-LINK is non-nil, the keyword text is copied and a text |
7002 |
|
property indicating the link is added." |
7003 |
|
(let (kwds) |
7004 |
|
(mapcar |
7005 |
|
(lambda (key-list) |
7006 |
|
(let ((file (car key-list))) |
7007 |
|
(mapcar (lambda (key-cons) |
7008 |
|
(let ((key (car key-cons)) |
7009 |
|
(link (cdr key-cons))) |
7010 |
|
(when (and record-link file) |
7011 |
|
(setq key (copy-sequence key)) |
7012 |
|
(put-text-property |
7013 |
|
0 (length key) |
7014 |
|
'link |
7015 |
|
(concat |
7016 |
|
file |
7017 |
|
(if link |
7018 |
|
(concat idlwave-html-link-sep |
7019 |
|
(number-to-string link)))) |
7020 |
|
key)) |
7021 |
|
(push (list key) kwds))) |
7022 |
|
(cdr key-list)))) |
7023 |
|
(nthcdr 5 entry)) |
7024 |
|
(nreverse kwds))) |
7025 |
|
|
7026 |
|
(defun idlwave-entry-find-keyword (entry keyword) |
7027 |
|
"Find keyword KEYWORD in entry ENTRY, and return (with link) if set" |
7028 |
|
(catch 'exit |
7029 |
|
(mapc |
7030 |
|
(lambda (key-list) |
7031 |
|
(let ((file (car key-list)) |
7032 |
|
(kwd (assoc keyword (cdr key-list)))) |
7033 |
|
(when kwd |
7034 |
|
(setq kwd (cons (car kwd) |
7035 |
|
(if (and file (cdr kwd)) |
7036 |
|
(concat file |
7037 |
|
idlwave-html-link-sep |
7038 |
|
(number-to-string (cdr kwd))) |
7039 |
|
(cdr kwd)))) |
7040 |
|
(throw 'exit kwd)))) |
7041 |
|
(nthcdr 5 entry)))) |
7042 |
|
|
7043 |
;;========================================================================== |
;;========================================================================== |
7044 |
;; |
;; |
7060 |
(case-fold-search t)) |
(case-fold-search t)) |
7061 |
(if (save-excursion |
(if (save-excursion |
7062 |
;; Check if the context is right |
;; Check if the context is right |
7063 |
(skip-chars-backward "[a-zA-Z0-9._$]") |
(skip-chars-backward "a-zA-Z0-9._$") |
7064 |
(and (< (point) (- pos 4)) |
(and (< (point) (- pos 4)) |
7065 |
(looking-at "self\\."))) |
(looking-at "self\\."))) |
7066 |
(let* ((class-selector (nth 2 (idlwave-current-routine))) |
(let* ((class-selector (nth 2 (idlwave-current-routine))) |
7071 |
;; Check if we need to update the "current" class |
;; Check if we need to update the "current" class |
7072 |
(if (not (equal class-selector idlwave-current-tags-class)) |
(if (not (equal class-selector idlwave-current-tags-class)) |
7073 |
(idlwave-prepare-class-tag-completion class-selector)) |
(idlwave-prepare-class-tag-completion class-selector)) |
7074 |
(setq idlwave-completion-help-info |
(setq idlwave-completion-help-info |
7075 |
(list 'idlwave-complete-class-structure-tag-help |
(list 'idlwave-complete-class-structure-tag-help |
7076 |
(idlwave-sintern-routine |
(idlwave-sintern-routine |
7077 |
(concat class-selector "__define")) |
(concat class-selector "__define")) |
7078 |
nil)) |
nil)) |
7079 |
(let ((idlwave-cpl-bold idlwave-current-native-class-tags)) |
(let ((idlwave-cpl-bold idlwave-current-native-class-tags)) |
7080 |
(idlwave-complete-in-buffer |
(idlwave-complete-in-buffer |
7081 |
'class-tag 'class-tag |
'class-tag 'class-tag |
7082 |
idlwave-current-class-tags nil |
idlwave-current-class-tags nil |
7083 |
(format "Select a tag of class %s" class-selector) |
(format "Select a tag of class %s" class-selector) |
7084 |
"class tag" |
"class tag" |
7103 |
;=========================================================================== |
;=========================================================================== |
7104 |
;; |
;; |
7105 |
;; Completing system variables and their structure fields |
;; Completing system variables and their structure fields |
7106 |
;; This is also a plugin. It is a bit bigger since we support loading |
;; This is also a plugin. |
|
;; current system variables from the shell and highlighting in the |
|
|
;; completions buffer. |
|
7107 |
|
|
7108 |
(defvar idlwave-sint-sysvars nil) |
(defvar idlwave-sint-sysvars nil) |
7109 |
(defvar idlwave-sint-sysvartags nil) |
(defvar idlwave-sint-sysvartags nil) |
7111 |
(idlwave-new-sintern-type 'sysvartag) |
(idlwave-new-sintern-type 'sysvartag) |
7112 |
(add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag) |
(add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag) |
7113 |
(add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset) |
(add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset) |
|
(add-hook 'idlwave-after-load-rinfo-hook 'idlwave-remember-builtin-sysvars) |
|
7114 |
(add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist) |
(add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist) |
7115 |
|
|
7116 |
|
(defvar idlwave-executive-commands-alist nil |
7117 |
|
"Alist of system variables and their help files.") |
7118 |
|
|
7119 |
(defvar idlwave-system-variables-alist nil |
(defvar idlwave-system-variables-alist nil |
7120 |
"Alist of system variables and the associated structure tags. |
"Alist of system variables and the associated structure tags. |
7121 |
Gets set in `idlw-rinfo.el'.") |
Gets set in `idlw-rinfo.el'.") |
|
(defvar idlwave-builtin-system-variables nil) |
|
7122 |
|
|
7123 |
(defun idlwave-complete-sysvar-or-tag () |
(defun idlwave-complete-sysvar-or-tag () |
7124 |
"Complete a system variable." |
"Complete a system variable." |
7130 |
(skip-chars-backward "[a-zA-Z0-9_$]") |
(skip-chars-backward "[a-zA-Z0-9_$]") |
7131 |
(equal (char-before) ?!)) |
(equal (char-before) ?!)) |
7132 |
(setq idlwave-completion-help-info '(idlwave-complete-sysvar-help)) |
(setq idlwave-completion-help-info '(idlwave-complete-sysvar-help)) |
7133 |
(idlwave-complete-in-buffer 'sysvar 'sysvar |
(idlwave-complete-in-buffer 'sysvar 'sysvar |
7134 |
idlwave-system-variables-alist nil |
idlwave-system-variables-alist nil |
7135 |
"Select a system variable" |
"Select a system variable" |
7136 |
"system variable") |
"system variable") |
7137 |
t) ; return t to skip other completions |
t) ; return t to skip other completions |
7138 |
((save-excursion |
((save-excursion |
7139 |
;; Check if the context is right for sysvar tag |
;; Check if the context is right for sysvar tag |
7140 |
(skip-chars-backward "[a-zA-Z0-9_$.]") |
(skip-chars-backward "a-zA-Z0-9_$.") |
7141 |
(and (equal (char-before) ?!) |
(and (equal (char-before) ?!) |
7142 |
(looking-at "\\([a-zA-Z][a-zA-Z0-9_$]*\\)\\.") |
(looking-at "\\([a-zA-Z][a-zA-Z0-9_$]*\\)\\.") |
7143 |
(<= (match-end 0) pos))) |
(<= (match-end 0) pos))) |
7144 |
;; Complete a system variable tag |
;; Complete a system variable tag |
7145 |
(let* ((var (idlwave-sintern-sysvar (match-string 1))) |
(let* ((var (idlwave-sintern-sysvar (match-string 1))) |
7146 |
(entry (assq var idlwave-system-variables-alist)) |
(entry (assq var idlwave-system-variables-alist)) |
7147 |
(tags (cdr entry))) |
(tags (cdr (assq 'tags entry)))) |
7148 |
(or entry (error "!%s is not know to be a system variable" var)) |
(or entry (error "!%s is not a known system variable" var)) |
7149 |
(or tags (error "System variable !%s is not a structure" var)) |
(or tags (error "System variable !%s is not a structure" var)) |
7150 |
(setq idlwave-completion-help-info |
(setq idlwave-completion-help-info |
7151 |
(list 'idlwave-complete-sysvar-help var)) |
(list 'idlwave-complete-sysvar-tag-help var)) |
7152 |
(idlwave-complete-in-buffer 'sysvartag 'sysvartag |
(idlwave-complete-in-buffer 'sysvartag 'sysvartag |
7153 |
tags nil |
tags nil |
7154 |
"Select a system variable tag" |
"Select a system variable tag" |
7155 |
"system variable tag") |
"system variable tag") |
7156 |
t)) ; return t to skip other completions |
t)) ; return t to skip other completions |
7157 |
(t nil)))) |
(t nil)))) |
7158 |
|
|
|
;; Here we fake help using the routine "system variables" with keyword |
|
|
;; set to the sysvar. Name and kwd are global variables here. |
|
|
(defvar name) |
|
|
(defvar kwd) |
|
7159 |
(defun idlwave-complete-sysvar-help (mode word) |
(defun idlwave-complete-sysvar-help (mode word) |
7160 |
(cond |
(let ((word (or (nth 1 idlwave-completion-help-info) word)) |
7161 |
((eq mode 'test) |
(entry (assoc word idlwave-system-variables-alist))) |
7162 |
(or (and (eq nil (nth 1 idlwave-completion-help-info)) |
(cond |
7163 |
(member (downcase word) idlwave-builtin-system-variables)) |
((eq mode 'test) |
7164 |
(and (stringp (nth 1 idlwave-completion-help-info)) |
(and (stringp word) entry (nth 1 (assq 'link entry)))) |
7165 |
(member (downcase (nth 1 idlwave-completion-help-info)) |
((eq mode 'set) |
7166 |
idlwave-builtin-system-variables)))) |
(if entry (setq link (nth 1 (assq 'link entry))))) ;; setting dynamic!!! |
7167 |
((eq mode 'set) |
(t (error "This should not happen"))))) |
7168 |
(setq name "system variables" |
|
7169 |
kwd (concat "!" |
(defun idlwave-complete-sysvar-tag-help (mode word) |
7170 |
(if (stringp (nth 1 idlwave-completion-help-info)) |
(let* ((var (nth 1 idlwave-completion-help-info)) |
7171 |
(nth 1 idlwave-completion-help-info) |
(entry (assoc var idlwave-system-variables-alist)) |
7172 |
word)))) |
(tags (cdr (assq 'tags entry))) |
7173 |
(t (error "This should not happen")))) |
(main (nth 1 (assq 'link entry))) |
7174 |
|
target main-base) |
7175 |
|
(cond |
7176 |
|
((eq mode 'test) ; we can at least link the main |
7177 |
|
(and (stringp word) entry main)) |
7178 |
|
((eq mode 'set) |
7179 |
|
(if entry |
7180 |
|
(setq link |
7181 |
|
(if (setq target (cdr (assoc word tags))) |
7182 |
|
(idlwave-substitute-link-target main target) |
7183 |
|
main)))) ;; setting dynamic!!! |
7184 |
|
(t (error "This should not happen"))))) |
7185 |
|
|
7186 |
|
(defun idlwave-substitute-link-target (link target) |
7187 |
|
"Substitute the target anchor for the given link." |
7188 |
|
(let (main-base) |
7189 |
|
(setq main-base (if (string-match "#" link) |
7190 |
|
(substring link 0 (match-beginning 0)) |
7191 |
|
link)) |
7192 |
|
(if target |
7193 |
|
(concat main-base idlwave-html-link-sep (number-to-string target)) |
7194 |
|
link))) |
7195 |
|
|
7196 |
;; Fake help in the source buffer for class structure tags. |
;; Fake help in the source buffer for class structure tags. |
7197 |
;; kwd and name are global-variables here. |
;; KWD AND NAME ARE GLOBAL-VARIABLES HERE. |
7198 |
|
(defvar name) |
7199 |
|
(defvar kwd) |
7200 |
(defvar idlwave-help-do-class-struct-tag nil) |
(defvar idlwave-help-do-class-struct-tag nil) |
7201 |
(defun idlwave-complete-class-structure-tag-help (mode word) |
(defun idlwave-complete-class-structure-tag-help (mode word) |
7202 |
(cond |
(cond |
7203 |
((eq mode 'test) ; nothing gets fontified for class tags |
((eq mode 'test) ; nothing gets fontified for class tags |
7204 |
nil) |
nil) |
7205 |
((eq mode 'set) |
((eq mode 'set) |
7206 |
(let (class-with) |
(let (class-with found-in) |
7207 |
(when (setq class-with |
(when (setq class-with |
7208 |
(idlwave-class-or-superclass-with-tag |
(idlwave-class-or-superclass-with-tag |
7209 |
idlwave-current-tags-class |
idlwave-current-tags-class |
7210 |
word)) |
word)) |
7211 |
(if (assq (idlwave-sintern-class class-with) |
(if (assq (idlwave-sintern-class class-with) |
7212 |
idlwave-system-class-info) |
idlwave-system-class-info) |
7213 |
(error "No help available for system class tags.")) |
(error "No help available for system class tags.")) |
7214 |
(setq name (concat class-with "__define")))) |
(if (setq found-in (idlwave-class-found-in class-with)) |
7215 |
|
(setq name (cons (concat found-in "__define") class-with)) |
7216 |
|
(setq name (concat class-with "__define"))))) |
7217 |
(setq kwd word |
(setq kwd word |
7218 |
idlwave-help-do-class-struct-tag t)) |
idlwave-help-do-class-struct-tag t)) |
7219 |
(t (error "This should not happen")))) |
(t (error "This should not happen")))) |
7221 |
(defun idlwave-class-or-superclass-with-tag (class tag) |
(defun idlwave-class-or-superclass-with-tag (class tag) |
7222 |
"Find and return the CLASS or one of its superclass with the |
"Find and return the CLASS or one of its superclass with the |
7223 |
associated TAG, if any." |
associated TAG, if any." |
7224 |
(let ((sclasses (cons class (cdr (assq 'all-inherits |
(let ((sclasses (cons class (cdr (assq 'all-inherits |
7225 |
(idlwave-class-info class))))) |
(idlwave-class-info class))))) |
7226 |
cl) |
cl) |
7227 |
(catch 'exit |
(catch 'exit |
7230 |
(let ((tags (idlwave-class-tags cl))) |
(let ((tags (idlwave-class-tags cl))) |
7231 |
(while tags |
(while tags |
7232 |
(if (eq t (compare-strings tag 0 nil (car tags) 0 nil t)) |
(if (eq t (compare-strings tag 0 nil (car tags) 0 nil t)) |
7233 |
(throw 'exit cl)) |
(throw 'exit cl)) |
7234 |
(setq tags (cdr tags)))))))) |
(setq tags (cdr tags)))))))) |
7235 |
|
|
7236 |
|
|
7237 |
(defun idlwave-sysvars-reset () |
(defun idlwave-sysvars-reset () |
7238 |
(if (and (fboundp 'idlwave-shell-is-running) |
(if (and (fboundp 'idlwave-shell-is-running) |
7239 |
(idlwave-shell-is-running)) |
(idlwave-shell-is-running) |
7240 |
|
idlwave-idlwave_routine_info-compiled) |
7241 |
(idlwave-shell-send-command "idlwave_get_sysvars" |
(idlwave-shell-send-command "idlwave_get_sysvars" |
7242 |
'idlwave-process-sysvars 'hide))) |
'idlwave-process-sysvars 'hide))) |
7243 |
|
|
7247 |
idlwave-sint-sysvartags nil) |
idlwave-sint-sysvartags nil) |
7248 |
(idlwave-sintern-sysvar-alist)) |
(idlwave-sintern-sysvar-alist)) |
7249 |
|
|
|
(defun idlwave-remember-builtin-sysvars () |
|
|
(setq idlwave-builtin-system-variables |
|
|
(mapcar 'downcase |
|
|
(mapcar 'car idlwave-system-variables-alist)))) |
|
|
|
|
7250 |
(defun idlwave-sintern-sysvar-alist () |
(defun idlwave-sintern-sysvar-alist () |
7251 |
(let ((list idlwave-system-variables-alist) entry) |
(let ((list idlwave-system-variables-alist) entry tags) |
7252 |
(while (setq entry (pop list)) |
(while (setq entry (pop list)) |
7253 |
(setcar entry (idlwave-sintern-sysvar (car entry) 'set)) |
(setcar entry (idlwave-sintern-sysvar (car entry) 'set)) |
7254 |
(setcdr entry (mapcar (lambda (x) |
(setq tags (assq 'tags entry)) |
7255 |
(list (idlwave-sintern-sysvartag (car x) 'set))) |
(if tags |
7256 |
(cdr entry)))))) |
(setcdr tags |
7257 |
|
(mapcar (lambda (x) |
7258 |
|
(cons (idlwave-sintern-sysvartag (car x) 'set) |
7259 |
|
(cdr x))) |
7260 |
|
(cdr tags))))))) |
7261 |
|
|
7262 |
(defvar idlwave-shell-command-output) |
(defvar idlwave-shell-command-output) |
7263 |
(defun idlwave-shell-filter-sysvars () |
(defun idlwave-shell-filter-sysvars () |
7264 |
"Get the system variables and structure tags." |
"Get any new system variables and tags." |
7265 |
(let ((text idlwave-shell-command-output) |
(let ((text idlwave-shell-command-output) |
7266 |
(start 0) |
(start 0) |
7267 |
(old idlwave-system-variables-alist) |
(old idlwave-system-variables-alist) |
7268 |
var tags type name class) |
var tags type name class link old-entry) |
7269 |
(setq idlwave-system-variables-alist nil) |
(setq idlwave-system-variables-alist nil) |
7270 |
(while (string-match "^IDLWAVE-SYSVAR: !\\([a-zA-Z0-9_$]+\\)\\( \\(.*\\)\\)?" |
(while (string-match "^IDLWAVE-SYSVAR: !\\([a-zA-Z0-9_$]+\\)\\( \\(.*\\)\\)?" |
7271 |
text start) |
text start) |
7272 |
(setq start (match-end 0) |
(setq start (match-end 0) |
7273 |
var (match-string 1 text) |
var (match-string 1 text) |
7274 |
tags (if (match-end 3) (idlwave-split-string (match-string 3 text)))) |
tags (if (match-end 3) |
7275 |
|
(idlwave-split-string (match-string 3 text)))) |
7276 |
|
;; Maintain old links, if present |
7277 |
|
(setq old-entry (assq (idlwave-sintern-sysvar var) old)) |
7278 |
|
(setq link (assq 'link old-entry)) |
7279 |
(setq idlwave-system-variables-alist |
(setq idlwave-system-variables-alist |
7280 |
(cons (cons var (mapcar 'list tags)) |
(cons (list var |
7281 |
|
(cons |
7282 |
|
'tags |
7283 |
|
(mapcar (lambda (x) |
7284 |
|
(cons x |
7285 |
|
(cdr (assq |
7286 |
|
(idlwave-sintern-sysvartag x) |
7287 |
|
(cdr (assq 'tags old-entry)))))) |
7288 |
|
tags)) link) |
7289 |
idlwave-system-variables-alist))) |
idlwave-system-variables-alist))) |
7290 |
;; Keep the old value if query was not successful |
;; Keep the old value if query was not successful |
7291 |
(setq idlwave-system-variables-alist |
(setq idlwave-system-variables-alist |
7304 |
'face 'font-lock-string-face))))))) |
'face 'font-lock-string-face))))))) |
7305 |
|
|
7306 |
(defun idlwave-uniquify (list) |
(defun idlwave-uniquify (list) |
7307 |
(let (nlist) |
(let ((ht (make-hash-table :size (length list) :test 'equal))) |
7308 |
(loop for x in list do |
(delq nil |
7309 |
(add-to-list 'nlist x)) |
(mapcar (lambda (x) |
7310 |
nlist)) |
(unless (gethash x ht) |
7311 |
|
(puthash x t ht) |
7312 |
|
x)) |
7313 |
|
list)))) |
7314 |
|
|
7315 |
(defun idlwave-after-successful-completion (type slash &optional verify) |
(defun idlwave-after-successful-completion (type slash &optional verify) |
7316 |
"Add `=' or `(' after successful completion of keyword and function. |
"Add `=' or `(' after successful completion of keyword and function. |
7335 |
nil))) |
nil))) |
7336 |
|
|
7337 |
;; Restore the pre-completion window configuration if this is safe. |
;; Restore the pre-completion window configuration if this is safe. |
7338 |
|
|
7339 |
(if (or (eq verify 'force) ; force |
(if (or (eq verify 'force) ; force |
7340 |
(and |
(and |
7341 |
(get-buffer-window "*Completions*") ; visible |
(get-buffer-window "*Completions*") ; visible |
7342 |
(idlwave-local-value 'idlwave-completion-p |
(idlwave-local-value 'idlwave-completion-p |
7343 |
"*Completions*") ; cib-buffer |
"*Completions*") ; cib-buffer |
7344 |
(eq (marker-buffer idlwave-completion-mark) |
(eq (marker-buffer idlwave-completion-mark) |
7345 |
(current-buffer)) ; buffer OK |
(current-buffer)) ; buffer OK |
7366 |
`idlwave-help-source-try-header' is non-nil) or the routine definition |
`idlwave-help-source-try-header' is non-nil) or the routine definition |
7367 |
itself." |
itself." |
7368 |
(interactive "P") |
(interactive "P") |
|
(idlwave-require-online-help) |
|
7369 |
(idlwave-do-context-help arg)) |
(idlwave-do-context-help arg)) |
7370 |
|
|
7371 |
(defun idlwave-mouse-completion-help (ev) |
(defun idlwave-mouse-completion-help (ev) |
7372 |
"Display online help about the completion at point." |
"Display online help about the completion at point." |
7373 |
(interactive "eP") |
(interactive "eP") |
7374 |
(idlwave-require-online-help) |
;; Restore last-command for next command, to make |
7375 |
;; Restore last-command for next command, to make scrolling of completions |
;; scrolling/cancelling of completions work. |
|
;; work. |
|
7376 |
(setq this-command last-command) |
(setq this-command last-command) |
7377 |
(idlwave-do-mouse-completion-help ev)) |
(idlwave-do-mouse-completion-help ev)) |
7378 |
|
|
|
(defvar idlwave-help-is-loaded nil |
|
|
"Is online help avaiable?") |
|
|
;; The following variables will be defined by `idlw-help.el'. |
|
|
(defvar idlwave-help-frame-width nil) |
|
|
(defvar idlwave-help-file nil) |
|
|
(defvar idlwave-help-topics nil) |
|
|
|
|
|
(defun idlwave-help-directory () |
|
|
"Return the help directory, or nil if that is not known." |
|
|
(or (and (stringp idlwave-help-directory) |
|
|
(> (length idlwave-help-directory) 0) |
|
|
idlwave-help-directory) |
|
|
(getenv "IDLWAVE_HELP_DIRECTORY"))) |
|
|
|
|
|
(defun idlwave-require-online-help () |
|
|
(if idlwave-help-is-loaded |
|
|
t ;; everything is OK. |
|
|
(let* ((dir (or (idlwave-help-directory) |
|
|
(error "Online Help not installed (help directory unknown) - download at idlwave.org"))) |
|
|
(lfile1 (expand-file-name "idlw-help.elc" dir)) |
|
|
(lfile2 (expand-file-name "idlw-help.el" dir)) |
|
|
(hfile (expand-file-name "idlw-help.txt" dir))) |
|
|
(if (or (and (file-regular-p lfile1) (load-file lfile1)) |
|
|
(and (file-regular-p lfile2) (load-file lfile2))) |
|
|
(progn |
|
|
(if (and idlwave-help-frame-parameters |
|
|
(not (assoc 'width idlwave-help-frame-parameters))) |
|
|
(push (cons 'width idlwave-help-frame-width) |
|
|
idlwave-help-frame-parameters)) |
|
|
(or idlwave-help-topics |
|
|
(error "File `%s' in help dir `%s' does not define `idlwave-help-topics'" |
|
|
"idlw-help.el" dir))) |
|
|
(error "No such file `%s' in help dir `%s'" "idlw-help.el" dir)) |
|
|
(if (file-regular-p hfile) |
|
|
(setq idlwave-help-is-loaded t |
|
|
idlwave-help-file hfile) |
|
|
(error "No such file `%s' in dir `%s'" "idlw-help.txt" dir))))) |
|
|
|
|
7379 |
(defun idlwave-routine-info (&optional arg external) |
(defun idlwave-routine-info (&optional arg external) |
7380 |
"Display a routines calling sequence and list of keywords. |
"Display a routines calling sequence and list of keywords. When |
7381 |
When point is on the name a function or procedure, or in the argument |
point is on the name a function or procedure, or in the argument list |
7382 |
list of a function or procedure, this command displays a help buffer |
of a function or procedure, this command displays a help buffer with |
7383 |
with the information. When called with prefix arg, enforce class |
the information. When called with prefix arg, enforce class query. |
|
query. |
|
7384 |
|
|
7385 |
When point is on an object operator `->', display the class stored in |
When point is on an object operator `->', display the class stored in |
7386 |
this arrow, if any (see `idlwave-store-inquired-class'). With a |
this arrow, if any (see `idlwave-store-inquired-class'). With a |
7418 |
(error "Don't know which calling sequence to show"))))) |
(error "Don't know which calling sequence to show"))))) |
7419 |
|
|
7420 |
(defun idlwave-resolve (&optional arg) |
(defun idlwave-resolve (&optional arg) |
7421 |
"Call RESOLVE on the module name at point. |
"Call RESOLVE_ROUTINE on the module name at point. |
7422 |
Like `idlwave-routine-info', this looks for a routine call at point. |
Like `idlwave-routine-info', this looks for a routine call at point. |
7423 |
After confirmation in the minibuffer, it will use the shell to issue |
After confirmation in the minibuffer, it will use the shell to issue |
7424 |
a RESOLVE call for this routine, to attempt to make it defined and its |
a RESOLVE call for this routine, to attempt to make it defined and its |
7437 |
(if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" |
(if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" |
7438 |
resolve) |
resolve) |
7439 |
(setq type (match-string 1 resolve) |
(setq type (match-string 1 resolve) |
7440 |
class (if (match-beginning 2) |
class (if (match-beginning 2) |
7441 |
(match-string 3 resolve) |
(match-string 3 resolve) |
7442 |
nil) |
nil) |
7443 |
name (match-string 4 resolve))) |
name (match-string 4 resolve))) |
7446 |
|
|
7447 |
(cond |
(cond |
7448 |
((null class) |
((null class) |
7449 |
(idlwave-shell-send-command |
(idlwave-shell-send-command |
7450 |
(format "resolve_routine,'%s'%s" (downcase name) kwd) |
(format "resolve_routine,'%s'%s" (downcase name) kwd) |
7451 |
'idlwave-update-routine-info |
'idlwave-update-routine-info |
7452 |
nil t)) |
nil t)) |
7453 |
(t |
(t |
7454 |
(idlwave-shell-send-command |
(idlwave-shell-send-command |
7455 |
(format "resolve_routine,'%s__define'%s" (downcase class) kwd) |
(format "resolve_routine,'%s__define'%s" (downcase class) kwd) |
7456 |
(list 'idlwave-shell-send-command |
(list 'idlwave-shell-send-command |
7457 |
(format "resolve_routine,'%s__%s'%s" |
(format "resolve_routine,'%s__%s'%s" |
7458 |
(downcase class) (downcase name) kwd) |
(downcase class) (downcase name) kwd) |
7459 |
'(idlwave-update-routine-info) |
'(idlwave-update-routine-info) |
7460 |
nil t)))))) |
nil t)))))) |
7461 |
|
|
7462 |
(defun idlwave-find-module (&optional arg) |
(defun idlwave-find-module (&optional arg) |
7463 |
"Find the source code of an IDL module. |
"Find the source code of an IDL module. |
7464 |
Works for modules for which IDLWAVE has routine info available. |
Works for modules for which IDLWAVE has routine info available. The |
7465 |
The function offers as default the module name `idlwave-routine-info' would |
function offers as default the module name `idlwave-routine-info' |
7466 |
use. With ARG force class query for object methods." |
would use. With ARG limit to this buffer. With two prefix ARG's |
7467 |
|
force class query for object methods." |
7468 |
(interactive "P") |
(interactive "P") |
7469 |
(let* ((idlwave-query-class nil) |
(let* ((idlwave-query-class nil) |
7470 |
(idlwave-force-class-query (equal arg '(4))) |
(idlwave-force-class-query (equal arg '(16))) |
7471 |
|
(this-buffer (equal arg '(4))) |
7472 |
(module (idlwave-fix-module-if-obj_new (idlwave-what-module))) |
(module (idlwave-fix-module-if-obj_new (idlwave-what-module))) |
7473 |
(default (concat (idlwave-make-full-name (nth 2 module) (car module)) |
(default (if module |
7474 |
(if (eq (nth 1 module) 'pro) "<p>" "<f>"))) |
(concat (idlwave-make-full-name |
7475 |
(list |
(nth 2 module) (car module)) |
7476 |
(delq nil |
(if (eq (nth 1 module) 'pro) "<p>" "<f>")) |
7477 |
(mapcar (lambda (x) |
"none")) |
7478 |
(if (eq 'system (car-safe (nth 3 x))) |
(list |
7479 |
;; Take out system routines with no source. |
(idlwave-uniquify |
7480 |
nil |
(delq nil |
7481 |
(cons |
(mapcar (lambda (x) |
7482 |
(concat (idlwave-make-full-name (nth 2 x) (car x)) |
(if (eq 'system (car-safe (nth 3 x))) |
7483 |
(if (eq (nth 1 x) 'pro) "<p>" "<f>")) |
;; Take out system routines with no source. |
7484 |
(cdr x)))) |
nil |
7485 |
(idlwave-routines)))) |
(list |
7486 |
|
(concat (idlwave-make-full-name |
7487 |
|
(nth 2 x) (car x)) |
7488 |
|
(if (eq (nth 1 x) 'pro) "<p>" "<f>"))))) |
7489 |
|
(if this-buffer |
7490 |
|
(idlwave-save-buffer-update) |
7491 |
|
(idlwave-routines)))))) |
7492 |
(name (idlwave-completing-read |
(name (idlwave-completing-read |
7493 |
(format "Module (Default %s): " |
(if (or (not this-buffer) |
7494 |
(if default default "none")) |
(assoc default list)) |
7495 |
|
(format "Module (Default %s): " default) |
7496 |
|
(format "Module in this file: ")) |
7497 |
list)) |
list)) |
7498 |
type class) |
type class) |
7499 |
(if (string-match "\\`\\s-*\\'" name) |
(if (string-match "\\`\\s-*\\'" name) |
7510 |
type (cond ((equal type "f") 'fun) |
type (cond ((equal type "f") 'fun) |
7511 |
((equal type "p") 'pro) |
((equal type "p") 'pro) |
7512 |
(t t))) |
(t t))) |
7513 |
(idlwave-do-find-module name type class))) |
(idlwave-do-find-module name type class nil this-buffer))) |
7514 |
|
|
7515 |
(defun idlwave-do-find-module (name type class &optional force-source) |
(defun idlwave-do-find-module (name type class |
7516 |
|
&optional force-source this-buffer) |
7517 |
(let ((name1 (idlwave-make-full-name class name)) |
(let ((name1 (idlwave-make-full-name class name)) |
7518 |
source buf1 entry |
source buf1 entry |
7519 |
(buf (current-buffer)) |
(buf (current-buffer)) |
7520 |
(pos (point)) |
(pos (point)) |
7521 |
name2) |
file name2) |
7522 |
(setq entry (idlwave-best-rinfo-assq name type class (idlwave-routines)) |
(setq entry (idlwave-best-rinfo-assq name type class (idlwave-routines) |
7523 |
|
'WITH-FILE) |
7524 |
source (or force-source (nth 3 entry)) |
source (or force-source (nth 3 entry)) |
7525 |
name2 (if (nth 2 entry) |
name2 (if (nth 2 entry) |
7526 |
(idlwave-make-full-name (nth 2 entry) name) |
(idlwave-make-full-name (nth 2 entry) name) |
7527 |
name1)) |
name1)) |
7528 |
|
(if source |
7529 |
|
(setq file (idlwave-routine-source-file source))) |
7530 |
|
(unless file ; Try to find it on the path. |
7531 |
|
(setq file |
7532 |
|
(idlwave-expand-lib-file-name |
7533 |
|
(if class |
7534 |
|
(format "%s__define.pro" (downcase class)) |
7535 |
|
(format "%s.pro" (downcase name)))))) |
7536 |
(cond |
(cond |
7537 |
((or (null name) (equal name "")) |
((or (null name) (equal name "")) |
7538 |
(error "Abort")) |
(error "Abort")) |
|
((null entry) |
|
|
(error "Nothing known about a module %s" name2)) |
|
7539 |
((eq (car source) 'system) |
((eq (car source) 'system) |
7540 |
(error "Source code for system routine %s is not available" |
(error "Source code for system routine %s is not available" |
7541 |
name2)) |
name2)) |
7542 |
((equal (cdr source) "") |
((or (not file) (not (file-regular-p file))) |
7543 |
(error "Source code for routine %s is not available" |
(error "Source code for routine %s is not available" |
7544 |
name2)) |
name2)) |
7545 |
((memq (car source) '(buffer lib compiled)) |
(t |
7546 |
(setq buf1 |
(when (not this-buffer) |
7547 |
(if (eq (car source) 'lib) |
(setq buf1 |
7548 |
(idlwave-find-file-noselect |
(idlwave-find-file-noselect file 'find)) |
7549 |
(idlwave-expand-lib-file-name |
(pop-to-buffer buf1 t)) |
|
(or (cdr source) |
|
|
(format "%s.pro" (downcase name)))) 'find) |
|
|
(idlwave-find-file-noselect (cdr source) 'find))) |
|
|
(pop-to-buffer buf1 t) |
|
7550 |
(goto-char (point-max)) |
(goto-char (point-max)) |
7551 |
(let ((case-fold-search t)) |
(let ((case-fold-search t)) |
7552 |
(if (re-search-backward |
(if (re-search-backward |
7553 |
(concat "^[ \t]*\\<" |
(concat "^[ \t]*\\<" |
7554 |
(cond ((equal type "f") "function") |
(cond ((eq type 'fun) "function") |
7555 |
((equal type "p") "pro") |
((eq type 'pro) "pro") |
7556 |
(t "\\(pro\\|function\\)")) |
(t "\\(pro\\|function\\)")) |
7557 |
"\\>[ \t]+" |
"\\>[ \t]+" |
7558 |
(regexp-quote (downcase name2)) |
(regexp-quote (downcase name2)) |
7559 |
"[^a-zA-Z0-9_$]") |
"[^a-zA-Z0-9_$]") |
7560 |
nil t) |
nil t) |
7574 |
;; This is a function or procedure definition statement |
;; This is a function or procedure definition statement |
7575 |
;; We return the defined routine as module. |
;; We return the defined routine as module. |
7576 |
(list |
(list |
7577 |
(idlwave-sintern-routine-or-method (match-string 4) |
(idlwave-sintern-routine-or-method (match-string-no-properties 4) |
7578 |
(match-string 2)) |
(match-string-no-properties 2)) |
7579 |
(if (equal (downcase (match-string 1)) "pro") 'pro 'fun) |
(if (equal (downcase (match-string 1)) "pro") 'pro 'fun) |
7580 |
(idlwave-sintern-class (match-string 3))) |
(idlwave-sintern-class (match-string 3))) |
7581 |
|
|
7582 |
;; Not a definition statement - analyze precise positon. |
;; Not a definition statement - analyze precise position. |
7583 |
(let* ((where (idlwave-where)) |
(let* ((where (idlwave-where)) |
7584 |
(cw (nth 2 where)) |
(cw (nth 2 where)) |
7585 |
(pro (car (nth 0 where))) |
(pro (car (nth 0 where))) |
7591 |
(cond |
(cond |
7592 |
((and (eq cw 'procedure) |
((and (eq cw 'procedure) |
7593 |
(not (equal this-word ""))) |
(not (equal this-word ""))) |
7594 |
(setq this-word (idlwave-sintern-routine-or-method |
(setq this-word (idlwave-sintern-routine-or-method |
7595 |
this-word (nth 2 (nth 3 where)))) |
this-word (nth 2 (nth 3 where)))) |
7596 |
(list this-word 'pro |
(list this-word 'pro |
7597 |
(idlwave-determine-class |
(idlwave-determine-class |
7598 |
(cons this-word (cdr (nth 3 where))) |
(cons this-word (cdr (nth 3 where))) |
7599 |
'pro))) |
'pro))) |
7600 |
((and (eq cw 'function) |
((and (eq cw 'function) |
7601 |
(not (equal this-word "")) |
(not (equal this-word "")) |
7602 |
(or (eq next-char ?\() ; exclude arrays, vars. |
(or (eq next-char ?\() ; exclude arrays, vars. |
7603 |
(looking-at "[a-zA-Z0-9_]*[ \t]*("))) |
(looking-at "[a-zA-Z0-9_]*[ \t]*("))) |
7604 |
(setq this-word (idlwave-sintern-routine-or-method |
(setq this-word (idlwave-sintern-routine-or-method |
7605 |
this-word (nth 2 (nth 3 where)))) |
this-word (nth 2 (nth 3 where)))) |
7606 |
(list this-word 'fun |
(list this-word 'fun |
7607 |
(idlwave-determine-class |
(idlwave-determine-class |
7638 |
class))) |
class))) |
7639 |
|
|
7640 |
(defun idlwave-fix-module-if-obj_new (module) |
(defun idlwave-fix-module-if-obj_new (module) |
7641 |
"Check if MODULE points to obj_new. If yes, and if the cursor is in the |
"Check if MODULE points to obj_new. |
7642 |
keyword region, change to the appropriate Init method." |
If yes, and if the cursor is in the keyword region, change to the |
7643 |
|
appropriate Init method." |
7644 |
(let* ((name (car module)) |
(let* ((name (car module)) |
7645 |
(pos (point)) |
(pos (point)) |
7646 |
(case-fold-search t) |
(case-fold-search t) |
7659 |
(idlwave-sintern-class class))))) |
(idlwave-sintern-class class))))) |
7660 |
module)) |
module)) |
7661 |
|
|
7662 |
|
(defun idlwave-fix-keywords (name type class keywords &optional super-classes) |
7663 |
(defun idlwave-fix-keywords (name type class keywords) |
"Update a list of keywords. |
7664 |
;; This fixes the list of keywords. |
Translate OBJ_NEW, adding all super-class keywords, or all keywords |
7665 |
|
from all classes if class equals t." |
7666 |
(let ((case-fold-search t)) |
(let ((case-fold-search t)) |
7667 |
|
|
7668 |
;; If this is the OBJ_NEW function, try to figure out the class and use |
;; If this is the OBJ_NEW function, try to figure out the class and use |
7678 |
string) |
string) |
7679 |
(setq class (idlwave-sintern-class (match-string 1 string))) |
(setq class (idlwave-sintern-class (match-string 1 string))) |
7680 |
(setq idlwave-current-obj_new-class class) |
(setq idlwave-current-obj_new-class class) |
7681 |
(setq keywords |
(setq keywords |
7682 |
(append keywords |
(append keywords |
7683 |
(nth 5 (idlwave-rinfo-assq |
(idlwave-entry-keywords |
7684 |
(idlwave-sintern-method "INIT") |
(idlwave-rinfo-assq |
7685 |
'fun |
(idlwave-sintern-method "INIT") |
7686 |
class |
'fun |
7687 |
(idlwave-routines)))))))) |
class |
7688 |
|
(idlwave-routines)) 'do-link)))))) |
7689 |
|
|
7690 |
;; If the class is `t', combine all keywords of all methods NAME |
;; If the class is `t', combine all keywords of all methods NAME |
7691 |
(when (eq class t) |
(when (eq class t) |
7692 |
(loop for x in (idlwave-routines) do |
(mapc (lambda (entry) |
7693 |
(and (nth 2 x) ; non-nil class |
(and |
7694 |
(eq (nth 1 x) type) ; correct type |
(nth 2 entry) ; non-nil class |
7695 |
(eq (car x) name) ; correct name |
(eq (nth 1 entry) type) ; correct type |
7696 |
(mapcar (lambda (k) (add-to-list 'keywords k)) |
(setq keywords |
7697 |
(nth 5 x)))) |
(append keywords |
7698 |
|
(idlwave-entry-keywords entry 'do-link))))) |
7699 |
|
(idlwave-all-assq name (idlwave-routines))) |
7700 |
(setq keywords (idlwave-uniquify keywords))) |
(setq keywords (idlwave-uniquify keywords))) |
7701 |
|
|
7702 |
;; If we have inheritance, add all keywords from superclasses, if |
;; If we have inheritance, add all keywords from superclasses, if |
7703 |
;; the user indicated that method in |
;; the user indicated that method in `idlwave-keyword-class-inheritance' |
7704 |
;; `idlwave-keyword-class-inheritance' |
(when (and |
7705 |
(when (and |
super-classes |
7706 |
idlwave-keyword-class-inheritance |
idlwave-keyword-class-inheritance |
7707 |
(stringp class) |
(stringp class) |
7708 |
(or (assq (idlwave-sintern-keyword "_extra") keywords) |
(or (assq (idlwave-sintern-keyword "_extra") keywords) |
7709 |
(assq (idlwave-sintern-keyword "_ref_extra") keywords)) |
(assq (idlwave-sintern-keyword "_ref_extra") keywords)) |
|
(boundp 'super-classes) |
|
7710 |
;; Check if one of the keyword-class regexps matches the name |
;; Check if one of the keyword-class regexps matches the name |
7711 |
(let ((regexps idlwave-keyword-class-inheritance) re) |
(let ((regexps idlwave-keyword-class-inheritance) re) |
7712 |
(catch 'exit |
(catch 'exit |
7713 |
(while (setq re (pop regexps)) |
(while (setq re (pop regexps)) |
7714 |
(if (string-match re name) (throw 'exit t)))))) |
(if (string-match re name) (throw 'exit t)))))) |
7715 |
(loop for x in (idlwave-routines) do |
|
7716 |
(and (nth 2 x) ; non-nil class |
(loop for entry in (idlwave-routines) do |
7717 |
(or (eq (nth 2 x) class) ; the right class |
(and (nth 2 entry) ; non-nil class |
7718 |
(memq (nth 2 x) super-classes)) ; an inherited class |
(memq (nth 2 entry) super-classes) ; an inherited class |
7719 |
(eq (nth 1 x) type) ; correct type |
(eq (nth 1 entry) type) ; correct type |
7720 |
(eq (car x) name) ; correct name |
(eq (car entry) name) ; correct name |
7721 |
(mapcar (lambda (k) (add-to-list 'keywords k)) |
(mapcar (lambda (k) (add-to-list 'keywords k)) |
7722 |
(nth 5 x)))) |
(idlwave-entry-keywords entry 'do-link)))) |
7723 |
(setq keywords (idlwave-uniquify keywords))) |
(setq keywords (idlwave-uniquify keywords))) |
7724 |
|
|
7725 |
;; Return the final list |
;; Return the final list |
7726 |
keywords)) |
keywords)) |
7727 |
|
|
7741 |
(class (nth 2 module)) |
(class (nth 2 module)) |
7742 |
(kwd (idlwave-sintern-keyword keyword)) |
(kwd (idlwave-sintern-keyword keyword)) |
7743 |
(entry (idlwave-best-rinfo-assoc name type class (idlwave-routines))) |
(entry (idlwave-best-rinfo-assoc name type class (idlwave-routines))) |
7744 |
(kwd-alist (nth 5 entry)) |
(kwd-alist (idlwave-entry-keywords entry)) |
7745 |
(extra (or (assq (idlwave-sintern-keyword "_EXTRA") kwd-alist) |
(extra (or (assq (idlwave-sintern-keyword "_EXTRA") kwd-alist) |
7746 |
(assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) |
(assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) |
7747 |
(completion-ignore-case t) |
(completion-ignore-case t) |
7748 |
candidates) |
candidates) |
7749 |
(cond ((assq kwd kwd-alist) |
(cond ((assq kwd kwd-alist) |
7750 |
kwd) |
kwd) |
7751 |
((setq candidates (all-completions kwd kwd-alist)) |
((setq candidates (all-completions kwd kwd-alist)) |
7752 |
(if (= (length candidates) 1) |
(if (= (length candidates) 1) |
7753 |
(car candidates) |
(car candidates) |
7754 |
candidates)) |
candidates)) |
7755 |
((and entry extra) |
((and entry extra) |
7756 |
;; Inheritance may cause this keyword to be correct |
;; Inheritance may cause this keyword to be correct |
7757 |
keyword) |
keyword) |
7758 |
(entry |
(entry |
7759 |
;; We do know the function, which does not have the keyword. |
;; We do know the function, which does not have the keyword. |
7765 |
|
|
7766 |
(defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) |
(defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) |
7767 |
(defvar idlwave-rinfo-map (make-sparse-keymap)) |
(defvar idlwave-rinfo-map (make-sparse-keymap)) |
7768 |
(define-key idlwave-rinfo-mouse-map |
(define-key idlwave-rinfo-mouse-map |
7769 |
(if (featurep 'xemacs) [button2] [mouse-2]) |
(if (featurep 'xemacs) [button2] [mouse-2]) |
7770 |
'idlwave-mouse-active-rinfo) |
'idlwave-mouse-active-rinfo) |
7771 |
(define-key idlwave-rinfo-mouse-map |
(define-key idlwave-rinfo-mouse-map |
7772 |
(if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) |
(if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) |
7773 |
'idlwave-mouse-active-rinfo-shift) |
'idlwave-mouse-active-rinfo-shift) |
7774 |
(define-key idlwave-rinfo-mouse-map |
(define-key idlwave-rinfo-mouse-map |
7775 |
(if (featurep 'xemacs) [button3] [mouse-3]) |
(if (featurep 'xemacs) [button3] [mouse-3]) |
7776 |
'idlwave-mouse-active-rinfo-right) |
'idlwave-mouse-active-rinfo-right) |
7777 |
(define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) |
(define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) |
7797 |
(let* ((initial-class (or initial-class class)) |
(let* ((initial-class (or initial-class class)) |
7798 |
(entry (or (idlwave-best-rinfo-assq name type class |
(entry (or (idlwave-best-rinfo-assq name type class |
7799 |
(idlwave-routines)) |
(idlwave-routines)) |
7800 |
(idlwave-rinfo-assq name type class |
(idlwave-rinfo-assq name type class |
7801 |
idlwave-unresolved-routines))) |
idlwave-unresolved-routines))) |
7802 |
(name (or (car entry) name)) |
(name (or (car entry) name)) |
7803 |
(class (or (nth 2 entry) class)) |
(class (or (nth 2 entry) class)) |
7805 |
(twins (idlwave-routine-twins entry)) |
(twins (idlwave-routine-twins entry)) |
7806 |
(dtwins (idlwave-study-twins twins)) |
(dtwins (idlwave-study-twins twins)) |
7807 |
(all dtwins) |
(all dtwins) |
7808 |
(system (idlwave-rinfo-assq |
(system (eq (car (nth 3 entry)) 'system)) |
|
name type class idlwave-system-routines)) |
|
|
(have-sysdoc (and system (idlwave-help-directory))) |
|
|
;; (source (nth 3 entry)) |
|
|
(have-olh (and (or system idlwave-extra-help-function) |
|
|
(idlwave-help-directory))) |
|
7809 |
(calling-seq (nth 4 entry)) |
(calling-seq (nth 4 entry)) |
7810 |
(keywords (nth 5 entry)) |
(keywords (idlwave-entry-keywords entry 'do-link)) |
7811 |
(olh (nth 6 entry)) |
(html-file (car (nth 5 entry))) |
7812 |
(help-echo-kwd |
(help-echo-kwd |
7813 |
(if have-olh |
"Button2: Insert KEYWORD (SHIFT=`/KEYWORD') | Button3: Online Help ") |
|
"Button2: Insert KEYWORD (SHIFT=`/KEYWORD') Button3: Online Help " |
|
|
"Button2: Insert KEYWORD (SHIFT=`/KEYWORD').")) |
|
7814 |
(help-echo-use |
(help-echo-use |
7815 |
(if have-olh |
"Button2/3: Online Help") |
|
"Button2/3: Online Help" |
|
|
nil)) |
|
7816 |
(help-echo-src |
(help-echo-src |
7817 |
(if (idlwave-help-directory) |
"Button2: Jump to source and back | Button3: Source in Help window.") |
|
"Button2: Pop to source and back. Button3: Source in Help window." |
|
|
"Button2: Pop to source and back.")) |
|
7818 |
(help-echo-class |
(help-echo-class |
7819 |
"Button2: Display info about same method in superclass") |
"Button2: Display info about same method in superclass") |
7820 |
(col 0) |
(col 0) |
7821 |
(data (list name type class (current-buffer) olh initial-class)) |
(data (list name type class (current-buffer) nil initial-class)) |
7822 |
(km-prop (if (featurep 'xemacs) 'keymap 'local-map)) |
(km-prop (if (featurep 'xemacs) 'keymap 'local-map)) |
7823 |
(face 'idlwave-help-link-face) |
(face 'idlwave-help-link-face) |
7824 |
beg props win cnt total) |
beg props win cnt total) |
7825 |
|
;; Fix keywords, but don't add chained super-classes, since these |
7826 |
|
;; are shown separately for that super-class |
7827 |
(setq keywords (idlwave-fix-keywords name type class keywords)) |
(setq keywords (idlwave-fix-keywords name type class keywords)) |
7828 |
(cond |
(cond |
7829 |
((null entry) |
((null entry) |
7832 |
((or (null name) (equal name "")) |
((or (null name) (equal name "")) |
7833 |
(error "No function or procedure call at point")) |
(error "No function or procedure call at point")) |
7834 |
((null calling-seq) |
((null calling-seq) |
7835 |
(error "Calling sequence of %s %s is not available" type name)) |
(error "Calling sequence of %s %s not available" type name)) |
7836 |
(t |
(t |
7837 |
(save-excursion |
(save-excursion |
7838 |
(move-marker idlwave-rinfo-marker (point)) |
(move-marker idlwave-rinfo-marker (point)) |
7856 |
(insert c) |
(insert c) |
7857 |
(if (equal (downcase c) (downcase class)) |
(if (equal (downcase c) (downcase class)) |
7858 |
(add-text-properties beg (point) (list 'face 'bold)) |
(add-text-properties beg (point) (list 'face 'bold)) |
7859 |
|
;; If Method exists in a different class link it |
7860 |
(if (idlwave-rinfo-assq name type c (idlwave-routines)) |
(if (idlwave-rinfo-assq name type c (idlwave-routines)) |
7861 |
(add-text-properties beg (point) props)))) |
(add-text-properties beg (point) props)))) |
7862 |
(insert "\n"))) |
(insert "\n"))) |
7863 |
(setq props (if have-olh |
(setq props (list 'mouse-face 'highlight |
7864 |
(list 'mouse-face 'highlight |
km-prop idlwave-rinfo-mouse-map |
7865 |
km-prop idlwave-rinfo-mouse-map |
'help-echo help-echo-use |
7866 |
'help-echo help-echo-use |
'data (cons 'usage data))) |
7867 |
'data (cons 'usage data)))) |
(if html-file (setq props (append (list 'face face 'link html-file) |
7868 |
(if have-sysdoc (setq props (append (list 'face face) props))) |
props))) |
7869 |
(insert "Usage: ") |
(insert "Usage: ") |
7870 |
(setq beg (point)) |
(setq beg (point)) |
7871 |
(insert (if class |
(insert (if class |
7872 |
(format calling-seq class name) |
(format calling-seq class name class name class name) |
7873 |
(format calling-seq name)) |
(format calling-seq name name name name)) |
7874 |
"\n") |
"\n") |
7875 |
(add-text-properties beg (point) props) |
(add-text-properties beg (point) props) |
7876 |
|
|
7877 |
(insert "Keywords:") |
(insert "Keywords:") |
7878 |
(if (null keywords) |
(if (null keywords) |
7879 |
(insert " No keywords accepted.") |
(insert " No keywords accepted.") |
7880 |
(setq col 9) |
(setq col 9) |
7881 |
(mapcar |
(mapcar |
7882 |
(lambda (x) |
(lambda (x) |
7883 |
(if (>= (+ col 1 (length (car x))) |
(if (>= (+ col 1 (length (car x))) |
7884 |
(window-width)) |
(window-width)) |
7885 |
(progn |
(progn |
7886 |
(insert "\n ") |
(insert "\n ") |
7887 |
(setq col 9))) |
(setq col 9))) |
7888 |
(insert " ") |
(insert " ") |
7889 |
(setq beg (point) |
(setq beg (point) |
7890 |
|
;; Relevant keywords already have link property attached |
7891 |
props (list 'mouse-face 'highlight |
props (list 'mouse-face 'highlight |
7892 |
km-prop idlwave-rinfo-mouse-map |
km-prop idlwave-rinfo-mouse-map |
7893 |
'data (cons 'keyword data) |
'data (cons 'keyword data) |
7894 |
'help-echo help-echo-kwd |
'help-echo help-echo-kwd |
7895 |
'keyword (car x))) |
'keyword (car x))) |
7896 |
(if have-sysdoc (setq props (append (list 'face face) props))) |
(if system (setq props (append (list 'face face) props))) |
7897 |
(insert (car x)) |
(insert (car x)) |
7898 |
(add-text-properties beg (point) props) |
(add-text-properties beg (point) props) |
7899 |
(setq col (+ col 1 (length (car x))))) |
(setq col (+ col 1 (length (car x))))) |
7900 |
keywords)) |
keywords)) |
7901 |
|
|
7902 |
(setq cnt 1 total (length all)) |
(setq cnt 1 total (length all)) |
7903 |
|
;; Here entry is (key file (list of type-conses)) |
7904 |
(while (setq entry (pop all)) |
(while (setq entry (pop all)) |
7905 |
(setq props (list 'mouse-face 'highlight |
(setq props (list 'mouse-face 'highlight |
7906 |
km-prop idlwave-rinfo-mouse-map |
km-prop idlwave-rinfo-mouse-map |
7907 |
'help-echo help-echo-src |
'help-echo help-echo-src |
7908 |
'source (cons (car (nth 2 entry)) (nth 1 entry)) |
'source (list (car (car (nth 2 entry))) ;type |
7909 |
|
(nth 1 entry) |
7910 |
|
nil |
7911 |
|
(cdr (car (nth 2 entry)))) |
7912 |
'data (cons 'source data))) |
'data (cons 'source data))) |
7913 |
(idlwave-insert-source-location |
(idlwave-insert-source-location |
7914 |
(format "\n%-8s %s" |
(format "\n%-8s %s" |
7915 |
(if (equal cnt 1) |
(if (equal cnt 1) |
7916 |
(if (> total 1) "Sources:" "Source:") |
(if (> total 1) "Sources:" "Source:") |
7917 |
"") |
"") |
7920 |
(incf cnt) |
(incf cnt) |
7921 |
(when (and all (> cnt idlwave-rinfo-max-source-lines)) |
(when (and all (> cnt idlwave-rinfo-max-source-lines)) |
7922 |
;; No more source lines, please |
;; No more source lines, please |
7923 |
(insert (format |
(insert (format |
7924 |
"\n Source information truncated to %d entries." |
"\n Source information truncated to %d entries." |
7925 |
idlwave-rinfo-max-source-lines)) |
idlwave-rinfo-max-source-lines)) |
7926 |
(setq all nil))) |
(setq all nil))) |
7927 |
|
(beginning-of-buffer) |
7928 |
(setq buffer-read-only t)) |
(setq buffer-read-only t)) |
7929 |
(display-buffer "*Help*") |
(display-buffer "*Help*") |
7930 |
(if (and (setq win (get-buffer-window "*Help*")) |
(if (and (setq win (get-buffer-window "*Help*")) |
7934 |
(unwind-protect |
(unwind-protect |
7935 |
(progn |
(progn |
7936 |
(select-window win) |
(select-window win) |
7937 |
(enlarge-window (- (/ (frame-height) 2) |
(enlarge-window (- (/ (frame-height) 2) |
7938 |
(window-height))) |
(window-height))) |
7939 |
(shrink-window-if-larger-than-buffer)) |
(shrink-window-if-larger-than-buffer)) |
7940 |
(select-window ww))))))))) |
(select-window ww))))))))) |
7941 |
|
|
7942 |
(defun idlwave-insert-source-location (prefix entry &optional file-props) |
(defun idlwave-insert-source-location (prefix entry &optional file-props) |
7943 |
"Insert a source location into the routine info buffer. |
"Insert a source location into the routine info buffer. |
7944 |
Start line with PREFIX. |
Start line with PREFIX. If a file name is inserted, add FILE-PROPS to |
7945 |
If a file name is inserted, add FILE-PROPS to it." |
it." |
|
|
|
7946 |
(let* ((key (car entry)) |
(let* ((key (car entry)) |
7947 |
(file (nth 1 entry)) |
(file (nth 1 entry)) |
7948 |
(types (nth 2 entry)) |
(types (nth 2 entry)) |
7949 |
(shell-flag (member 'compiled types)) |
(shell-flag (assq 'compiled types)) |
7950 |
(buffer-flag (member 'buffer types)) |
(buffer-flag (assq 'buffer types)) |
7951 |
(lib-flag (member 'lib types)) |
(user-flag (assq 'user types)) |
7952 |
(ndupl (or (and buffer-flag (idlwave-count-eq 'buffer types)) |
(lib-flag (assq 'lib types)) |
7953 |
(and lib-flag (idlwave-count-eq 'lib types)) |
(ndupl (or (and buffer-flag (idlwave-count-memq 'buffer types)) |
7954 |
|
(and user-flag (idlwave-count-memq 'user types)) |
7955 |
|
(and lib-flag (idlwave-count-memq 'lib types)) |
7956 |
1)) |
1)) |
7957 |
(doflags t) |
(doflags t) |
7958 |
beg special) |
beg special) |
7962 |
(cond |
(cond |
7963 |
((eq key 'system) |
((eq key 'system) |
7964 |
(setq doflags nil) |
(setq doflags nil) |
7965 |
(insert "System ")) |
(insert "System ")) |
7966 |
|
|
7967 |
((eq key 'builtin) |
((eq key 'builtin) |
7968 |
(setq doflags nil) |
(setq doflags nil) |
7969 |
(insert "Builtin ")) |
(insert "Builtin ")) |
7970 |
|
|
7971 |
((and (not file) shell-flag) |
((and (not file) shell-flag) |
7972 |
(insert "Unresolved")) |
(insert "Unresolved")) |
7973 |
((null file) (insert "ERROR")) |
|
7974 |
((setq special (idlwave-special-lib-test file)) |
((null file) |
7975 |
(insert (format "%-10s" special))) |
(insert "ERROR")) |
7976 |
|
|
7977 |
((idlwave-syslib-p file) |
((idlwave-syslib-p file) |
7978 |
(if (string-match "obsolete" (file-name-directory file)) |
(if (string-match "obsolete" (file-name-directory file)) |
7979 |
(insert "Obsolete ") |
(insert "Obsolete ") |
7980 |
(insert "SystemLib "))) |
(insert "SystemLib "))) |
7981 |
|
|
7982 |
|
;; New special syntax: taken directly from routine-info for |
7983 |
|
;; library catalog routines |
7984 |
|
((setq special (or (cdr lib-flag) (cdr user-flag))) |
7985 |
|
(insert (format "%-10s" special))) |
7986 |
|
|
7987 |
|
;; Old special syntax: a matching regexp |
7988 |
|
((setq special (idlwave-special-lib-test file)) |
7989 |
|
(insert (format "%-10s" special))) |
7990 |
|
|
7991 |
|
;; Catch-all with file |
7992 |
((idlwave-lib-p file) (insert "Library ")) |
((idlwave-lib-p file) (insert "Library ")) |
7993 |
|
|
7994 |
|
;; Sanity catch all |
7995 |
(t (insert "Other "))) |
(t (insert "Other "))) |
7996 |
|
|
7997 |
(when doflags |
(when doflags |
7998 |
(insert (concat |
(insert (concat |
7999 |
" [" |
" [" |
8000 |
(if lib-flag "C" "-") |
(if lib-flag "L" "-") |
8001 |
|
(if user-flag "C" "-") |
8002 |
(if shell-flag "S" "-") |
(if shell-flag "S" "-") |
8003 |
(if buffer-flag "B" "-") |
(if buffer-flag "B" "-") |
8004 |
"] "))) |
"] "))) |
8005 |
(when (> ndupl 1) |
(when (> ndupl 1) |
8006 |
(setq beg (point)) |
(setq beg (point)) |
8007 |
(insert (format "(%dx) " ndupl)) |
(insert (format "(%dx) " ndupl)) |
8008 |
(add-text-properties beg (point) (list 'face 'bold))) |
(add-text-properties beg (point) (list 'face 'bold))) |
8026 |
alist nil))) |
alist nil))) |
8027 |
rtn) |
rtn) |
8028 |
(t nil)))) |
(t nil)))) |
8029 |
|
|
8030 |
(defun idlwave-mouse-active-rinfo-right (ev) |
(defun idlwave-mouse-active-rinfo-right (ev) |
8031 |
(interactive "e") |
(interactive "e") |
8032 |
(idlwave-mouse-active-rinfo ev 'right)) |
(idlwave-mouse-active-rinfo ev 'right)) |
8045 |
was pressed." |
was pressed." |
8046 |
(interactive "e") |
(interactive "e") |
8047 |
(if ev (mouse-set-point ev)) |
(if ev (mouse-set-point ev)) |
8048 |
(let (data id name type class buf keyword bufwin source word initial-class) |
(let (data id name type class buf bufwin source word initial-class) |
8049 |
(setq data (get-text-property (point) 'data) |
(setq data (get-text-property (point) 'data) |
8050 |
source (get-text-property (point) 'source) |
source (get-text-property (point) 'source) |
8051 |
keyword (get-text-property (point) 'keyword) |
keyword (get-text-property (point) 'keyword) |
8052 |
|
link (get-text-property (point) 'link) |
8053 |
id (car data) |
id (car data) |
8054 |
name (nth 1 data) type (nth 2 data) class (nth 3 data) |
name (nth 1 data) type (nth 2 data) class (nth 3 data) |
8055 |
buf (nth 4 data) |
buf (nth 4 data) |
8056 |
initial-class (nth 6 data) |
initial-class (nth 6 data) |
8057 |
word (idlwave-this-word) |
word (idlwave-this-word) |
8058 |
bufwin (get-buffer-window buf t)) |
bufwin (get-buffer-window buf t)) |
8059 |
(cond ((eq id 'class) |
|
8060 |
|
(cond ((eq id 'class) ; Switch class being displayed |
8061 |
(if (window-live-p bufwin) (select-window bufwin)) |
(if (window-live-p bufwin) (select-window bufwin)) |
8062 |
(idlwave-display-calling-sequence |
(idlwave-display-calling-sequence |
8063 |
(idlwave-sintern-method name) |
(idlwave-sintern-method name) |
8064 |
type (idlwave-sintern-class word) |
type (idlwave-sintern-class word) |
8065 |
initial-class)) |
initial-class)) |
8066 |
((eq id 'usage) |
((eq id 'usage) ; Online help on this routine |
8067 |
(idlwave-require-online-help) |
(idlwave-online-help link name type class)) |
8068 |
(idlwave-online-help nil name type class)) |
((eq id 'source) ; Source in help or buffer |
8069 |
((eq id 'source) |
(if right ; In help |
|
(if (and right (idlwave-help-directory)) |
|
8070 |
(let ((idlwave-extra-help-function 'idlwave-help-with-source) |
(let ((idlwave-extra-help-function 'idlwave-help-with-source) |
8071 |
(idlwave-help-source-try-header nil) |
(idlwave-help-source-try-header nil) |
8072 |
;; Fake idlwave-routines, to make help find the right entry |
;; Fake idlwave-routines so help will find the right entry |
8073 |
(idlwave-routines |
(idlwave-routines |
8074 |
(list (list (nth 1 data) (nth 2 data) (nth 3 data) source "")))) |
(list (list name type class source "")))) |
|
(idlwave-require-online-help) |
|
8075 |
(idlwave-help-get-special-help name type class nil)) |
(idlwave-help-get-special-help name type class nil)) |
8076 |
|
;; Otherwise just pop to the source |
8077 |
(setq idlwave-popup-source (not idlwave-popup-source)) |
(setq idlwave-popup-source (not idlwave-popup-source)) |
8078 |
(if idlwave-popup-source |
(if idlwave-popup-source |
8079 |
(condition-case err |
(condition-case err |
8088 |
(goto-char (marker-position idlwave-rinfo-marker))))) |
(goto-char (marker-position idlwave-rinfo-marker))))) |
8089 |
((eq id 'keyword) |
((eq id 'keyword) |
8090 |
(if right |
(if right |
8091 |
(progn |
(idlwave-online-help link name type class keyword) |
|
(idlwave-require-online-help) |
|
|
(idlwave-online-help nil name type class keyword)) |
|
8092 |
(idlwave-rinfo-insert-keyword keyword buf shift)))))) |
(idlwave-rinfo-insert-keyword keyword buf shift)))))) |
8093 |
|
|
8094 |
(defun idlwave-rinfo-insert-keyword (keyword buffer &optional shift) |
(defun idlwave-rinfo-insert-keyword (keyword buffer &optional shift) |
8102 |
(setq bwin (get-buffer-window buffer))) |
(setq bwin (get-buffer-window buffer))) |
8103 |
(if (eq (preceding-char) ?/) |
(if (eq (preceding-char) ?/) |
8104 |
(insert keyword) |
(insert keyword) |
8105 |
(unless (save-excursion |
(unless (save-excursion |
8106 |
(re-search-backward |
(re-search-backward |
8107 |
"[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" |
"[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" |
8108 |
(min (- (point) 100) (point-min)) t)) |
(min (- (point) 100) (point-min)) t)) |
8109 |
(insert ", ")) |
(insert ", ")) |
8110 |
(if shift (insert "/")) |
(if shift (insert "/")) |
8155 |
the load path in order to find a definition. The output of this |
the load path in order to find a definition. The output of this |
8156 |
command can be used to detect possible name clashes during this process." |
command can be used to detect possible name clashes during this process." |
8157 |
(idlwave-routines) ; Make sure everything is loaded. |
(idlwave-routines) ; Make sure everything is loaded. |
8158 |
(unless idlwave-library-routines |
(unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines) |
8159 |
(or (y-or-n-p |
(or (y-or-n-p |
8160 |
"You don't have a library catalog. Continue anyway? ") |
"You don't have any user or library catalogs. Continue anyway? ") |
8161 |
(error "Abort"))) |
(error "Abort"))) |
8162 |
(let* ((routines (append idlwave-system-routines |
(let* ((routines (append idlwave-system-routines |
8163 |
idlwave-compiled-routines |
idlwave-compiled-routines |
8164 |
idlwave-library-routines |
idlwave-library-catalog-routines |
8165 |
|
idlwave-user-catalog-routines |
8166 |
idlwave-buffer-routines |
idlwave-buffer-routines |
8167 |
nil)) |
nil)) |
8168 |
(km-prop (if (featurep 'xemacs) 'keymap 'local-map)) |
(km-prop (if (featurep 'xemacs) 'keymap 'local-map)) |
8169 |
(keymap (make-sparse-keymap)) |
(keymap (make-sparse-keymap)) |
8170 |
(props (list 'mouse-face 'highlight |
(props (list 'mouse-face 'highlight |
8171 |
km-prop keymap |
km-prop keymap |
8172 |
'help-echo "Mouse2: Find source")) |
'help-echo "Mouse2: Find source")) |
8173 |
(nroutines (length (or special-routines routines))) |
(nroutines (length (or special-routines routines))) |
8174 |
(step (/ nroutines 99)) |
(step (/ nroutines 99)) |
8175 |
(n 0) |
(n 0) |
8193 |
(message "Sorting routines...done") |
(message "Sorting routines...done") |
8194 |
|
|
8195 |
(define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) |
(define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) |
8196 |
(lambda (ev) |
(lambda (ev) |
8197 |
(interactive "e") |
(interactive "e") |
8198 |
(mouse-set-point ev) |
(mouse-set-point ev) |
8199 |
(apply 'idlwave-do-find-module |
(apply 'idlwave-do-find-module |
8200 |
(get-text-property (point) 'find-args)))) |
(get-text-property (point) 'find-args)))) |
8201 |
(define-key keymap [(return)] |
(define-key keymap [(return)] |
8202 |
(lambda () |
(lambda () |
8203 |
(interactive) |
(interactive) |
8204 |
(apply 'idlwave-do-find-module |
(apply 'idlwave-do-find-module |
8205 |
(get-text-property (point) 'find-args)))) |
(get-text-property (point) 'find-args)))) |
8222 |
;; Mark all twins as dealt with |
;; Mark all twins as dealt with |
8223 |
(setq done (append twins done)) |
(setq done (append twins done)) |
8224 |
(when (or (> (length dtwins) 1) |
(when (or (> (length dtwins) 1) |
8225 |
(> (idlwave-count-eq 'lib (nth 2 (car dtwins))) 1) |
(> (idlwave-count-memq 'lib (nth 2 (car dtwins))) 1) |
8226 |
(> (idlwave-count-eq 'buffer (nth 2 (car dtwins))) 1)) |
(> (idlwave-count-memq 'user (nth 2 (car dtwins))) 1) |
8227 |
|
(> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1)) |
8228 |
(incf cnt) |
(incf cnt) |
8229 |
(insert (format "\n%s%s" |
(insert (format "\n%s%s" |
8230 |
(idlwave-make-full-name (nth 2 routine) (car routine)) |
(idlwave-make-full-name (nth 2 routine) |
8231 |
|
(car routine)) |
8232 |
(if (eq (nth 1 routine) 'fun) "()" ""))) |
(if (eq (nth 1 routine) 'fun) "()" ""))) |
8233 |
(while (setq twin (pop dtwins)) |
(while (setq twin (pop dtwins)) |
8234 |
(setq props1 (append (list 'find-args |
(setq props1 (append (list 'find-args |
8235 |
(list (nth 0 routine) |
(list (nth 0 routine) |
8236 |
(nth 1 routine) |
(nth 1 routine) |
8237 |
(nth 2 routine) |
(nth 2 routine))) |
|
(cons 'lib (nth 1 twin)))) |
|
8238 |
props)) |
props)) |
8239 |
(idlwave-insert-source-location "\n - " twin props1)))) |
(idlwave-insert-source-location "\n - " twin props1)))) |
8240 |
(goto-char (point-min)) |
(goto-char (point-min)) |
8250 |
(defun idlwave-print-source (routine) |
(defun idlwave-print-source (routine) |
8251 |
(let* ((source (nth 3 routine)) |
(let* ((source (nth 3 routine)) |
8252 |
(stype (car source)) |
(stype (car source)) |
8253 |
(sfile (cdr source))) |
(sfile (idlwave-routine-source-file source))) |
8254 |
(if (and (eq stype 'lib) sfile) |
(if (idlwave-syslib-p sfile) (setq stype 'syslib)) |
|
(progn |
|
|
(setq sfile (idlwave-expand-lib-file-name sfile)) |
|
|
(if (idlwave-syslib-p sfile) (setq stype 'syslib)))) |
|
8255 |
(if (and (eq stype 'compiled) |
(if (and (eq stype 'compiled) |
8256 |
(or (not (stringp sfile)) |
(or (not (stringp sfile)) |
8257 |
(not (string-match "\\S-" sfile)))) |
(not (string-match "\\S-" sfile)))) |
8258 |
(setq stype 'unresolved)) |
(setq stype 'unresolved)) |
8259 |
(princ (format " %-10s %s\n" |
(princ (format " %-10s %s\n" |
8260 |
stype |
stype |
8261 |
(if sfile sfile "No source code available"))))) |
(if sfile sfile "No source code available"))))) |
8262 |
|
|
8275 |
(eq type (nth 1 candidate)) |
(eq type (nth 1 candidate)) |
8276 |
(eq class (nth 2 candidate))) |
(eq class (nth 2 candidate))) |
8277 |
(push candidate twins))) |
(push candidate twins))) |
8278 |
(if (setq candidate (idlwave-rinfo-assq name type class |
(if (setq candidate (idlwave-rinfo-assq name type class |
8279 |
idlwave-unresolved-routines)) |
idlwave-unresolved-routines)) |
8280 |
(push candidate twins)) |
(push candidate twins)) |
8281 |
(cons entry (nreverse twins)))) |
(cons entry (nreverse twins)))) |
8282 |
|
|
8283 |
(defun idlwave-study-twins (entries) |
(defun idlwave-study-twins (entries) |
8284 |
"Return dangerous twins of first entry in TWINS. |
"Return dangerous twins of first entry in ENTRIES. |
8285 |
Dangerous twins are routines with same name, but in different files |
Dangerous twins are routines with same name, but in different files on |
8286 |
on the load path. |
the load path. If a file is in the system library and has an entry in |
8287 |
If a file is in the system library and has an entry in the |
the `idlwave-system-routines' list, we omit the latter as |
8288 |
`idlwave-system-routines' list, we omit the latter because many IDL |
non-dangerous because many IDL routines are implemented as library |
8289 |
routines are implemented as library routines." |
routines, and may have been scanned." |
8290 |
(let* ((entry (car entries)) |
(let* ((entry (car entries)) |
8291 |
(name (car entry)) ; |
(name (car entry)) ; |
8292 |
(type (nth 1 entry)) ; Must be bound for |
(type (nth 1 entry)) ; Must be bound for |
8293 |
(class (nth 2 entry)) ; idlwave-routine-twin-compare |
(class (nth 2 entry)) ; idlwave-routine-twin-compare |
8294 |
(cnt 0) |
(cnt 0) |
8295 |
source type file thefile alist syslibp key) |
source type type-cons file alist syslibp key) |
8296 |
(while (setq entry (pop entries)) |
(while (setq entry (pop entries)) |
8297 |
(incf cnt) |
(incf cnt) |
8298 |
(setq source (nth 3 entry) |
(setq source (nth 3 entry) |
8299 |
type (car source) |
type (car source) |
8300 |
file (cdr source)) |
type-cons (cons type (nth 3 source)) |
8301 |
(if (eq type 'lib) |
file (idlwave-routine-source-file source)) |
8302 |
(setq file (idlwave-expand-lib-file-name file))) |
|
8303 |
;; Make KEY to index entry properly |
;; Make KEY to index entry properly |
8304 |
(setq key (cond ((eq type 'system) type) |
(setq key (cond ((eq type 'system) type) |
8305 |
(file (file-truename file)) |
(file (file-truename file)) |
8306 |
(t 'unresolved))) |
(t 'unresolved))) |
8307 |
(if (and file |
|
8308 |
|
;; Check for an entry in the system library |
8309 |
|
(if (and file |
8310 |
(not syslibp) |
(not syslibp) |
8311 |
(idlwave-syslib-p file)) |
(idlwave-syslib-p file)) |
|
;; We do have an entry in the system library |
|
8312 |
(setq syslibp t)) |
(setq syslibp t)) |
8313 |
|
|
8314 |
(setq thefile (or thefile file)) |
;; If there's more than one matching entry for the same file, just |
8315 |
|
;; append the type-cons to the type list. |
8316 |
(if (setq entry (assoc key alist)) |
(if (setq entry (assoc key alist)) |
8317 |
(push type (nth 2 entry)) |
(push type-cons (nth 2 entry)) |
8318 |
(push (list key file (list type)) alist))) |
(push (list key file (list type-cons)) alist))) |
8319 |
|
|
8320 |
(setq alist (nreverse alist)) |
(setq alist (nreverse alist)) |
8321 |
|
|
8322 |
(when syslibp |
(when syslibp |
8323 |
;; File is system *library* - remove any system entry |
;; File is in system *library* - remove any 'system entry |
8324 |
(setq alist (delq (assoc 'system alist) alist))) |
(setq alist (delq (assq 'system alist) alist))) |
8325 |
|
|
8326 |
|
;; If 'system remains and we've scanned the syslib, it's a builtin |
8327 |
|
;; (rather than a !DIR/lib/.pro file bundled as source). |
8328 |
(when (and (idlwave-syslib-scanned-p) |
(when (and (idlwave-syslib-scanned-p) |
8329 |
(setq entry (assoc 'system alist))) |
(setq entry (assoc 'system alist))) |
8330 |
(setcar entry 'builtin)) |
(setcar entry 'builtin)) |
8359 |
((not (eq type (nth 1 b))) |
((not (eq type (nth 1 b))) |
8360 |
;; Type decides |
;; Type decides |
8361 |
(< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) |
(< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) |
8362 |
(t |
(t |
8363 |
;; A and B are twins - so the decision is more complicated. |
;; A and B are twins - so the decision is more complicated. |
8364 |
;; Call twin-compare with the proper arguments. |
;; Call twin-compare with the proper arguments. |
8365 |
(idlwave-routine-entry-compare-twins a b))))) |
(idlwave-routine-entry-compare-twins a b))))) |
8366 |
|
|
8367 |
(defun idlwave-routine-entry-compare-twins (a b) |
(defun idlwave-routine-entry-compare-twins (a b) |
8368 |
"Compare two routine entries, under the assumption that they are twins. |
"Compare two routine entries, under the assumption that they are |
8369 |
This basically calles `idlwave-routine-twin-compare' with the correct args." |
twins. This basically calls `idlwave-routine-twin-compare' with the |
8370 |
(let ((name (car a)) (type (nth 1 a)) (class (nth 2 a)) ; needed outside |
correct args." |
8371 |
(atype (car (nth 3 a))) |
(let* ((name (car a)) (type (nth 1 a)) (class (nth 2 a)) ; needed outside |
8372 |
(btype (car (nth 3 b))) |
(asrc (nth 3 a)) |
8373 |
(afile (cdr (nth 3 a))) |
(atype (car asrc)) |
8374 |
(bfile (cdr (nth 3 b)))) |
(bsrc (nth 3 b)) |
8375 |
(if (eq atype 'lib) |
(btype (car bsrc)) |
8376 |
(setq afile (idlwave-expand-lib-file-name afile))) |
(afile (idlwave-routine-source-file asrc)) |
8377 |
(if (eq btype 'lib) |
(bfile (idlwave-routine-source-file bsrc))) |
|
(setq bfile (idlwave-expand-lib-file-name bfile))) |
|
8378 |
(idlwave-routine-twin-compare |
(idlwave-routine-twin-compare |
8379 |
(if (stringp afile) |
(if (stringp afile) |
8380 |
(list (file-truename afile) afile (list atype)) |
(list (file-truename afile) afile (list atype)) |
8409 |
(bbufp (memq 'buffer btypes)) |
(bbufp (memq 'buffer btypes)) |
8410 |
;; On search path? |
;; On search path? |
8411 |
(tpath-alist (idlwave-true-path-alist)) |
(tpath-alist (idlwave-true-path-alist)) |
8412 |
(apathp (assoc akey tpath-alist)) |
(apathp (and (stringp akey) |
8413 |
(bpathp (assoc bkey tpath-alist)) |
(assoc (file-name-directory akey) tpath-alist))) |
8414 |
|
(bpathp (and (stringp bkey) |
8415 |
|
(assoc (file-name-directory bkey) tpath-alist))) |
8416 |
;; How early on search path? High number means early since we |
;; How early on search path? High number means early since we |
8417 |
;; measure the tail of the path list |
;; measure the tail of the path list |
8418 |
(anpath (length (memq apathp tpath-alist))) |
(anpath (length (memq apathp tpath-alist))) |
8446 |
((> anpath bnpath) t) ; Who is first on path? |
((> anpath bnpath) t) ; Who is first on path? |
8447 |
(t nil)))) ; Default |
(t nil)))) ; Default |
8448 |
|
|
8449 |
|
(defun idlwave-routine-source-file (source) |
8450 |
|
(if (nth 2 source) |
8451 |
|
(expand-file-name (nth 1 source) (nth 2 source)) |
8452 |
|
(nth 1 source))) |
8453 |
|
|
8454 |
(defun idlwave-downcase-safe (string) |
(defun idlwave-downcase-safe (string) |
8455 |
"Donwcase if string, else return unchanged." |
"Donwcase if string, else return unchanged." |
8456 |
(if (stringp string) |
(if (stringp string) |
8461 |
"How often is ELT in LIST?" |
"How often is ELT in LIST?" |
8462 |
(length (delq nil (mapcar (lambda (x) (eq x elt)) list)))) |
(length (delq nil (mapcar (lambda (x) (eq x elt)) list)))) |
8463 |
|
|
8464 |
|
(defun idlwave-count-memq (elt alist) |
8465 |
|
"How often is ELT a key in ALIST?" |
8466 |
|
(length (delq nil (mapcar (lambda (x) (eq (car x) elt)) alist)))) |
8467 |
|
|
8468 |
(defun idlwave-syslib-p (file) |
(defun idlwave-syslib-p (file) |
8469 |
"Non-nil of FILE is in the system library." |
"Non-nil if FILE is in the system library." |
8470 |
(let* ((true-syslib (file-name-as-directory |
(let* ((true-syslib (file-name-as-directory |
8471 |
(file-truename |
(file-truename |
8472 |
(expand-file-name "lib" (idlwave-sys-dir))))) |
(expand-file-name "lib" (idlwave-sys-dir))))) |
8478 |
(let ((true-dir (file-name-directory (file-truename file)))) |
(let ((true-dir (file-name-directory (file-truename file)))) |
8479 |
(assoc true-dir (idlwave-true-path-alist)))) |
(assoc true-dir (idlwave-true-path-alist)))) |
8480 |
|
|
8481 |
|
(defun idlwave-path-alist-add-flag (list-entry flag) |
8482 |
|
"Add a flag to the path list entry, if not set." |
8483 |
|
(let ((flags (cdr list-entry))) |
8484 |
|
(add-to-list 'flags flag) |
8485 |
|
(setcdr list-entry flags))) |
8486 |
|
|
8487 |
|
(defun idlwave-path-alist-remove-flag (list-entry flag) |
8488 |
|
"Remove a flag to the path list entry, if set." |
8489 |
|
(let ((flags (delq flag (cdr list-entry)))) |
8490 |
|
(setcdr list-entry flags))) |
8491 |
|
|
8492 |
(defun idlwave-true-path-alist () |
(defun idlwave-true-path-alist () |
8493 |
"Return `idlwave-path-alist' alist with true-names. |
"Return `idlwave-path-alist' alist with true-names. |
8494 |
Info is cached, but relies on the functons setting `idlwave-path-alist' |
Info is cached, but relies on the functions setting `idlwave-path-alist' |
8495 |
to reset the variable `idlwave-true-path-alist' to nil." |
to reset the variable `idlwave-true-path-alist' to nil." |
8496 |
(or idlwave-true-path-alist |
(or idlwave-true-path-alist |
8497 |
(setq idlwave-true-path-alist |
(setq idlwave-true-path-alist |
8537 |
(forward-sexp 2) |
(forward-sexp 2) |
8538 |
(forward-sexp -1) |
(forward-sexp -1) |
8539 |
(let ((begin (point))) |
(let ((begin (point))) |
8540 |
(re-search-forward "[a-zA-Z][a-zA-Z0-9$_]+\\(::[a-zA-Z][a-zA-Z0-9$_]+\\)?") |
(re-search-forward |
8541 |
|
"[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") |
8542 |
(if (fboundp 'buffer-substring-no-properties) |
(if (fboundp 'buffer-substring-no-properties) |
8543 |
(buffer-substring-no-properties begin (point)) |
(buffer-substring-no-properties begin (point)) |
8544 |
(buffer-substring begin (point))))) |
(buffer-substring begin (point))))) |
8554 |
'imenu) |
'imenu) |
8555 |
(error nil))))) |
(error nil))))) |
8556 |
|
|
8557 |
;; Here we kack func-menu.el in order to support this new mode. |
;; Here we hack func-menu.el in order to support this new mode. |
8558 |
;; The latest versions of func-menu.el already have this stuff in, so |
;; The latest versions of func-menu.el already have this stuff in, so |
8559 |
;; we hack only if it is not already there. |
;; we hack only if it is not already there. |
8560 |
(when (fboundp 'eval-after-load) |
(when (fboundp 'eval-after-load) |
8577 |
(start-process "idldeclient" nil |
(start-process "idldeclient" nil |
8578 |
idlwave-shell-explicit-file-name "-c" "-e" |
idlwave-shell-explicit-file-name "-c" "-e" |
8579 |
(buffer-file-name) "&")) |
(buffer-file-name) "&")) |
8580 |
|
|
8581 |
(defun idlwave-launch-idlhelp () |
(defun idlwave-launch-idlhelp () |
8582 |
"Start the IDLhelp application." |
"Start the IDLhelp application." |
8583 |
(interactive) |
(interactive) |
8584 |
(start-process "idlhelp" nil idlwave-help-application)) |
(start-process "idlhelp" nil idlwave-help-application)) |
8585 |
|
|
8586 |
;; Menus - using easymenu.el |
;; Menus - using easymenu.el |
8587 |
(defvar idlwave-mode-menu-def |
(defvar idlwave-mode-menu-def |
8588 |
`("IDLWAVE" |
`("IDLWAVE" |
8637 |
["9 Class Name" idlwave-complete-class t])) |
["9 Class Name" idlwave-complete-class t])) |
8638 |
("Routine Info" |
("Routine Info" |
8639 |
["Show Routine Info" idlwave-routine-info t] |
["Show Routine Info" idlwave-routine-info t] |
8640 |
["Online Context Help" idlwave-context-help (idlwave-help-directory)] |
["Online Context Help" idlwave-context-help t] |
8641 |
"--" |
"--" |
8642 |
["Find Routine Source" idlwave-find-module t] |
["Find Routine Source" idlwave-find-module t] |
8643 |
["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)] |
["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)] |
8644 |
"--" |
"--" |
8645 |
["Update Routine Info" idlwave-update-routine-info t] |
["Update Routine Info" idlwave-update-routine-info t] |
8646 |
"--" |
"--" |
8647 |
"IDL Library Catalog" |
"IDL User Catalog" |
8648 |
["Select Catalog Directories" (idlwave-create-libinfo-file nil) t] |
["Select Catalog Directories" (idlwave-create-user-catalog-file nil) t] |
8649 |
["Scan Directories" (idlwave-update-routine-info '(16)) |
["Scan Directories" (idlwave-update-routine-info '(16)) |
8650 |
(and idlwave-path-alist (not idlwave-catalog-process))] |
(and idlwave-path-alist (not idlwave-catalog-process))] |
8651 |
["Scan Directories &" (idlwave-update-routine-info '(64)) |
["Scan Directories &" (idlwave-update-routine-info '(64)) |
8669 |
("Customize" |
("Customize" |
8670 |
["Browse IDLWAVE Group" idlwave-customize t] |
["Browse IDLWAVE Group" idlwave-customize t] |
8671 |
"--" |
"--" |
8672 |
["Build Full Customize Menu" idlwave-create-customize-menu |
["Build Full Customize Menu" idlwave-create-customize-menu |
8673 |
(fboundp 'customize-menu-create)]) |
(fboundp 'customize-menu-create)]) |
8674 |
("Documentation" |
("Documentation" |
8675 |
["Describe Mode" describe-mode t] |
["Describe Mode" describe-mode t] |
8686 |
'("Debug" |
'("Debug" |
8687 |
["Start IDL shell" idlwave-shell t] |
["Start IDL shell" idlwave-shell t] |
8688 |
["Save and .RUN buffer" idlwave-shell-save-and-run |
["Save and .RUN buffer" idlwave-shell-save-and-run |
8689 |
(and (boundp 'idlwave-shell-automatic-start) |
(and (boundp 'idlwave-shell-automatic-start) |
8690 |
idlwave-shell-automatic-start)])) |
idlwave-shell-automatic-start)])) |
8691 |
|
|
8692 |
(if (or (featurep 'easymenu) (load "easymenu" t)) |
(if (or (featurep 'easymenu) (load "easymenu" t)) |
8693 |
(progn |
(progn |
8694 |
(easy-menu-define idlwave-mode-menu idlwave-mode-map |
(easy-menu-define idlwave-mode-menu idlwave-mode-map |
8695 |
"IDL and WAVE CL editing menu" |
"IDL and WAVE CL editing menu" |
8696 |
idlwave-mode-menu-def) |
idlwave-mode-menu-def) |
8697 |
(easy-menu-define idlwave-mode-debug-menu idlwave-mode-map |
(easy-menu-define idlwave-mode-debug-menu idlwave-mode-map |
8698 |
"IDL and WAVE CL editing menu" |
"IDL and WAVE CL editing menu" |
8699 |
idlwave-mode-debug-menu-def))) |
idlwave-mode-debug-menu-def))) |
8700 |
|
|
8701 |
(defun idlwave-customize () |
(defun idlwave-customize () |
8702 |
"Call the customize function with idlwave as argument." |
"Call the customize function with idlwave as argument." |
8703 |
(interactive) |
(interactive) |
8704 |
;; Try to load the code for the shell, so that we can customize it |
;; Try to load the code for the shell, so that we can customize it |
8705 |
;; as well. |
;; as well. |
8706 |
(or (featurep 'idlw-shell) |
(or (featurep 'idlw-shell) |
8707 |
(load "idlw-shell" t)) |
(load "idlw-shell" t)) |
8712 |
(interactive) |
(interactive) |
8713 |
(if (fboundp 'customize-menu-create) |
(if (fboundp 'customize-menu-create) |
8714 |
(progn |
(progn |
8715 |
;; Try to load the code for the shell, so that we can customize it |
;; Try to load the code for the shell, so that we can customize it |
8716 |
;; as well. |
;; as well. |
8717 |
(or (featurep 'idlw-shell) |
(or (featurep 'idlw-shell) |
8718 |
(load "idlw-shell" t)) |
(load "idlw-shell" t)) |
8719 |
(easy-menu-change |
(easy-menu-change |
8720 |
'("IDLWAVE") "Customize" |
'("IDLWAVE") "Customize" |
8721 |
`(["Browse IDLWAVE group" idlwave-customize t] |
`(["Browse IDLWAVE group" idlwave-customize t] |
8722 |
"--" |
"--" |
8764 |
(let ((table (symbol-value 'idlwave-mode-abbrev-table)) |
(let ((table (symbol-value 'idlwave-mode-abbrev-table)) |
8765 |
abbrevs |
abbrevs |
8766 |
str rpl func fmt (len-str 0) (len-rpl 0)) |
str rpl func fmt (len-str 0) (len-rpl 0)) |
8767 |
(mapatoms |
(mapatoms |
8768 |
(lambda (sym) |
(lambda (sym) |
8769 |
(if (symbol-value sym) |
(if (symbol-value sym) |
8770 |
(progn |
(progn |
8790 |
(with-output-to-temp-buffer "*Help*" |
(with-output-to-temp-buffer "*Help*" |
8791 |
(if arg |
(if arg |
8792 |
(progn |
(progn |
8793 |
(princ "Abbreviations and Actions in IDLWAVE-Mode\n") |
(princ "Abbreviations and Actions in IDLWAVE-Mode\n") |
8794 |
(princ "=========================================\n\n") |
(princ "=========================================\n\n") |
8795 |
(princ (format fmt "KEY" "REPLACE" "HOOK")) |
(princ (format fmt "KEY" "REPLACE" "HOOK")) |
8796 |
(princ (format fmt "---" "-------" "----"))) |
(princ (format fmt "---" "-------" "----"))) |
8813 |
;; Add .pro files to speedbar for support, if it's loaded |
;; Add .pro files to speedbar for support, if it's loaded |
8814 |
(eval-after-load "speedbar" '(speedbar-add-supported-extension ".pro")) |
(eval-after-load "speedbar" '(speedbar-add-supported-extension ".pro")) |
8815 |
|
|
|
;; Try to load online help, but catch any errors. |
|
|
(condition-case nil |
|
|
(idlwave-require-online-help) |
|
|
(error nil)) |
|
|
|
|
8816 |
;; Set an idle timer to load the routine info. |
;; Set an idle timer to load the routine info. |
8817 |
;; Will only work on systems which support this. |
;; Will only work on systems which support this. |
8818 |
(or idlwave-routines (idlwave-start-load-rinfo-timer)) |
(or idlwave-routines (idlwave-start-load-rinfo-timer)) |
8819 |
|
|
8820 |
|
;;;###autoload(add-to-list 'auto-mode-alist '("\\.[Pp][Rr][Oo]\\'" . idlwave-mode)) |
8821 |
|
|
8822 |
;; Run the hook |
;; Run the hook |
8823 |
(run-hooks 'idlwave-load-hook) |
(run-hooks 'idlwave-load-hook) |
8824 |
|
|
8825 |
(provide 'idlwave) |
(provide 'idlwave) |
8826 |
|
|
8827 |
;;; arch-tag: f77f3b0c-c37c-424f-a328-0886fd42b6fb |
;; arch-tag: f77f3b0c-c37c-424f-a328-0886fd42b6fb |
8828 |
;;; idlwave.el ends here |
;;; idlwave.el ends here |