Commit | Line | Data |
---|---|---|
52a244eb | 1 | ;; idlwave.el --- IDL editing mode for GNU Emacs |
d7a0267c | 2 | |
acaf905b | 3 | ;; Copyright (C) 1999-2012 Free Software Foundation, Inc. |
f32b3b91 | 4 | |
52a244eb | 5 | ;; Authors: J.D. Smith <jdsmith@as.arizona.edu> |
65363a4e | 6 | ;; Carsten Dominik <dominik@science.uva.nl> |
52a244eb | 7 | ;; Chris Chase <chase@att.com> |
5e72c6b2 | 8 | ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> |
bd78fa1d | 9 | ;; Version: 6.1.22 |
f32b3b91 CD |
10 | ;; Keywords: languages |
11 | ||
e8af40ee | 12 | ;; This file is part of GNU Emacs. |
f32b3b91 | 13 | |
b1fc2b50 | 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
f32b3b91 | 15 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
16 | ;; the Free Software Foundation, either version 3 of the License, or |
17 | ;; (at your option) any later version. | |
f32b3b91 CD |
18 | |
19 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 25 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
f32b3b91 CD |
26 | |
27 | ;;; Commentary: | |
28 | ||
f66f03de S |
29 | ;; IDLWAVE enables feature-rich development and interaction with IDL, |
30 | ;; the Interactive Data Language. It provides a compelling, | |
31 | ;; full-featured alternative to the IDLDE development environment | |
32 | ;; bundled with IDL. | |
3938cb82 | 33 | |
52a244eb S |
34 | ;; In the remotely distant past, based on pascal.el, though bears |
35 | ;; little resemblance to it now. | |
f32b3b91 CD |
36 | ;; |
37 | ;; Incorporates many ideas, such as abbrevs, action routines, and | |
38 | ;; continuation line indenting, from wave.el. | |
39 | ;; wave.el original written by Lubos Pochman, Precision Visuals, Boulder. | |
40 | ;; | |
41 | ;; See the mode description ("C-h m" in idlwave-mode or "C-h f idlwave-mode") | |
42 | ;; for features, key bindings, and info. | |
43 | ;; Also, Info format documentation is available with `M-x idlwave-info' | |
44 | ;; | |
5e72c6b2 S |
45 | ;; New versions of IDLWAVE, documentation, and more information |
46 | ;; available from: | |
47 | ;; http://idlwave.org | |
f32b3b91 CD |
48 | ;; |
49 | ;; INSTALLATION | |
50 | ;; ============ | |
51 | ;; | |
52 | ;; Follow the instructions in the INSTALL file of the distribution. | |
53 | ;; In short, put this file on your load path and add the following | |
54 | ;; lines to your .emacs file: | |
55 | ;; | |
56 | ;; (autoload 'idlwave-mode "idlwave" "IDLWAVE Mode" t) | |
8c7b4ec8 | 57 | ;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t) |
f32b3b91 CD |
58 | ;; (setq auto-mode-alist (cons '("\\.pro\\'" . idlwave-mode) auto-mode-alist)) |
59 | ;; | |
60 | ;; | |
61 | ;; SOURCE | |
62 | ;; ====== | |
63 | ;; | |
76959b77 | 64 | ;; The newest version of this file is available from the maintainer's |
52a244eb | 65 | ;; Webpage: |
f32b3b91 | 66 | ;; |
5e72c6b2 | 67 | ;; http://idlwave.org |
f32b3b91 CD |
68 | ;; |
69 | ;; DOCUMENTATION | |
70 | ;; ============= | |
71 | ;; | |
52a244eb S |
72 | ;; IDLWAVE is documented online in info format. A printable version |
73 | ;; of the documentation is available from the maintainers webpage (see | |
74 | ;; SOURCE). | |
775591f7 | 75 | ;; |
4b1aaa8b | 76 | ;; |
f32b3b91 CD |
77 | ;; ACKNOWLEDGMENTS |
78 | ;; =============== | |
79 | ;; | |
80 | ;; Thanks to the following people for their contributions and comments: | |
81 | ;; | |
52a244eb S |
82 | ;; Ulrik Dickow <dickow_at_nbi.dk> |
83 | ;; Eric E. Dors <edors_at_lanl.gov> | |
84 | ;; Stein Vidar H. Haugan <s.v.h.haugan_at_astro.uio.no> | |
85 | ;; David Huenemoerder <dph_at_space.mit.edu> | |
86 | ;; Kevin Ivory <Kevin.Ivory_at_linmpi.mpg.de> | |
87 | ;; Dick Jackson <dick_at_d-jackson.com> | |
88 | ;; Xuyong Liu <liu_at_stsci.edu> | |
89 | ;; Simon Marshall <Simon.Marshall_at_esrin.esa.it> | |
90 | ;; Laurent Mugnier <mugnier_at_onera.fr> | |
91 | ;; Lubos Pochman <lubos_at_rsinc.com> | |
92 | ;; Bob Portmann <portmann_at_al.noaa.gov> | |
93 | ;; Patrick M. Ryan <pat_at_jaameri.gsfc.nasa.gov> | |
94 | ;; Marty Ryba <ryba_at_ll.mit.edu> | |
95 | ;; Paul Sorenson <aardvark62_at_msn.com> | |
96 | ;; Phil Sterne <sterne_at_dublin.llnl.gov> | |
97 | ;; Phil Williams <williams_at_irc.chmcc.org> | |
f32b3b91 CD |
98 | ;; |
99 | ;; CUSTOMIZATION: | |
100 | ;; ============= | |
101 | ;; | |
52a244eb S |
102 | ;; IDLWAVE has extensive customize support; to learn about the |
103 | ;; variables which control the mode's behavior, use `M-x | |
104 | ;; idlwave-customize'. | |
f32b3b91 CD |
105 | ;; |
106 | ;; You can set your own preferred values with Customize, or with Lisp | |
107 | ;; code in .emacs. For an example of what to put into .emacs, check | |
52a244eb S |
108 | ;; the TexInfo documentation or see a complete .emacs available at the |
109 | ;; website. | |
f32b3b91 CD |
110 | ;; |
111 | ;; KNOWN PROBLEMS: | |
112 | ;; ============== | |
113 | ;; | |
76959b77 S |
114 | ;; IDLWAVE support for the IDL-derived PV-WAVE CL language of Visual |
115 | ;; Numerics, Inc. is growing less and less complete as the two | |
116 | ;; languages grow increasingly apart. The mode probably shouldn't | |
3938cb82 | 117 | ;; even have "WAVE" in its title, but it's catchy, and was required |
52a244eb | 118 | ;; to avoid conflict with the CORBA idl.el mode. Caveat WAVEor. |
76959b77 | 119 | ;; |
f32b3b91 CD |
120 | ;; Moving the point backwards in conjunction with abbrev expansion |
121 | ;; does not work as I would like it, but this is a problem with | |
122 | ;; emacs abbrev expansion done by the self-insert-command. It ends | |
123 | ;; up inserting the character that expanded the abbrev after moving | |
124 | ;; point backward, e.g., "\cl" expanded with a space becomes | |
125 | ;; "LONG( )" with point before the close paren. This is solved by | |
4b1aaa8b | 126 | ;; using a temporary function in `post-command-hook' - not pretty, |
595ab50b | 127 | ;; but it works. |
f32b3b91 CD |
128 | ;; |
129 | ;; Tabs and spaces are treated equally as whitespace when filling a | |
130 | ;; comment paragraph. To accomplish this, tabs are permanently | |
131 | ;; replaced by spaces in the text surrounding the paragraph, which | |
132 | ;; may be an undesirable side-effect. Replacing tabs with spaces is | |
133 | ;; limited to comments only and occurs only when a comment | |
134 | ;; paragraph is filled via `idlwave-fill-paragraph'. | |
135 | ;; | |
52a244eb S |
136 | ;; Muti-statement lines (using "&") on block begin and end lines can |
137 | ;; ruin the formatting. For example, multiple end statements on a | |
138 | ;; line: endif & endif. Using "&" outside of block begin/end lines | |
139 | ;; should be okay. | |
f32b3b91 | 140 | ;; |
76959b77 S |
141 | ;; Determining the expression at point for printing and other |
142 | ;; examination commands is somewhat rough: currently only fairly | |
143 | ;; simple entities are found. You can always drag-select or examine | |
52a244eb | 144 | ;; a pre-selected region. |
f32b3b91 | 145 | ;; |
f32b3b91 CD |
146 | ;; When forcing completion of method keywords, the initial |
147 | ;; query for a method has multiple entries for some methods. Would | |
595ab50b | 148 | ;; be too difficult to fix this hardly used case. |
f32b3b91 CD |
149 | ;; |
150 | \f | |
151 | ;;; Code: | |
152 | ||
52a244eb | 153 | |
f32b3b91 | 154 | (eval-when-compile (require 'cl)) |
52a244eb S |
155 | (require 'idlw-help) |
156 | ||
157 | ;; For XEmacs | |
158 | (unless (fboundp 'line-beginning-position) | |
159 | (defalias 'line-beginning-position 'point-at-bol)) | |
160 | (unless (fboundp 'line-end-position) | |
161 | (defalias 'line-end-position 'point-at-eol)) | |
162 | (unless (fboundp 'char-valid-p) | |
163 | (defalias 'char-valid-p 'characterp)) | |
f66f03de S |
164 | (unless (fboundp 'match-string-no-properties) |
165 | (defalias 'match-string-no-properties 'match-string)) | |
f32b3b91 | 166 | |
3938cb82 S |
167 | (if (not (fboundp 'cancel-timer)) |
168 | (condition-case nil | |
169 | (require 'timer) | |
170 | (error nil))) | |
171 | ||
73e72da4 DN |
172 | (declare-function idlwave-shell-get-path-info "idlw-shell") |
173 | (declare-function idlwave-shell-temp-file "idlw-shell") | |
174 | (declare-function idlwave-shell-is-running "idlw-shell") | |
175 | (declare-function widget-value "wid-edit" (widget)) | |
176 | (declare-function comint-dynamic-complete-filename "comint" ()) | |
73e72da4 | 177 | |
f32b3b91 | 178 | (defgroup idlwave nil |
31b58798 | 179 | "Major mode for editing IDL .pro files." |
f32b3b91 | 180 | :tag "IDLWAVE" |
4b1aaa8b | 181 | :link '(url-link :tag "Home Page" |
5e72c6b2 | 182 | "http://idlwave.org") |
595ab50b CD |
183 | :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" |
184 | "idlw-shell.el") | |
f32b3b91 CD |
185 | :link '(emacs-commentary-link :tag "Commentary in idlwave.el" "idlwave.el") |
186 | :link '(custom-manual "(idlwave)Top") | |
187 | :prefix "idlwave" | |
188 | :group 'languages) | |
189 | ||
52a244eb | 190 | |
f32b3b91 CD |
191 | ;;; Variables for indentation behavior --------------------------------------- |
192 | ||
193 | (defgroup idlwave-code-formatting nil | |
194 | "Indentation and formatting options for IDLWAVE mode." | |
195 | :group 'idlwave) | |
196 | ||
f66f03de | 197 | (defcustom idlwave-main-block-indent 2 |
fb7ada5f | 198 | "Extra indentation for the main block of code. |
f32b3b91 CD |
199 | That is the block between the FUNCTION/PRO statement and the END |
200 | statement for that program unit." | |
201 | :group 'idlwave-code-formatting | |
202 | :type 'integer) | |
203 | ||
f66f03de | 204 | (defcustom idlwave-block-indent 3 |
fb7ada5f | 205 | "Extra indentation applied to block lines. |
f32b3b91 CD |
206 | If you change this, you probably also want to change `idlwave-end-offset'." |
207 | :group 'idlwave-code-formatting | |
208 | :type 'integer) | |
209 | ||
f66f03de | 210 | (defcustom idlwave-end-offset -3 |
fb7ada5f | 211 | "Extra indentation applied to block END lines. |
f32b3b91 CD |
212 | A value equal to negative `idlwave-block-indent' will make END lines |
213 | line up with the block BEGIN lines." | |
214 | :group 'idlwave-code-formatting | |
215 | :type 'integer) | |
216 | ||
f66f03de | 217 | (defcustom idlwave-continuation-indent 3 |
fb7ada5f | 218 | "Extra indentation applied to continuation lines. |
f32b3b91 | 219 | This extra offset applies to the first of a set of continuation lines. |
5e72c6b2 S |
220 | The following lines receive the same indentation as the first." |
221 | :group 'idlwave-code-formatting | |
222 | :type 'integer) | |
223 | ||
f66f03de | 224 | (defcustom idlwave-max-extra-continuation-indent 40 |
fb7ada5f | 225 | "Maximum additional indentation for special continuation indent. |
5e72c6b2 S |
226 | Several special indentations are tried to help line up continuation |
227 | lines in routine calls or definitions, other statements with | |
134b6671 | 228 | parentheses, or assignment statements. This variable specifies a |
5e72c6b2 S |
229 | maximum amount by which this special indentation can exceed the |
230 | standard continuation indentation, otherwise defaulting to a fixed | |
231 | offset. Set to 0 to effectively disable all special continuation | |
232 | indentation, or to a large number (like 100) to enable it in all | |
52a244eb | 233 | cases. See also `idlwave-indent-to-open-paren', which can override |
5e72c6b2 | 234 | this variable." |
f32b3b91 CD |
235 | :group 'idlwave-code-formatting |
236 | :type 'integer) | |
237 | ||
5e72c6b2 | 238 | (defcustom idlwave-indent-to-open-paren t |
fb7ada5f | 239 | "Non-nil means, indent continuation lines to innermost open parenthesis. |
5a0c3f56 | 240 | This indentation occurs even if otherwise disallowed by |
5e72c6b2 S |
241 | `idlwave-max-extra-continuation-indent'. Matching parens and the |
242 | interleaving args are lined up. Example: | |
243 | ||
244 | x = function_a(function_b(function_c( a, b, [1,2,3, $ | |
245 | 4,5,6 $ | |
246 | ], $ | |
247 | c, d $ | |
248 | ))) | |
249 | ||
250 | When this variable is nil, paren alignment may still occur, based on | |
5a0c3f56 JB |
251 | the value of `idlwave-max-extra-continuation-indent', which, if zero, |
252 | would yield: | |
5e72c6b2 S |
253 | |
254 | x = function_a(function_b(function_c( a, b, [1,2,3, $ | |
255 | 4,5,6 $ | |
256 | ], $ | |
257 | c, d $ | |
258 | )))" | |
5a0c3f56 | 259 | :group 'idlwave-code-formatting |
5e72c6b2 S |
260 | :type 'boolean) |
261 | ||
52a244eb | 262 | (defcustom idlwave-indent-parens-nested nil |
fb7ada5f | 263 | "Non-nil means, indent continuation lines with parens by nesting |
52a244eb S |
264 | lines at consecutively deeper levels." |
265 | :group 'idlwave-code-formatting | |
266 | :type 'boolean) | |
267 | ||
268 | ||
f32b3b91 | 269 | (defcustom idlwave-hanging-indent t |
fb7ada5f | 270 | "If set non-nil then comment paragraphs are indented under the |
f32b3b91 CD |
271 | hanging indent given by `idlwave-hang-indent-regexp' match in the first line |
272 | of the paragraph." | |
273 | :group 'idlwave-code-formatting | |
274 | :type 'boolean) | |
275 | ||
276 | (defcustom idlwave-hang-indent-regexp "- " | |
fb7ada5f | 277 | "Regular expression matching the position of the hanging indent |
5a0c3f56 | 278 | in the first line of a comment paragraph. The size of the indent |
f32b3b91 CD |
279 | extends to the end of the match for the regular expression." |
280 | :group 'idlwave-code-formatting | |
281 | :type 'regexp) | |
282 | ||
283 | (defcustom idlwave-use-last-hang-indent nil | |
fb7ada5f | 284 | "If non-nil then use last match on line for `idlwave-indent-regexp'." |
f32b3b91 CD |
285 | :group 'idlwave-code-formatting |
286 | :type 'boolean) | |
287 | ||
288 | (defcustom idlwave-fill-comment-line-only t | |
fb7ada5f | 289 | "If non-nil then auto fill will only operate on comment lines." |
f32b3b91 CD |
290 | :group 'idlwave-code-formatting |
291 | :type 'boolean) | |
292 | ||
293 | (defcustom idlwave-auto-fill-split-string t | |
fb7ada5f | 294 | "If non-nil then auto fill will split strings with the IDL `+' operator. |
4b1aaa8b PE |
295 | When the line end falls within a string, string concatenation with the |
296 | '+' operator will be used to distribute a long string over lines. | |
f32b3b91 CD |
297 | If nil and a string is split then a terminal beep and warning are issued. |
298 | ||
299 | This variable is ignored when `idlwave-fill-comment-line-only' is | |
300 | non-nil, since in this case code is not auto-filled." | |
301 | :group 'idlwave-code-formatting | |
302 | :type 'boolean) | |
303 | ||
304 | (defcustom idlwave-split-line-string t | |
fb7ada5f | 305 | "If non-nil then `idlwave-split-line' will split strings with `+'. |
f32b3b91 CD |
306 | When the splitting point of a line falls inside a string, split the string |
307 | using the `+' string concatenation operator. If nil and a string is | |
308 | split then a terminal beep and warning are issued." | |
309 | :group 'idlwave-code-formatting | |
310 | :type 'boolean) | |
311 | ||
312 | (defcustom idlwave-no-change-comment ";;;" | |
fb7ada5f | 313 | "The indentation of a comment that starts with this regular |
5a0c3f56 | 314 | expression will not be changed. Note that the indentation of a comment |
f32b3b91 CD |
315 | at the beginning of a line is never changed." |
316 | :group 'idlwave-code-formatting | |
317 | :type 'string) | |
318 | ||
319 | (defcustom idlwave-begin-line-comment nil | |
fb7ada5f | 320 | "A comment anchored at the beginning of line. |
f32b3b91 CD |
321 | A comment matching this regular expression will not have its |
322 | indentation changed. If nil the default is \"^;\", i.e., any line | |
323 | beginning with a \";\". Expressions for comments at the beginning of | |
324 | the line should begin with \"^\"." | |
325 | :group 'idlwave-code-formatting | |
326 | :type '(choice (const :tag "Any line beginning with `;'" nil) | |
327 | 'regexp)) | |
328 | ||
329 | (defcustom idlwave-code-comment ";;[^;]" | |
fb7ada5f | 330 | "A comment that starts with this regular expression on a line by |
f32b3b91 CD |
331 | itself is indented as if it is a part of IDL code. As a result if |
332 | the comment is not preceded by whitespace it is unchanged." | |
333 | :group 'idlwave-code-formatting | |
334 | :type 'regexp) | |
335 | ||
336 | ;; Comments not matching any of the above will be indented as a | |
337 | ;; right-margin comment, i.e., to a minimum of `comment-column'. | |
338 | ||
f32b3b91 CD |
339 | ;;; Routine Info and Completion --------------------------------------- |
340 | ||
15e42531 CD |
341 | (defgroup idlwave-routine-info nil |
342 | "Routine Info options for IDLWAVE mode." | |
f32b3b91 CD |
343 | :group 'idlwave) |
344 | ||
52a244eb | 345 | (defcustom idlwave-use-library-catalogs t |
fb7ada5f | 346 | "Non-nil means search the IDL path for library catalog files. |
52a244eb S |
347 | |
348 | These files, named .idlwave_catalog, document routine information for | |
349 | individual directories and libraries of IDL .pro files. Many popular | |
5a0c3f56 JB |
350 | libraries come with catalog files by default, so leaving this on is |
351 | usually a good idea." | |
52a244eb S |
352 | :group 'idlwave-routine-info |
353 | :type 'boolean) | |
5e72c6b2 S |
354 | |
355 | (defcustom idlwave-init-rinfo-when-idle-after 10 | |
fb7ada5f | 356 | "Seconds of idle time before routine info is automatically initialized. |
5a0c3f56 JB |
357 | Initializing the routine info can take a long time, in particular if a |
358 | large number of library catalogs are involved. When Emacs is idle for | |
359 | more than the number of seconds specified by this variable, it starts | |
360 | the initialization. The process is split into five steps, in order to | |
361 | keep work interruption as short as possible. If one of the steps | |
362 | finishes, and no user input has arrived in the mean time, initialization | |
363 | proceeds immediately to the next step. A good value for this variable | |
364 | is about 1/3 of the time initialization take in your setup. So if you | |
365 | have a fast machine and no problems with a slow network connection, | |
366 | don't hesitate to set this to 2 seconds. A value of 0 means, don't | |
367 | initialize automatically, but instead wait until routine information is | |
368 | needed, and initialize then." | |
5e72c6b2 S |
369 | :group 'idlwave-routine-info |
370 | :type 'number) | |
371 | ||
f32b3b91 | 372 | (defcustom idlwave-scan-all-buffers-for-routine-info t |
fb7ada5f | 373 | "Non-nil means, scan buffers for IDL programs when updating info. |
15e42531 CD |
374 | The scanning is done by the command `idlwave-update-routine-info'. |
375 | The following values are allowed: | |
376 | ||
377 | nil Don't scan any buffers. | |
5a0c3f56 | 378 | t Scan all `idlwave-mode' buffers in the current editing session. |
15e42531 CD |
379 | current Scan only the current buffer, but no other buffers." |
380 | :group 'idlwave-routine-info | |
381 | :type '(choice | |
382 | (const :tag "No buffer" nil) | |
383 | (const :tag "All buffers" t) | |
384 | (const :tag "Current buffer only" 'current))) | |
f32b3b91 CD |
385 | |
386 | (defcustom idlwave-query-shell-for-routine-info t | |
fb7ada5f | 387 | "Non-nil means query the shell for info about compiled routines. |
f32b3b91 CD |
388 | Querying the shell is useful to get information about compiled modules, |
389 | and it is turned on by default. However, when you have a complete library | |
390 | scan, this is not necessary." | |
15e42531 | 391 | :group 'idlwave-routine-info |
f32b3b91 CD |
392 | :type 'boolean) |
393 | ||
15e42531 CD |
394 | (defcustom idlwave-auto-routine-info-updates |
395 | '(find-file save-buffer kill-buffer compile-buffer) | |
fb7ada5f | 396 | "Controls under what circumstances routine info is updated automatically. |
15e42531 CD |
397 | Possible values: |
398 | nil Never | |
399 | t All available | |
5a0c3f56 | 400 | \(...) A list of circumstances. Allowed members are: |
15e42531 CD |
401 | find-file Add info for new IDLWAVE buffers. |
402 | save-buffer Update buffer info when buffer is saved | |
403 | kill-buffer Remove buffer info when buffer gets killed | |
404 | compile-buffer Update shell info after `idlwave-shell-save-and...'" | |
405 | :group 'idlwave-routine-info | |
406 | :type '(choice | |
407 | (const :tag "Never" nil) | |
408 | (const :tag "As often as possible" t) | |
409 | (set :tag "Checklist" :greedy t | |
410 | (const :tag "When visiting a file" find-file) | |
411 | (const :tag "When saving a buffer" save-buffer) | |
412 | (const :tag "After a buffer was killed" kill-buffer) | |
413 | (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) | |
4b1aaa8b | 414 | |
15e42531 | 415 | (defcustom idlwave-rinfo-max-source-lines 5 |
fb7ada5f | 416 | "Maximum number of source files displayed in the Routine Info window. |
15e42531 | 417 | When an integer, it is the maximum number of source files displayed. |
5a0c3f56 | 418 | A value of t means to show all source files." |
15e42531 CD |
419 | :group 'idlwave-routine-info |
420 | :type 'integer) | |
421 | ||
f32b3b91 | 422 | (defcustom idlwave-library-path nil |
8c43762b | 423 | "Library path for Windows and MacOS (OS9). Not needed under UNIX. |
f66f03de S |
424 | When selecting the directories to scan for IDL user catalog routine |
425 | info, IDLWAVE can, under UNIX, query the shell for the exact search | |
426 | path \(the value of !PATH). However, under Windows and MacOS | |
8c43762b | 427 | \(pre-OSX), the IDLWAVE shell does not work. In this case, this |
f66f03de S |
428 | variable can be set to specify the paths where IDLWAVE can find PRO |
429 | files. The shell will only be asked for a list of paths when this | |
430 | variable is nil. The value is a list of directories. A directory | |
97610156 | 431 | preceded by a `+' will be searched recursively. If you set this |
f66f03de S |
432 | variable on a UNIX system, the shell will not be queried. See also |
433 | `idlwave-system-directory'." | |
15e42531 | 434 | :group 'idlwave-routine-info |
f32b3b91 CD |
435 | :type '(repeat (directory))) |
436 | ||
15e42531 | 437 | (defcustom idlwave-system-directory "" |
52a244eb S |
438 | "The IDL system directory for Windows and MacOS. Not needed under |
439 | UNIX. Set this to the value of the `!DIR' system variable in IDL. | |
440 | IDLWAVE uses this to find out which of the library routines belong to | |
441 | the official system library. All files inside the `lib' subdirectory | |
442 | are considered system library files - so don't install private stuff | |
443 | in this directory. On UNIX systems, IDLWAVE queries the shell for the | |
444 | value of `!DIR'. See also `idlwave-library-path'." | |
15e42531 CD |
445 | :group 'idlwave-routine-info |
446 | :type 'directory) | |
447 | ||
f66f03de | 448 | ;; Configuration files |
4b1aaa8b | 449 | (defcustom idlwave-config-directory |
52a244eb | 450 | (convert-standard-filename "~/.idlwave") |
fb7ada5f | 451 | "Directory for configuration files and user-library catalog." |
15e42531 | 452 | :group 'idlwave-routine-info |
f32b3b91 CD |
453 | :type 'file) |
454 | ||
52a244eb | 455 | (defvar idlwave-user-catalog-file "idlusercat.el") |
f66f03de | 456 | (defvar idlwave-xml-system-rinfo-converted-file "idl_xml_rinfo.el") |
52a244eb S |
457 | (defvar idlwave-path-file "idlpath.el") |
458 | ||
15e42531 CD |
459 | (defcustom idlwave-special-lib-alist nil |
460 | "Alist of regular expressions matching special library directories. | |
461 | When listing routine source locations, IDLWAVE gives a short hint where | |
4b1aaa8b | 462 | the file defining the routine is located. By default it lists `SystemLib' |
15e42531 CD |
463 | for routines in the system library `!DIR/lib' and `Library' for anything |
464 | else. This variable can define additional types. The car of each entry | |
465 | is a regular expression matching the file name (they normally will match | |
466 | on the path). The cdr is the string to be used as identifier. Max 10 | |
467 | chars are allowed." | |
468 | :group 'idlwave-routine-info | |
469 | :type '(repeat | |
470 | (cons regexp string))) | |
471 | ||
52a244eb | 472 | (defcustom idlwave-auto-write-paths t |
4b1aaa8b | 473 | "Write out path (!PATH) and system directory (!DIR) info automatically. |
52a244eb S |
474 | Path info is needed to locate library catalog files. If non-nil, |
475 | whenever the path-list changes as a result of shell-query, etc., it is | |
476 | written to file. Otherwise, the menu option \"Write Paths\" can be | |
477 | used to force a write." | |
478 | :group 'idlwave-routine-info | |
05a1abfc | 479 | :type 'boolean) |
775591f7 | 480 | |
15e42531 CD |
481 | (defgroup idlwave-completion nil |
482 | "Completion options for IDLWAVE mode." | |
483 | :prefix "idlwave" | |
484 | :group 'idlwave) | |
485 | ||
f32b3b91 CD |
486 | (eval-and-compile |
487 | (defconst idlwave-tmp | |
488 | '(choice :tag "by applying the function" | |
489 | (const upcase) | |
490 | (const downcase) | |
491 | (const capitalize) | |
492 | (const preserve) | |
493 | (symbol :tag "Other")))) | |
494 | ||
f32b3b91 CD |
495 | (defcustom idlwave-completion-case '((routine . upcase) |
496 | (keyword . upcase) | |
497 | (class . preserve) | |
498 | (method . preserve)) | |
499 | "Association list setting the case of completed words. | |
500 | ||
501 | This variable determines the case (UPPER/lower/Capitalized...) of | |
502 | words inserted into the buffer by completion. The preferred case can | |
503 | be specified separately for routine names, keywords, classes and | |
4b1aaa8b | 504 | methods. |
f32b3b91 CD |
505 | This alist should therefore have entries for `routine' (normal |
506 | functions and procedures, i.e. non-methods), `keyword', `class', and | |
507 | `method'. Plausible values are | |
508 | ||
509 | upcase upcase whole word, like `BOX_CURSOR' | |
510 | downcase downcase whole word, like `read_ppm' | |
511 | capitalize capitalize each part, like `Widget_Control' | |
512 | preserve preserve case as is, like `IDLgrView' | |
513 | ||
514 | The value can also be any Emacs Lisp function which transforms the | |
515 | case of characters in a string. | |
516 | ||
517 | A value of `preserve' means that the case of the completed word is | |
518 | identical to the way it was written in the definition statement of the | |
519 | routine. This was implemented to allow for mixed-case completion, in | |
520 | particular of object classes and methods. | |
521 | If a completable word is defined in multiple locations, the meaning of | |
522 | `preserve' is not unique since the different definitions might be | |
523 | cased differently. Therefore IDLWAVE always takes the case of the | |
524 | *first* definition it encounters during routine info collection and | |
525 | uses the case derived from it consistently. | |
526 | ||
527 | Note that a lowercase-only string in the buffer will always be completed in | |
528 | lower case (but see the variable `idlwave-completion-force-default-case'). | |
529 | ||
530 | After changing this variable, you need to either restart Emacs or press | |
531 | `C-u C-c C-i' to update the internal lists." | |
15e42531 | 532 | :group 'idlwave-completion |
f32b3b91 CD |
533 | :type `(repeat |
534 | (cons (symbol :tag "Derive completion case for") | |
535 | ,idlwave-tmp))) | |
536 | ||
537 | (defcustom idlwave-completion-force-default-case nil | |
fb7ada5f | 538 | "Non-nil means, completion will always honor `idlwave-completion-case'. |
f32b3b91 CD |
539 | When nil, only the completion of a mixed case or upper case string |
540 | will honor the default settings in `idlwave-completion-case', while | |
541 | the completion of lower case strings will be completed entirely in | |
542 | lower case." | |
15e42531 | 543 | :group 'idlwave-completion |
f32b3b91 CD |
544 | :type 'boolean) |
545 | ||
546 | (defcustom idlwave-complete-empty-string-as-lower-case nil | |
fb7ada5f | 547 | "Non-nil means, the empty string is considered downcase for completion. |
f32b3b91 CD |
548 | The case of what is already in the buffer determines the case of completions. |
549 | When this variable is non-nil, the empty string is considered to be downcase. | |
550 | Completing on the empty string then offers downcase versions of the possible | |
551 | completions." | |
15e42531 | 552 | :group 'idlwave-completion |
f32b3b91 CD |
553 | :type 'boolean) |
554 | ||
f32b3b91 | 555 | (defcustom idlwave-buffer-case-takes-precedence nil |
fb7ada5f | 556 | "Non-nil means, the case of tokens in buffers dominates over system stuff. |
f32b3b91 CD |
557 | To make this possible, we need to re-case everything each time we update |
558 | the routine info from the buffers. This is slow. | |
559 | The default is to consider the case given in the system and library files | |
560 | first which makes updating much faster." | |
15e42531 CD |
561 | :group 'idlwave-completion |
562 | :type 'boolean) | |
563 | ||
564 | (defcustom idlwave-highlight-help-links-in-completion t | |
fb7ada5f | 565 | "Non-nil means, highlight completions for which system help is available. |
15e42531 CD |
566 | Help can then be accessed with mouse-3. |
567 | This option is only effective when the online help system is installed." | |
568 | :group 'idlwave-completion | |
f32b3b91 CD |
569 | :type 'boolean) |
570 | ||
05a1abfc CD |
571 | (defcustom idlwave-support-inheritance t |
572 | "Non-nil means, treat inheritance with completion, online help etc. | |
cef6cafe | 573 | When nil, IDLWAVE only knows about the native methods and tags of a class, |
05a1abfc CD |
574 | not about inherited ones." |
575 | :group 'idlwave-routine-info | |
576 | :type 'boolean) | |
577 | ||
5e72c6b2 S |
578 | (defcustom idlwave-keyword-class-inheritance '("^[gs]etproperty$" "^init$") |
579 | "List of regular expressions for class-driven keyword inheritance. | |
580 | Keyword inheritance is often tied to class inheritance by \"chaining\" | |
581 | up the class tree. While it cannot be assumed that the presence of an | |
582 | _EXTRA or _REF_EXTRA symbol guarantees such chaining will occur, for | |
583 | certain methods this assumption is almost always true. The methods | |
584 | for which to assume this can be set here." | |
585 | :group 'idlwave-routine-info | |
586 | :type '(repeat (regexp :tag "Match method:"))) | |
4b1aaa8b | 587 | |
5e72c6b2 | 588 | |
f32b3b91 | 589 | (defcustom idlwave-completion-show-classes 1 |
fb7ada5f | 590 | "Number of classes to show when completing object methods and keywords. |
f32b3b91 | 591 | When completing methods or keywords for an object with unknown class, |
2e8b9c7d | 592 | the *Completions* buffer will show the valid classes for each completion |
f32b3b91 CD |
593 | like this: |
594 | ||
595 | MyMethod <Class1,Class2,Class3> | |
596 | ||
597 | The value of this variable may be nil to inhibit display, or an integer to | |
598 | indicate the maximum number of classes to display. | |
599 | ||
600 | On XEmacs, a full list of classes will also be placed into a `help-echo' | |
da6062e6 | 601 | property on the completion items, so that the list of classes for the current |
f32b3b91 CD |
602 | item is displayed in the echo area. If the value of this variable is a |
603 | negative integer, the `help-echo' property will be suppressed." | |
15e42531 | 604 | :group 'idlwave-completion |
f32b3b91 CD |
605 | :type '(choice (const :tag "Don't show" nil) |
606 | (integer :tag "Number of classes shown" 1))) | |
607 | ||
608 | (defcustom idlwave-completion-fontify-classes t | |
fb7ada5f | 609 | "Non-nil means, fontify the classes in completions buffer. |
f32b3b91 CD |
610 | This makes it easier to distinguish the completion items from the extra |
611 | class info listed. See `idlwave-completion-show-classes'." | |
15e42531 | 612 | :group 'idlwave-completion |
f32b3b91 CD |
613 | :type 'boolean) |
614 | ||
615 | (defcustom idlwave-query-class '((method-default . nil) | |
616 | (keyword-default . nil)) | |
617 | "Association list governing specification of object classes for completion. | |
618 | ||
5e72c6b2 S |
619 | When IDLWAVE tries to complete object-oriented methods, it usually |
620 | cannot determine the class of a given object from context. In order | |
621 | to provide the user with a correct list of methods or keywords, it | |
76959b77 S |
622 | needs to determine the appropriate class. IDLWAVE has two ways of |
623 | doing this (well, three ways if you count the shell... see | |
624 | `idlwave-shell-query-for-class'): | |
625 | ||
626 | 1. Combine the items of all available classes which contain this | |
627 | method for the purpose of completion. So when completing a method, | |
628 | all methods of all known classes are available, and when completing | |
629 | a keyword, all keywords allowed for this method in any class are | |
630 | shown. This behavior is very much like normal completion and is | |
631 | therefore the default. It works much better than one might think - | |
632 | only for the INIT, GETPROPERTY and SETPROPERTY the keyword lists | |
633 | become uncomfortably long. See also | |
5e72c6b2 | 634 | `idlwave-completion-show-classes'. |
f32b3b91 CD |
635 | |
636 | 2. The second possibility is to ask the user on each occasion. To | |
637 | make this less interruptive, IDLWAVE can store the class as a text | |
638 | property on the object operator `->'. For a given object in the | |
639 | source code, class selection will then be needed only once | |
640 | - for example to complete the method. Keywords to the method can | |
641 | then be completed directly, because the class is already known. | |
642 | You will have to turn on the storage of the selected class | |
643 | explicitly with the variable `idlwave-store-inquired-class'. | |
644 | ||
5e72c6b2 S |
645 | This variable allows you to configure IDLWAVE's method and |
646 | method-keyword completion behavior. Its value is an alist, which | |
647 | should contain at least two elements: (method-default . VALUE) and | |
facebc7b | 648 | \(keyword-default . VALUE), where VALUE is either t or nil. These |
5e72c6b2 S |
649 | specify if the class should be found during method and keyword |
650 | completion, respectively. | |
f32b3b91 | 651 | |
4b1aaa8b | 652 | The alist may have additional entries specifying exceptions from the |
f32b3b91 CD |
653 | keyword completion rule for specific methods, like INIT or |
654 | GETPROPERTY. In order to turn on class specification for the INIT | |
655 | method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." | |
15e42531 | 656 | :group 'idlwave-completion |
f32b3b91 CD |
657 | :type '(list |
658 | (cons (const method-default) | |
659 | (boolean :tag "Determine class when completing METHODS ")) | |
660 | (cons (const keyword-default) | |
661 | (boolean :tag "Determine class when completing KEYWORDS ")) | |
662 | (repeat | |
663 | :tag "Exceptions to defaults" | |
664 | :inline t | |
665 | (cons (string :tag "MODULE" :value "") | |
666 | (boolean :tag "Determine class for this method"))))) | |
667 | ||
f66f03de | 668 | (defcustom idlwave-store-inquired-class t |
fb7ada5f | 669 | "Non-nil means, store class of a method call as text property on `->'. |
f32b3b91 CD |
670 | IDLWAVE sometimes has to ask the user for the class associated with a |
671 | particular object method call. This happens during the commands | |
672 | `idlwave-routine-info' and `idlwave-complete', depending upon the | |
673 | value of the variable `idlwave-query-class'. | |
674 | ||
675 | When you specify a class, this information can be stored as a text | |
4b1aaa8b | 676 | property on the `->' arrow in the source code, so that during the same |
f32b3b91 CD |
677 | editing session, IDLWAVE will not have to ask again. When this |
678 | variable is non-nil, IDLWAVE will store and reuse the class information. | |
679 | The class stored can be checked and removed with `\\[idlwave-routine-info]' | |
680 | on the arrow. | |
681 | ||
682 | The default of this variable is nil, since the result of commands then | |
683 | is more predictable. However, if you know what you are doing, it can | |
684 | be nice to turn this on. | |
685 | ||
686 | An arrow which knows the class will be highlighted with | |
687 | `idlwave-class-arrow-face'. The command \\[idlwave-routine-info] | |
688 | displays (with prefix arg: deletes) the class stored on the arrow | |
689 | at point." | |
15e42531 | 690 | :group 'idlwave-completion |
f32b3b91 CD |
691 | :type 'boolean) |
692 | ||
693 | (defcustom idlwave-class-arrow-face 'bold | |
fb7ada5f | 694 | "Face to highlight object operator arrows `->' which carry a class property. |
f32b3b91 | 695 | When IDLWAVE stores a class name as text property on an object arrow |
facebc7b | 696 | \(see variable `idlwave-store-inquired-class', it highlights the arrow |
f32b3b91 | 697 | with this font in order to remind the user that this arrow is special." |
15e42531 | 698 | :group 'idlwave-completion |
f32b3b91 CD |
699 | :type 'symbol) |
700 | ||
701 | (defcustom idlwave-resize-routine-help-window t | |
fb7ada5f | 702 | "Non-nil means, resize the Routine-info *Help* window to fit the content." |
15e42531 | 703 | :group 'idlwave-completion |
f32b3b91 CD |
704 | :type 'boolean) |
705 | ||
706 | (defcustom idlwave-keyword-completion-adds-equal t | |
fb7ada5f | 707 | "Non-nil means, completion automatically adds `=' after completed keywords." |
15e42531 | 708 | :group 'idlwave-completion |
f32b3b91 CD |
709 | :type 'boolean) |
710 | ||
711 | (defcustom idlwave-function-completion-adds-paren t | |
fb7ada5f | 712 | "Non-nil means, completion automatically adds `(' after completed function. |
0ff9b955 | 713 | nil means, don't add anything. |
f32b3b91 CD |
714 | A value of `2' means, also add the closing parenthesis and position cursor |
715 | between the two." | |
15e42531 | 716 | :group 'idlwave-completion |
f32b3b91 CD |
717 | :type '(choice (const :tag "Nothing" nil) |
718 | (const :tag "(" t) | |
719 | (const :tag "()" 2))) | |
720 | ||
721 | (defcustom idlwave-completion-restore-window-configuration t | |
fb7ada5f | 722 | "Non-nil means, try to restore the window configuration after completion. |
f32b3b91 CD |
723 | When completion is not unique, Emacs displays a list of completions. |
724 | This messes up your window configuration. With this variable set, IDLWAVE | |
725 | restores the old configuration after successful completion." | |
15e42531 | 726 | :group 'idlwave-completion |
f32b3b91 CD |
727 | :type 'boolean) |
728 | ||
729 | ;;; Variables for abbrev and action behavior ----------------------------- | |
730 | ||
731 | (defgroup idlwave-abbrev-and-indent-action nil | |
732 | "IDLWAVE performs actions when expanding abbreviations or indenting lines. | |
733 | The variables in this group govern this." | |
734 | :group 'idlwave) | |
735 | ||
736 | (defcustom idlwave-do-actions nil | |
fb7ada5f | 737 | "Non-nil means performs actions when indenting. |
f32b3b91 CD |
738 | The actions that can be performed are listed in `idlwave-indent-action-table'." |
739 | :group 'idlwave-abbrev-and-indent-action | |
740 | :type 'boolean) | |
741 | ||
742 | (defcustom idlwave-abbrev-start-char "\\" | |
fb7ada5f | 743 | "A single character string used to start abbreviations in abbrev mode. |
f32b3b91 CD |
744 | Possible characters to chose from: ~`\% |
745 | or even '?'. '.' is not a good choice because it can make structure | |
746 | field names act like abbrevs in certain circumstances. | |
747 | ||
748 | Changes to this in `idlwave-mode-hook' will have no effect. Instead a user | |
749 | must set it directly using `setq' in the .emacs file before idlwave.el | |
750 | is loaded." | |
751 | :group 'idlwave-abbrev-and-indent-action | |
752 | :type 'string) | |
753 | ||
754 | (defcustom idlwave-surround-by-blank nil | |
fb7ada5f | 755 | "Non-nil means, enable `idlwave-surround'. |
595ab50b | 756 | If non-nil, `=',`<',`>',`&',`,', `->' are surrounded with spaces by |
f32b3b91 CD |
757 | `idlwave-surround'. |
758 | See help for `idlwave-indent-action-table' for symbols using `idlwave-surround'. | |
759 | ||
760 | Also see the default key bindings for keys using `idlwave-surround'. | |
761 | Keys are bound and made into actions calling `idlwave-surround' with | |
762 | `idlwave-action-and-binding'. | |
763 | See help for `idlwave-action-and-binding' for examples. | |
764 | ||
765 | Also see help for `idlwave-surround'." | |
766 | :group 'idlwave-abbrev-and-indent-action | |
767 | :type 'boolean) | |
768 | ||
769 | (defcustom idlwave-pad-keyword t | |
fb7ada5f | 770 | "Non-nil means pad '=' in keywords (routine calls or defs) like assignment. |
52a244eb S |
771 | Whenever `idlwave-surround' is non-nil then this affects how '=' is |
772 | padded for keywords and for variables. If t, pad the same as for | |
773 | assignments. If nil then spaces are removed. With any other value, | |
774 | spaces are left unchanged." | |
f32b3b91 | 775 | :group 'idlwave-abbrev-and-indent-action |
15e42531 CD |
776 | :type '(choice |
777 | (const :tag "Pad like assignments" t) | |
778 | (const :tag "Remove space near `='" nil) | |
779 | (const :tag "Keep space near `='" 'keep))) | |
f32b3b91 CD |
780 | |
781 | (defcustom idlwave-show-block t | |
fb7ada5f | 782 | "Non-nil means point blinks to block beginning for `idlwave-show-begin'." |
f32b3b91 CD |
783 | :group 'idlwave-abbrev-and-indent-action |
784 | :type 'boolean) | |
785 | ||
786 | (defcustom idlwave-expand-generic-end nil | |
fb7ada5f | 787 | "Non-nil means expand generic END to ENDIF/ENDELSE/ENDWHILE etc." |
f32b3b91 CD |
788 | :group 'idlwave-abbrev-and-indent-action |
789 | :type 'boolean) | |
790 | ||
15e42531 | 791 | (defcustom idlwave-reindent-end t |
fb7ada5f | 792 | "Non-nil means re-indent line after END was typed." |
15e42531 CD |
793 | :group 'idlwave-abbrev-and-indent-action |
794 | :type 'boolean) | |
795 | ||
f32b3b91 | 796 | (defcustom idlwave-abbrev-move t |
fb7ada5f | 797 | "Non-nil means the abbrev hook can move point. |
5a0c3f56 | 798 | Set to nil by `idlwave-expand-region-abbrevs'. To see the abbrev |
f32b3b91 | 799 | definitions, use the command `list-abbrevs', for abbrevs that move |
5a0c3f56 | 800 | point. Moving point is useful, for example, to place point between |
f32b3b91 CD |
801 | parentheses of expanded functions. |
802 | ||
803 | See `idlwave-check-abbrev'." | |
804 | :group 'idlwave-abbrev-and-indent-action | |
805 | :type 'boolean) | |
806 | ||
807 | (defcustom idlwave-abbrev-change-case nil | |
fb7ada5f | 808 | "Non-nil means all abbrevs will be forced to either upper or lower case. |
f32b3b91 CD |
809 | If the value t, all expanded abbrevs will be upper case. |
810 | If the value is 'down then abbrevs will be forced to lower case. | |
811 | If nil, the case will not change. | |
812 | If `idlwave-reserved-word-upcase' is non-nil, reserved words will always be | |
813 | upper case, regardless of this variable." | |
814 | :group 'idlwave-abbrev-and-indent-action | |
815 | :type 'boolean) | |
816 | ||
817 | (defcustom idlwave-reserved-word-upcase nil | |
fb7ada5f | 818 | "Non-nil means, reserved words will be made upper case via abbrev expansion. |
f32b3b91 CD |
819 | If nil case of reserved words is controlled by `idlwave-abbrev-change-case'. |
820 | Has effect only if in abbrev-mode." | |
821 | :group 'idlwave-abbrev-and-indent-action | |
822 | :type 'boolean) | |
823 | ||
824 | ;;; Action/Expand Tables. | |
825 | ;; | |
826 | ;; The average user may have difficulty modifying this directly. It | |
827 | ;; can be modified/set in idlwave-mode-hook, but it is easier to use | |
828 | ;; idlwave-action-and-binding. See help for idlwave-action-and-binding for | |
829 | ;; examples of how to add an action. | |
830 | ;; | |
831 | ;; The action table is used by `idlwave-indent-line' whereas both the | |
832 | ;; action and expand tables are used by `idlwave-indent-and-action'. In | |
833 | ;; general, the expand table is only used when a line is explicitly | |
834 | ;; indented. Whereas, in addition to being used when the expand table | |
835 | ;; is used, the action table is used when a line is indirectly | |
836 | ;; indented via line splitting, auto-filling or a new line creation. | |
837 | ;; | |
838 | ;; Example actions: | |
839 | ;; | |
840 | ;; Capitalize system vars | |
841 | ;; (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t) | |
842 | ;; | |
843 | ;; Capitalize procedure name | |
844 | ;; (idlwave-action-and-binding "\\<\\(pro\\|function\\)\\>[ \t]*\\<" | |
845 | ;; '(capitalize-word 1) t) | |
846 | ;; | |
847 | ;; Capitalize common block name | |
848 | ;; (idlwave-action-and-binding "\\<common\\>[ \t]+\\<" | |
849 | ;; '(capitalize-word 1) t) | |
850 | ;; Capitalize label | |
851 | ;; (idlwave-action-and-binding (concat "^[ \t]*" idlwave-label) | |
852 | ;; '(capitalize-word -1) t) | |
853 | ||
854 | (defvar idlwave-indent-action-table nil | |
fb7ada5f | 855 | "Associated array containing action lists of search string (car), |
5a0c3f56 | 856 | and function as a cdr. This table is used by `idlwave-indent-line'. |
f32b3b91 CD |
857 | See documentation for `idlwave-do-action' for a complete description of |
858 | the action lists. | |
859 | ||
860 | Additions to the table are made with `idlwave-action-and-binding' when a | |
861 | binding is not requested. | |
862 | See help on `idlwave-action-and-binding' for examples.") | |
863 | ||
864 | (defvar idlwave-indent-expand-table nil | |
fb7ada5f | 865 | "Associated array containing action lists of search string (car), |
5a0c3f56 JB |
866 | and function as a cdr. The table is used by the |
867 | `idlwave-indent-and-action' function. See documentation for | |
f32b3b91 CD |
868 | `idlwave-do-action' for a complete description of the action lists. |
869 | ||
870 | Additions to the table are made with `idlwave-action-and-binding' when a | |
871 | binding is requested. | |
872 | See help on `idlwave-action-and-binding' for examples.") | |
873 | ||
874 | ;;; Documentation header and history keyword --------------------------------- | |
875 | ||
876 | (defgroup idlwave-documentation nil | |
877 | "Options for documenting IDLWAVE files." | |
878 | :group 'idlwave) | |
879 | ||
880 | ;; FIXME: make defcustom? | |
881 | (defvar idlwave-file-header | |
882 | (list nil | |
883 | ";+ | |
884 | ; NAME: | |
885 | ; | |
886 | ; | |
887 | ; | |
888 | ; PURPOSE: | |
889 | ; | |
890 | ; | |
891 | ; | |
892 | ; CATEGORY: | |
893 | ; | |
894 | ; | |
895 | ; | |
896 | ; CALLING SEQUENCE: | |
897 | ; | |
898 | ; | |
899 | ; | |
900 | ; INPUTS: | |
901 | ; | |
902 | ; | |
903 | ; | |
904 | ; OPTIONAL INPUTS: | |
905 | ; | |
906 | ; | |
907 | ; | |
908 | ; KEYWORD PARAMETERS: | |
909 | ; | |
910 | ; | |
911 | ; | |
912 | ; OUTPUTS: | |
913 | ; | |
914 | ; | |
915 | ; | |
916 | ; OPTIONAL OUTPUTS: | |
917 | ; | |
918 | ; | |
919 | ; | |
920 | ; COMMON BLOCKS: | |
921 | ; | |
922 | ; | |
923 | ; | |
924 | ; SIDE EFFECTS: | |
925 | ; | |
926 | ; | |
927 | ; | |
928 | ; RESTRICTIONS: | |
929 | ; | |
930 | ; | |
931 | ; | |
932 | ; PROCEDURE: | |
933 | ; | |
934 | ; | |
935 | ; | |
936 | ; EXAMPLE: | |
937 | ; | |
938 | ; | |
939 | ; | |
940 | ; MODIFICATION HISTORY: | |
941 | ; | |
942 | ;- | |
943 | ") | |
fb7ada5f | 944 | "A list (PATHNAME STRING) specifying the doc-header template to use for |
5a0c3f56 JB |
945 | summarizing a file. If PATHNAME is non-nil then this file will be included. |
946 | Otherwise STRING is used. If nil, the file summary will be omitted. | |
f32b3b91 CD |
947 | For example you might set PATHNAME to the path for the |
948 | lib_template.pro file included in the IDL distribution.") | |
949 | ||
f66f03de | 950 | (defcustom idlwave-header-to-beginning-of-file t |
fb7ada5f | 951 | "Non-nil means, the documentation header will always be at start of file. |
5e72c6b2 S |
952 | When nil, the header is positioned between the PRO/FUNCTION line of |
953 | the current routine and the code, allowing several routine headers in | |
954 | a file." | |
955 | :group 'idlwave-documentation | |
956 | :type 'boolean) | |
957 | ||
f32b3b91 | 958 | (defcustom idlwave-timestamp-hook 'idlwave-default-insert-timestamp |
fb7ada5f | 959 | "The hook function used to update the timestamp of a function." |
f32b3b91 CD |
960 | :group 'idlwave-documentation |
961 | :type 'function) | |
962 | ||
963 | (defcustom idlwave-doc-modifications-keyword "HISTORY" | |
fb7ada5f | 964 | "The modifications keyword to use with the log documentation commands. |
f32b3b91 CD |
965 | A ':' is added to the keyword end. |
966 | Inserted by doc-header and used to position logs by doc-modification. | |
967 | If nil it will not be inserted." | |
968 | :group 'idlwave-documentation | |
969 | :type 'string) | |
970 | ||
971 | (defcustom idlwave-doclib-start "^;+\\+" | |
fb7ada5f | 972 | "Regexp matching the start of a document library header." |
f32b3b91 CD |
973 | :group 'idlwave-documentation |
974 | :type 'regexp) | |
975 | ||
976 | (defcustom idlwave-doclib-end "^;+-" | |
fb7ada5f | 977 | "Regexp matching the end of a document library header." |
f32b3b91 CD |
978 | :group 'idlwave-documentation |
979 | :type 'regexp) | |
980 | ||
981 | ;;; External Programs ------------------------------------------------------- | |
982 | ||
983 | (defgroup idlwave-external-programs nil | |
05a1abfc | 984 | "Path locations of external commands used by IDLWAVE." |
f32b3b91 CD |
985 | :group 'idlwave) |
986 | ||
f32b3b91 | 987 | (defcustom idlwave-shell-explicit-file-name "idl" |
fb7ada5f | 988 | "If non-nil, this is the command to run IDL. |
f32b3b91 | 989 | Should be an absolute file path or path relative to the current environment |
5e72c6b2 | 990 | execution search path. If you want to specify command line switches |
5a0c3f56 | 991 | for the IDL program, use `idlwave-shell-command-line-options'. |
5e72c6b2 S |
992 | |
993 | I know the name of this variable is badly chosen, but I cannot change | |
5a0c3f56 | 994 | it without compromising backwards-compatibility." |
f32b3b91 CD |
995 | :group 'idlwave-external-programs |
996 | :type 'string) | |
997 | ||
f32b3b91 | 998 | (defcustom idlwave-shell-command-line-options nil |
fb7ada5f | 999 | "A list of command line options for calling the IDL program. |
5e72c6b2 S |
1000 | Since IDL is executed directly without going through a shell like /bin/sh, |
1001 | this should be a list of strings like '(\"-rt=file\" \"-nw\") with a separate | |
1002 | string for each argument. But you may also give a single string which | |
1003 | contains the options whitespace-separated. Emacs will be kind enough to | |
1004 | split it for you." | |
1005 | :type '(choice | |
1006 | string | |
1007 | (repeat (string :value ""))) | |
f32b3b91 CD |
1008 | :group 'idlwave-external-programs) |
1009 | ||
1010 | (defcustom idlwave-help-application "idlhelp" | |
fb7ada5f | 1011 | "The external application providing reference help for programming. |
f66f03de | 1012 | Obsolete, if the IDL Assistant is being used for help." |
f32b3b91 CD |
1013 | :group 'idlwave-external-programs |
1014 | :type 'string) | |
1015 | ||
05a1abfc CD |
1016 | ;;; Some Shell variables which must be defined here.----------------------- |
1017 | ||
1018 | (defcustom idlwave-shell-debug-modifiers '() | |
1019 | "List of modifiers to be used for the debugging commands. | |
1020 | Will be used to bind debugging commands in the shell buffer and in all | |
1021 | source buffers. These are additional convenience bindings, the debugging | |
1022 | commands are always available with the `C-c C-d' prefix. | |
1023 | If you set this to '(control shift), this means setting a breakpoint will | |
1024 | be on `C-S-b', compiling a source file on `C-S-c' etc. Possible modifiers | |
1025 | are `control', `meta', `super', `hyper', `alt', and `shift'." | |
1026 | :group 'idlwave-shell-general-setup | |
1027 | :type '(set :tag "Specify modifiers" | |
1028 | (const control) | |
1029 | (const meta) | |
1030 | (const super) | |
1031 | (const hyper) | |
1032 | (const alt) | |
1033 | (const shift))) | |
1034 | ||
1035 | (defcustom idlwave-shell-automatic-start nil | |
fb7ada5f | 1036 | "If non-nil attempt invoke `idlwave-shell' if not already running. |
05a1abfc CD |
1037 | This is checked when an attempt to send a command to an |
1038 | IDL process is made." | |
1039 | :group 'idlwave-shell-general-setup | |
1040 | :type 'boolean) | |
1041 | ||
f32b3b91 CD |
1042 | ;;; Miscellaneous variables ------------------------------------------------- |
1043 | ||
1044 | (defgroup idlwave-misc nil | |
1045 | "Miscellaneous options for IDLWAVE mode." | |
8ec3bce0 | 1046 | :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) |
f32b3b91 CD |
1047 | :group 'idlwave) |
1048 | ||
1049 | (defcustom idlwave-startup-message t | |
fb7ada5f | 1050 | "Non-nil displays a startup message when `idlwave-mode' is first called." |
f32b3b91 CD |
1051 | :group 'idlwave-misc |
1052 | :type 'boolean) | |
1053 | ||
4b1aaa8b | 1054 | (defcustom idlwave-default-font-lock-items |
facebc7b | 1055 | '(pros-and-functions batch-files idlwave-idl-keywords label goto |
f32b3b91 CD |
1056 | common-blocks class-arrows) |
1057 | "Items which should be fontified on the default fontification level 2. | |
1058 | IDLWAVE defines 3 levels of fontification. Level 1 is very little, level 3 | |
1059 | is everything and level 2 is specified by this list. | |
5a0c3f56 JB |
1060 | This variable must be set before IDLWAVE gets loaded. |
1061 | It is a list of symbols; the following symbols are allowed: | |
f32b3b91 CD |
1062 | |
1063 | pros-and-functions Procedure and Function definitions | |
1064 | batch-files Batch Files | |
facebc7b | 1065 | idlwave-idl-keywords IDL Keywords |
f32b3b91 CD |
1066 | label Statement Labels |
1067 | goto Goto Statements | |
1068 | common-blocks Common Blocks | |
1069 | keyword-parameters Keyword Parameters in routine definitions and calls | |
1070 | system-variables System Variables | |
1071 | fixme FIXME: Warning in comments (on XEmacs only v. 21.0 and up) | |
1072 | class-arrows Object Arrows with class property" | |
1073 | :group 'idlwave-misc | |
1074 | :type '(set | |
1075 | :inline t :greedy t | |
1076 | (const :tag "Procedure and Function definitions" pros-and-functions) | |
facebc7b S |
1077 | (const :tag "Batch Files" batch-files) |
1078 | (const :tag "IDL Keywords (reserved words)" idlwave-idl-keywords) | |
1079 | (const :tag "Statement Labels" label) | |
1080 | (const :tag "Goto Statements" goto) | |
1081 | (const :tag "Tags in Structure Definition" structtag) | |
1082 | (const :tag "Structure Name" structname) | |
1083 | (const :tag "Common Blocks" common-blocks) | |
1084 | (const :tag "Keyword Parameters" keyword-parameters) | |
1085 | (const :tag "System Variables" system-variables) | |
1086 | (const :tag "FIXME: Warning" fixme) | |
f32b3b91 CD |
1087 | (const :tag "Object Arrows with class property " class-arrows))) |
1088 | ||
1089 | (defcustom idlwave-mode-hook nil | |
1090 | "Normal hook. Executed when a buffer is put into `idlwave-mode'." | |
1091 | :group 'idlwave-misc | |
1092 | :type 'hook) | |
1093 | ||
1094 | (defcustom idlwave-load-hook nil | |
1095 | "Normal hook. Executed when idlwave.el is loaded." | |
1096 | :group 'idlwave-misc | |
1097 | :type 'hook) | |
1098 | ||
15e42531 CD |
1099 | (defvar idlwave-experimental nil |
1100 | "Non-nil means turn on a few experimental features. | |
1101 | This variable is only for the maintainer, to test difficult stuff, | |
1102 | while still distributing stable releases. | |
1103 | As a user, you should not set this to t.") | |
1104 | ||
f32b3b91 CD |
1105 | ;;; |
1106 | ;;; End customization variables section | |
1107 | ;;; | |
1108 | ||
1109 | ;;; Non customization variables | |
1110 | ||
1111 | ;;; font-lock mode - Additions by Phil Williams, Ulrik Dickow and | |
52a244eb | 1112 | ;;; Simon Marshall <simon_at_gnu.ai.mit.edu> |
f32b3b91 CD |
1113 | ;;; and Carsten Dominik... |
1114 | ||
76959b77 | 1115 | ;; The following are the reserved words in IDL. Maybe we should |
4b1aaa8b | 1116 | ;; highlight some more stuff as well? |
76959b77 S |
1117 | ;; Procedure declarations. Fontify keyword plus procedure name. |
1118 | (defvar idlwave-idl-keywords | |
4b1aaa8b | 1119 | ;; To update this regexp, update the list of keywords and |
76959b77 | 1120 | ;; evaluate the form. |
4b1aaa8b | 1121 | ;; (insert |
76959b77 | 1122 | ;; (prin1-to-string |
4b1aaa8b | 1123 | ;; (concat |
76959b77 | 1124 | ;; "\\<\\(" |
4b1aaa8b | 1125 | ;; (regexp-opt |
52a244eb | 1126 | ;; '("||" "&&" "and" "or" "xor" "not" |
4b1aaa8b | 1127 | ;; "eq" "ge" "gt" "le" "lt" "ne" |
76959b77 | 1128 | ;; "for" "do" "endfor" |
4b1aaa8b | 1129 | ;; "if" "then" "endif" "else" "endelse" |
76959b77 S |
1130 | ;; "case" "of" "endcase" |
1131 | ;; "switch" "break" "continue" "endswitch" | |
1132 | ;; "begin" "end" | |
1133 | ;; "repeat" "until" "endrep" | |
4b1aaa8b | 1134 | ;; "while" "endwhile" |
76959b77 S |
1135 | ;; "goto" "return" |
1136 | ;; "inherits" "mod" | |
1137 | ;; "compile_opt" "forward_function" | |
1138 | ;; "on_error" "on_ioerror")) ; on_error is not officially reserved | |
1139 | ;; "\\)\\>"))) | |
52a244eb S |
1140 | "\\<\\(&&\\|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\\|||\\)\\>") |
1141 | ||
76959b77 | 1142 | |
facebc7b | 1143 | (let* (;; Procedure declarations. Fontify keyword plus procedure name. |
f32b3b91 CD |
1144 | ;; Function declarations. Fontify keyword plus function name. |
1145 | (pros-and-functions | |
1146 | '("\\<\\(function\\|pro\\)\\>[ \t]+\\(\\sw+\\(::\\sw+\\)?\\)" | |
1147 | (1 font-lock-keyword-face) | |
1148 | (2 font-lock-function-name-face nil t))) | |
1149 | ||
1150 | ;; Common blocks | |
1151 | (common-blocks | |
1152 | '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" | |
1153 | (1 font-lock-keyword-face) ; "common" | |
1154 | (2 font-lock-reference-face nil t) ; block name | |
f66f03de | 1155 | ("[ \t]*\\(\\sw+\\)[ ,]*" |
f32b3b91 | 1156 | ;; Start with point after block name and comma |
4b1aaa8b | 1157 | (goto-char (match-end 0)) ; needed for XEmacs, could be nil |
f32b3b91 CD |
1158 | nil |
1159 | (1 font-lock-variable-name-face) ; variable names | |
1160 | ))) | |
1161 | ||
1162 | ;; Batch files | |
1163 | (batch-files | |
1164 | '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face))) | |
1165 | ||
1166 | ;; FIXME warning. | |
1167 | (fixme | |
1168 | '("\\<FIXME:" (0 font-lock-warning-face t))) | |
1169 | ||
1170 | ;; Labels | |
1171 | (label | |
1172 | '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-reference-face))) | |
1173 | ||
1174 | ;; The goto statement and its label | |
1175 | (goto | |
1176 | '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)" | |
1177 | (1 font-lock-keyword-face) | |
1178 | (2 font-lock-reference-face))) | |
1179 | ||
52a244eb S |
1180 | ;; Tags in structure definitions. Note that this definition |
1181 | ;; actually collides with labels, so we have to use the same | |
1182 | ;; face. It also matches named subscript ranges, | |
1183 | ;; e.g. vec{bottom:top]. No good way around this. | |
05a1abfc CD |
1184 | (structtag |
1185 | '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face))) | |
1186 | ||
1187 | ;; Structure names | |
1188 | (structname | |
1189 | '("\\({\\|\\<inherits\\s-\\)\\s-*\\([a-zA-Z][a-zA-Z0-9_]*\\)[},\t \n]" | |
1190 | (2 font-lock-function-name-face))) | |
1191 | ||
52a244eb | 1192 | ;; Keyword parameters, like /xlog or ,xrange=[] |
97610156 | 1193 | ;; This is anchored to the comma preceding the keyword. |
595ab50b CD |
1194 | ;; Treats continuation lines, works only during whole buffer |
1195 | ;; fontification. Slow, use it only in fancy fontification. | |
f32b3b91 | 1196 | (keyword-parameters |
0dc2be2f S |
1197 | '("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\([ \t]*\\(;.*\\)?\n\\)*[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)" |
1198 | (6 font-lock-reference-face))) | |
f32b3b91 | 1199 | |
595ab50b | 1200 | ;; System variables start with a bang. |
f32b3b91 | 1201 | (system-variables |
15e42531 | 1202 | '("\\(![a-zA-Z_0-9]+\\(\\.\\sw+\\)?\\)" |
f32b3b91 CD |
1203 | (1 font-lock-variable-name-face))) |
1204 | ||
1205 | ;; Special and unusual operators (not used because too noisy) | |
8d222148 SM |
1206 | ;; (special-operators |
1207 | ;; '("[<>#]" (0 font-lock-keyword-face))) | |
f32b3b91 CD |
1208 | |
1209 | ;; All operators (not used because too noisy) | |
8d222148 SM |
1210 | ;; (all-operators |
1211 | ;; '("[-*^#+<>/]" (0 font-lock-keyword-face))) | |
4b1aaa8b | 1212 | |
f32b3b91 CD |
1213 | ;; Arrows with text property `idlwave-class' |
1214 | (class-arrows | |
facebc7b S |
1215 | '(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) |
1216 | ||
1217 | (defconst idlwave-font-lock-keywords-1 | |
1218 | (list pros-and-functions batch-files) | |
1219 | "Subdued level highlighting for IDLWAVE mode.") | |
f32b3b91 | 1220 | |
facebc7b S |
1221 | (defconst idlwave-font-lock-keywords-2 |
1222 | (mapcar 'symbol-value idlwave-default-font-lock-items) | |
1223 | "Medium level highlighting for IDLWAVE mode.") | |
f32b3b91 | 1224 | |
facebc7b | 1225 | (defconst idlwave-font-lock-keywords-3 |
f32b3b91 CD |
1226 | (list pros-and-functions |
1227 | batch-files | |
76959b77 | 1228 | idlwave-idl-keywords |
f32b3b91 | 1229 | label goto |
05a1abfc CD |
1230 | structtag |
1231 | structname | |
f32b3b91 CD |
1232 | common-blocks |
1233 | keyword-parameters | |
1234 | system-variables | |
facebc7b S |
1235 | class-arrows) |
1236 | "Gaudy level highlighting for IDLWAVE mode.")) | |
f32b3b91 CD |
1237 | |
1238 | (defun idlwave-match-class-arrows (limit) | |
1239 | ;; Match an object arrow with class property | |
1240 | (and idlwave-store-inquired-class | |
1241 | (re-search-forward "->" limit 'limit) | |
1242 | (get-text-property (match-beginning 0) 'idlwave-class))) | |
1243 | ||
1244 | (defvar idlwave-font-lock-keywords idlwave-font-lock-keywords-2 | |
1245 | "Default expressions to highlight in IDLWAVE mode.") | |
1246 | ||
1247 | (defvar idlwave-font-lock-defaults | |
1248 | '((idlwave-font-lock-keywords | |
4b1aaa8b | 1249 | idlwave-font-lock-keywords-1 |
f32b3b91 CD |
1250 | idlwave-font-lock-keywords-2 |
1251 | idlwave-font-lock-keywords-3) | |
4b1aaa8b PE |
1252 | nil t |
1253 | ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) | |
f32b3b91 CD |
1254 | beginning-of-line)) |
1255 | ||
4b1aaa8b | 1256 | (put 'idlwave-mode 'font-lock-defaults |
f32b3b91 CD |
1257 | idlwave-font-lock-defaults) ; XEmacs |
1258 | ||
1259 | (defconst idlwave-comment-line-start-skip "^[ \t]*;" | |
1260 | "Regexp to match the start of a full-line comment. | |
1261 | That is the _beginning_ of a line containing a comment delimiter `;' preceded | |
1262 | only by whitespace.") | |
1263 | ||
4b1aaa8b | 1264 | (defconst idlwave-begin-block-reg |
05a1abfc | 1265 | "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" |
5a0c3f56 JB |
1266 | "Regular expression to find the beginning of a block. |
1267 | The case does not matter. The search skips matches in comments.") | |
f32b3b91 | 1268 | |
52a244eb | 1269 | (defconst idlwave-begin-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\`" |
5a0c3f56 JB |
1270 | "Regular expression to find the beginning of a unit. |
1271 | The case does not matter.") | |
f32b3b91 | 1272 | |
52a244eb | 1273 | (defconst idlwave-end-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\'" |
f32b3b91 | 1274 | "Regular expression to find the line that indicates the end of unit. |
5a0c3f56 JB |
1275 | This line is the end of buffer or the start of another unit. |
1276 | The case does not matter. The search skips matches in comments.") | |
f32b3b91 CD |
1277 | |
1278 | (defconst idlwave-continue-line-reg "\\<\\$" | |
1279 | "Regular expression to match a continued line.") | |
1280 | ||
1281 | (defconst idlwave-end-block-reg | |
05a1abfc | 1282 | "\\<end\\(\\|case\\|switch\\|else\\|for\\|if\\|rep\\|while\\)\\>" |
5a0c3f56 JB |
1283 | "Regular expression to find the end of a block. |
1284 | The case does not matter. The search skips matches in comments.") | |
f32b3b91 CD |
1285 | |
1286 | (defconst idlwave-block-matches | |
1287 | '(("pro" . "end") | |
1288 | ("function" . "end") | |
1289 | ("case" . "endcase") | |
1290 | ("else" . "endelse") | |
1291 | ("for" . "endfor") | |
1292 | ("then" . "endif") | |
1293 | ("repeat" . "endrep") | |
05a1abfc | 1294 | ("switch" . "endswitch") |
f32b3b91 CD |
1295 | ("while" . "endwhile")) |
1296 | "Matches between statements and the corresponding END variant. | |
1297 | The cars are the reserved words starting a block. If the block really | |
1298 | begins with BEGIN, the cars are the reserved words before the begin | |
1299 | which can be used to identify the block type. | |
1300 | This is used to check for the correct END type, to close blocks and | |
1301 | to expand generic end statements to their detailed form.") | |
1302 | ||
1303 | (defconst idlwave-block-match-regexp | |
1304 | "\\<\\(else\\|for\\|then\\|repeat\\|while\\)\\>" | |
1305 | "Regular expression matching reserved words which can stand before | |
1306 | blocks starting with a BEGIN statement. The matches must have associations | |
5a0c3f56 | 1307 | `idlwave-block-matches'.") |
f32b3b91 | 1308 | |
52a244eb | 1309 | (defconst idlwave-identifier "[a-zA-Z_][a-zA-Z0-9$_]*" |
f32b3b91 CD |
1310 | "Regular expression matching an IDL identifier.") |
1311 | ||
1312 | (defconst idlwave-sysvar (concat "!" idlwave-identifier) | |
1313 | "Regular expression matching IDL system variables.") | |
1314 | ||
1315 | (defconst idlwave-variable (concat idlwave-identifier "\\|" idlwave-sysvar) | |
1316 | "Regular expression matching IDL variable names.") | |
1317 | ||
1318 | (defconst idlwave-label (concat idlwave-identifier ":") | |
1319 | "Regular expression matching IDL labels.") | |
1320 | ||
52a244eb S |
1321 | (defconst idlwave-method-call (concat idlwave-identifier "\\s *->" |
1322 | "\\(\\s *" idlwave-identifier "::\\)?" | |
1323 | )) | |
1324 | ||
f32b3b91 CD |
1325 | (defconst idlwave-statement-match |
1326 | (list | |
aa87aafc | 1327 | ;; "endif else" is the only possible "end" that can be |
f32b3b91 CD |
1328 | ;; followed by a statement on the same line. |
1329 | '(endelse . ("end\\(\\|if\\)\\s +else" "end\\(\\|if\\)\\s +else")) | |
1330 | ;; all other "end"s can not be followed by a statement. | |
1331 | (cons 'end (list idlwave-end-block-reg nil)) | |
1332 | '(if . ("if\\>" "then")) | |
1333 | '(for . ("for\\>" "do")) | |
1334 | '(begin . ("begin\\>" nil)) | |
1335 | '(pdef . ("pro\\>\\|function\\>" nil)) | |
1336 | '(while . ("while\\>" "do")) | |
1337 | '(repeat . ("repeat\\>" "repeat")) | |
1338 | '(goto . ("goto\\>" nil)) | |
1339 | '(case . ("case\\>" nil)) | |
05a1abfc | 1340 | '(switch . ("switch\\>" nil)) |
4b1aaa8b | 1341 | (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" |
52a244eb S |
1342 | "\\(" idlwave-method-call "\\s *\\)?" |
1343 | idlwave-identifier | |
1344 | "\\s *(") nil)) | |
4b1aaa8b | 1345 | (cons 'call (list (concat |
52a244eb | 1346 | "\\(" idlwave-method-call "\\s *\\)?" |
4b1aaa8b | 1347 | idlwave-identifier |
52a244eb | 1348 | "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil)) |
4b1aaa8b | 1349 | (cons 'assign (list (concat |
52a244eb | 1350 | "\\(" idlwave-variable "\\) *=") nil))) |
4b1aaa8b | 1351 | |
f32b3b91 | 1352 | "Associated list of statement matching regular expressions. |
5a0c3f56 JB |
1353 | Each regular expression matches the start of an IDL statement. |
1354 | The first element of each association is a symbol giving the statement | |
f32b3b91 CD |
1355 | type. The associated value is a list. The first element of this list |
1356 | is a regular expression matching the start of an IDL statement for | |
1357 | identifying the statement type. The second element of this list is a | |
1358 | regular expression for finding a substatement for the type. The | |
1359 | substatement starts after the end of the found match modulo | |
1360 | whitespace. If it is nil then the statement has no substatement. The | |
1361 | list order matters since matching an assignment statement exactly is | |
1362 | not possible without parsing. Thus assignment statement become just | |
5a0c3f56 | 1363 | the leftover unidentified statements containing an equal sign.") |
f32b3b91 | 1364 | |
f44379e7 | 1365 | ;; FIXME: This var seems to only ever be set, but never actually used! |
f32b3b91 CD |
1366 | (defvar idlwave-fill-function 'auto-fill-function |
1367 | "IDL mode auto fill function.") | |
1368 | ||
1369 | (defvar idlwave-comment-indent-function 'comment-indent-function | |
1370 | "IDL mode comment indent function.") | |
1371 | ||
1372 | ;; Note that this is documented in the v18 manuals as being a string | |
1373 | ;; of length one rather than a single character. | |
1374 | ;; The code in this file accepts either format for compatibility. | |
4b1aaa8b | 1375 | (defvar idlwave-comment-indent-char ?\ |
f32b3b91 CD |
1376 | "Character to be inserted for IDL comment indentation. |
1377 | Normally a space.") | |
1378 | ||
1379 | (defconst idlwave-continuation-char ?$ | |
1380 | "Character which is inserted as a last character on previous line by | |
1381 | \\[idlwave-split-line] to begin a continuation line. Normally $.") | |
1382 | ||
e08734e2 | 1383 | (defconst idlwave-mode-version "6.1_em22") |
f32b3b91 CD |
1384 | |
1385 | (defmacro idlwave-keyword-abbrev (&rest args) | |
1386 | "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." | |
8a946354 | 1387 | `(quote (lambda () |
5e72c6b2 | 1388 | ,(append '(idlwave-check-abbrev) args)))) |
f32b3b91 CD |
1389 | |
1390 | ;; If I take the time I can replace idlwave-keyword-abbrev with | |
1391 | ;; idlwave-code-abbrev and remove the quoted abbrev check from | |
1392 | ;; idlwave-check-abbrev. Then, e.g, (idlwave-keyword-abbrev 0 t) becomes | |
1393 | ;; (idlwave-code-abbrev idlwave-check-abbrev 0 t). In fact I should change | |
1394 | ;; the name of idlwave-check-abbrev to something like idlwave-modify-abbrev. | |
1395 | ||
1396 | (defmacro idlwave-code-abbrev (&rest args) | |
1397 | "Creates a function for abbrev hooks that ensures abbrevs are not quoted. | |
1398 | Specifically, if the abbrev is in a comment or string it is unexpanded. | |
1399 | Otherwise ARGS forms a list that is evaluated." | |
8d222148 SM |
1400 | ;; FIXME: it would probably be better to rely on the new :enable-function |
1401 | ;; to enforce the "don't expand in comments or strings". | |
1402 | `(lambda () | |
1403 | ,(prin1-to-string args) ;; Puts the code in the doc string | |
1404 | (if (idlwave-quoted) | |
1405 | (progn (unexpand-abbrev) nil) | |
1406 | ,(append args)))) | |
1407 | ||
1408 | (autoload 'idlwave-shell "idlw-shell" | |
1409 | "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'." t) | |
1410 | (autoload 'idlwave-shell-send-command "idlw-shell") | |
1411 | (autoload 'idlwave-shell-recenter-shell-window "idlw-shell" | |
1412 | "Run `idlwave-shell' and switch back to current window" t) | |
1413 | (autoload 'idlwave-shell-save-and-run "idlw-shell" | |
1414 | "Save and run buffer under the shell." t) | |
1415 | (autoload 'idlwave-shell-break-here "idlw-shell" | |
1416 | "Set breakpoint in current line." t) | |
1417 | (autoload 'idlwave-shell-run-region "idlw-shell" | |
1418 | "Compile and run the region." t) | |
f32b3b91 | 1419 | |
8d222148 SM |
1420 | (fset 'idlwave-debug-map (make-sparse-keymap)) |
1421 | ||
1422 | (defvar idlwave-mode-map | |
1423 | (let ((map (make-sparse-keymap))) | |
1424 | (define-key map "\C-c " 'idlwave-hard-tab) | |
1425 | (define-key map [(control tab)] 'idlwave-hard-tab) | |
1426 | ;;(define-key map "\C-c\C- " 'idlwave-hard-tab) | |
1427 | (define-key map "'" 'idlwave-show-matching-quote) | |
1428 | (define-key map "\"" 'idlwave-show-matching-quote) | |
1429 | (define-key map "\C-g" 'idlwave-keyboard-quit) | |
1430 | (define-key map "\C-c;" 'idlwave-toggle-comment-region) | |
1431 | (define-key map "\C-\M-a" 'idlwave-beginning-of-subprogram) | |
1432 | (define-key map "\C-\M-e" 'idlwave-end-of-subprogram) | |
1433 | (define-key map "\C-c{" 'idlwave-beginning-of-block) | |
1434 | (define-key map "\C-c}" 'idlwave-end-of-block) | |
1435 | (define-key map "\C-c]" 'idlwave-close-block) | |
1436 | (define-key map [(meta control h)] 'idlwave-mark-subprogram) | |
1437 | (define-key map "\M-\C-n" 'idlwave-forward-block) | |
1438 | (define-key map "\M-\C-p" 'idlwave-backward-block) | |
1439 | (define-key map "\M-\C-d" 'idlwave-down-block) | |
1440 | (define-key map "\M-\C-u" 'idlwave-backward-up-block) | |
1441 | (define-key map "\M-\r" 'idlwave-split-line) | |
1442 | (define-key map "\M-\C-q" 'idlwave-indent-subprogram) | |
1443 | (define-key map "\C-c\C-p" 'idlwave-previous-statement) | |
1444 | (define-key map "\C-c\C-n" 'idlwave-next-statement) | |
1445 | ;; (define-key map "\r" 'idlwave-newline) | |
1446 | ;; (define-key map "\t" 'idlwave-indent-line) | |
1447 | (define-key map [(shift iso-lefttab)] 'idlwave-indent-statement) | |
1448 | (define-key map "\C-c\C-a" 'idlwave-auto-fill-mode) | |
1449 | (define-key map "\M-q" 'idlwave-fill-paragraph) | |
1450 | (define-key map "\M-s" 'idlwave-edit-in-idlde) | |
1451 | (define-key map "\C-c\C-h" 'idlwave-doc-header) | |
1452 | (define-key map "\C-c\C-m" 'idlwave-doc-modification) | |
1453 | (define-key map "\C-c\C-c" 'idlwave-case) | |
1454 | (define-key map "\C-c\C-d" 'idlwave-debug-map) | |
1455 | (when (and (listp idlwave-shell-debug-modifiers) | |
1456 | (not (equal idlwave-shell-debug-modifiers '()))) | |
1457 | ;; Bind the debug commands also with the special modifiers. | |
1458 | (let ((shift (memq 'shift idlwave-shell-debug-modifiers)) | |
1459 | (mods-noshift | |
1460 | (delq 'shift (copy-sequence idlwave-shell-debug-modifiers)))) | |
1461 | (define-key map | |
1462 | (vector (append mods-noshift (list (if shift ?C ?c)))) | |
1463 | 'idlwave-shell-save-and-run) | |
1464 | (define-key map | |
1465 | (vector (append mods-noshift (list (if shift ?B ?b)))) | |
1466 | 'idlwave-shell-break-here) | |
1467 | (define-key map | |
1468 | (vector (append mods-noshift (list (if shift ?E ?e)))) | |
1469 | 'idlwave-shell-run-region))) | |
1470 | (define-key map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) | |
1471 | (define-key map "\C-c\C-d\C-b" 'idlwave-shell-break-here) | |
1472 | (define-key map "\C-c\C-d\C-e" 'idlwave-shell-run-region) | |
1473 | (define-key map "\C-c\C-f" 'idlwave-for) | |
1474 | ;; (define-key map "\C-c\C-f" 'idlwave-function) | |
1475 | ;; (define-key map "\C-c\C-p" 'idlwave-procedure) | |
1476 | (define-key map "\C-c\C-r" 'idlwave-repeat) | |
1477 | (define-key map "\C-c\C-w" 'idlwave-while) | |
1478 | (define-key map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers) | |
1479 | (define-key map "\C-c\C-s" 'idlwave-shell) | |
1480 | (define-key map "\C-c\C-l" 'idlwave-shell-recenter-shell-window) | |
1481 | (define-key map "\C-c\C-b" 'idlwave-list-buffer-load-path-shadows) | |
1482 | (define-key map "\C-c\C-v" 'idlwave-find-module) | |
1483 | (define-key map "\C-c\C-t" 'idlwave-find-module-this-file) | |
1484 | (define-key map "\C-c?" 'idlwave-routine-info) | |
1485 | (define-key map "\M-?" 'idlwave-context-help) | |
1486 | (define-key map [(control meta ?\?)] | |
1487 | 'idlwave-help-assistant-help-with-topic) | |
1488 | ;; Pickup both forms of Esc/Meta binding | |
1489 | (define-key map [(meta tab)] 'idlwave-complete) | |
1490 | (define-key map [?\e?\t] 'idlwave-complete) | |
1491 | (define-key map "\M-\C-i" 'idlwave-complete) | |
1492 | (define-key map "\C-c\C-i" 'idlwave-update-routine-info) | |
1493 | (define-key map "\C-c=" 'idlwave-resolve) | |
1494 | (define-key map | |
1495 | (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) | |
1496 | 'idlwave-mouse-context-help) | |
1497 | map) | |
f32b3b91 CD |
1498 | "Keymap used in IDL mode.") |
1499 | ||
8d222148 SM |
1500 | (defvar idlwave-mode-syntax-table |
1501 | (let ((st (make-syntax-table))) | |
1502 | (modify-syntax-entry ?+ "." st) | |
1503 | (modify-syntax-entry ?- "." st) | |
1504 | (modify-syntax-entry ?* "." st) | |
1505 | (modify-syntax-entry ?/ "." st) | |
1506 | (modify-syntax-entry ?^ "." st) | |
1507 | (modify-syntax-entry ?# "." st) | |
1508 | (modify-syntax-entry ?= "." st) | |
1509 | (modify-syntax-entry ?% "." st) | |
1510 | (modify-syntax-entry ?< "." st) | |
1511 | (modify-syntax-entry ?> "." st) | |
1512 | (modify-syntax-entry ?\' "\"" st) | |
1513 | (modify-syntax-entry ?\" "\"" st) | |
1514 | (modify-syntax-entry ?\\ "." st) | |
1515 | (modify-syntax-entry ?_ "_" st) | |
1516 | (modify-syntax-entry ?{ "(}" st) | |
1517 | (modify-syntax-entry ?} "){" st) | |
1518 | (modify-syntax-entry ?$ "_" st) | |
1519 | (modify-syntax-entry ?. "." st) | |
1520 | (modify-syntax-entry ?\; "<" st) | |
1521 | (modify-syntax-entry ?\n ">" st) | |
1522 | (modify-syntax-entry ?\f ">" st) | |
1523 | st) | |
f32b3b91 CD |
1524 | "Syntax table in use in `idlwave-mode' buffers.") |
1525 | ||
f32b3b91 | 1526 | (defvar idlwave-find-symbol-syntax-table |
8d222148 SM |
1527 | (let ((st (copy-syntax-table idlwave-mode-syntax-table))) |
1528 | (modify-syntax-entry ?$ "w" st) | |
1529 | (modify-syntax-entry ?_ "w" st) | |
1530 | (modify-syntax-entry ?! "w" st) | |
1531 | (modify-syntax-entry ?. "w" st) | |
1532 | st) | |
f32b3b91 CD |
1533 | "Syntax table that treats symbol characters as word characters.") |
1534 | ||
76959b77 S |
1535 | (defmacro idlwave-with-special-syntax (&rest body) |
1536 | "Execute BODY with a different syntax table." | |
05a1abfc CD |
1537 | `(let ((saved-syntax (syntax-table))) |
1538 | (unwind-protect | |
1539 | (progn | |
1540 | (set-syntax-table idlwave-find-symbol-syntax-table) | |
1541 | ,@body) | |
1542 | (set-syntax-table saved-syntax)))) | |
1543 | ||
76959b77 S |
1544 | ;(defmacro idlwave-with-special-syntax1 (&rest body) |
1545 | ; "Execute BODY with a different syntax table." | |
1546 | ; `(let ((saved-syntax (syntax-table))) | |
1547 | ; (unwind-protect | |
1548 | ; (progn | |
1549 | ; (set-syntax-table idlwave-find-symbol-syntax-table) | |
1550 | ; ,@body) | |
1551 | ; (set-syntax-table saved-syntax)))) | |
1552 | ||
f32b3b91 CD |
1553 | (defun idlwave-action-and-binding (key cmd &optional select) |
1554 | "KEY and CMD are made into a key binding and an indent action. | |
1555 | KEY is a string - same as for the `define-key' function. CMD is a | |
1556 | function of no arguments or a list to be evaluated. CMD is bound to | |
1557 | KEY in `idlwave-mode-map' by defining an anonymous function calling | |
1558 | `self-insert-command' followed by CMD. If KEY contains more than one | |
1559 | character a binding will only be set if SELECT is 'both. | |
1560 | ||
5e72c6b2 | 1561 | \(KEY . CMD\) is also placed in the `idlwave-indent-expand-table', |
f32b3b91 CD |
1562 | replacing any previous value for KEY. If a binding is not set then it |
1563 | will instead be placed in `idlwave-indent-action-table'. | |
1564 | ||
1565 | If the optional argument SELECT is nil then an action and binding are | |
1566 | created. If SELECT is 'noaction, then a binding is always set and no | |
1567 | action is created. If SELECT is 'both then an action and binding | |
1568 | will both be created even if KEY contains more than one character. | |
1569 | Otherwise, if SELECT is non-nil then only an action is created. | |
1570 | ||
1571 | Some examples: | |
1572 | No spaces before and 1 after a comma | |
1573 | (idlwave-action-and-binding \",\" '(idlwave-surround 0 1)) | |
1574 | A minimum of 1 space before and after `=' (see `idlwave-expand-equal'). | |
1575 | (idlwave-action-and-binding \"=\" '(idlwave-expand-equal -1 -1)) | |
1576 | Capitalize system variables - action only | |
1577 | (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t)" | |
1578 | (if (not (equal select 'noaction)) | |
1579 | ;; Add action | |
1580 | (let* ((table (if select 'idlwave-indent-action-table | |
1581 | 'idlwave-indent-expand-table)) | |
3938cb82 S |
1582 | (table-key (regexp-quote key)) |
1583 | (cell (assoc table-key (eval table)))) | |
f32b3b91 CD |
1584 | (if cell |
1585 | ;; Replace action command | |
1586 | (setcdr cell cmd) | |
1587 | ;; New action | |
3938cb82 | 1588 | (set table (append (eval table) (list (cons table-key cmd))))))) |
f32b3b91 CD |
1589 | ;; Make key binding for action |
1590 | (if (or (and (null select) (= (length key) 1)) | |
1591 | (equal select 'noaction) | |
1592 | (equal select 'both)) | |
1593 | (define-key idlwave-mode-map key | |
8d222148 SM |
1594 | `(lambda () |
1595 | (interactive) | |
1596 | (self-insert-command 1) | |
4111f0c7 | 1597 | ,(if (listp cmd) cmd (list cmd)))))) |
f32b3b91 CD |
1598 | |
1599 | ;; Set action and key bindings. | |
1600 | ;; See description of the function `idlwave-action-and-binding'. | |
1601 | ;; Automatically add spaces for the following characters | |
f66f03de S |
1602 | |
1603 | ;; Actions for & are complicated by && | |
1604 | (idlwave-action-and-binding "&" 'idlwave-custom-ampersand-surround) | |
1605 | ||
1606 | ;; Automatically add spaces to equal sign if not keyword. This needs | |
1607 | ;; to go ahead of > and <, so >= and <= will be treated correctly | |
f32b3b91 CD |
1608 | (idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1)) |
1609 | ||
4b1aaa8b | 1610 | ;; Actions for > and < are complicated by >=, <=, and ->... |
f66f03de S |
1611 | (idlwave-action-and-binding "<" '(idlwave-custom-ltgtr-surround nil)) |
1612 | (idlwave-action-and-binding ">" '(idlwave-custom-ltgtr-surround 'gtr)) | |
1613 | ||
1614 | (idlwave-action-and-binding "," '(idlwave-surround 0 -1 1)) | |
1615 | ||
1616 | ||
f32b3b91 CD |
1617 | ;;; |
1618 | ;;; Abbrev Section | |
1619 | ;;; | |
1620 | ;;; When expanding abbrevs and the abbrev hook moves backward, an extra | |
1621 | ;;; space is inserted (this is the space typed by the user to expanded | |
1622 | ;;; the abbrev). | |
1623 | ;;; | |
5e72c6b2 | 1624 | (defvar idlwave-mode-abbrev-table nil |
5a0c3f56 | 1625 | "Abbreviation table used for IDLWAVE mode.") |
5e72c6b2 S |
1626 | (define-abbrev-table 'idlwave-mode-abbrev-table ()) |
1627 | ||
1628 | (defun idlwave-define-abbrev (name expansion hook &optional noprefix table) | |
1629 | "Define-abbrev with backward compatibility. | |
1630 | ||
1631 | If NOPREFIX is non-nil, don't prepend prefix character. Installs into | |
5a0c3f56 | 1632 | `idlwave-mode-abbrev-table' unless TABLE is non-nil." |
5e72c6b2 S |
1633 | (let ((abbrevs-changed nil) ;; mask the current value to avoid save |
1634 | (args (list (or table idlwave-mode-abbrev-table) | |
1635 | (if noprefix name (concat idlwave-abbrev-start-char name)) | |
1636 | expansion | |
1637 | hook))) | |
1638 | (condition-case nil | |
1639 | (apply 'define-abbrev (append args '(0 t))) | |
1640 | (error (apply 'define-abbrev args))))) | |
f32b3b91 CD |
1641 | |
1642 | (condition-case nil | |
4b1aaa8b | 1643 | (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) |
f32b3b91 CD |
1644 | "w" idlwave-mode-syntax-table) |
1645 | (error nil)) | |
1646 | ||
5e72c6b2 S |
1647 | ;; |
1648 | ;; Templates | |
1649 | ;; | |
1650 | (idlwave-define-abbrev "c" "" (idlwave-code-abbrev idlwave-case)) | |
1651 | (idlwave-define-abbrev "sw" "" (idlwave-code-abbrev idlwave-switch)) | |
1652 | (idlwave-define-abbrev "f" "" (idlwave-code-abbrev idlwave-for)) | |
1653 | (idlwave-define-abbrev "fu" "" (idlwave-code-abbrev idlwave-function)) | |
1654 | (idlwave-define-abbrev "pr" "" (idlwave-code-abbrev idlwave-procedure)) | |
1655 | (idlwave-define-abbrev "r" "" (idlwave-code-abbrev idlwave-repeat)) | |
1656 | (idlwave-define-abbrev "w" "" (idlwave-code-abbrev idlwave-while)) | |
1657 | (idlwave-define-abbrev "i" "" (idlwave-code-abbrev idlwave-if)) | |
1658 | (idlwave-define-abbrev "elif" "" (idlwave-code-abbrev idlwave-elif)) | |
1659 | ;; | |
1660 | ;; Keywords, system functions, conversion routines | |
1661 | ;; | |
1662 | (idlwave-define-abbrev "ap" "arg_present()" (idlwave-keyword-abbrev 1)) | |
1663 | (idlwave-define-abbrev "b" "begin" (idlwave-keyword-abbrev 0 t)) | |
1664 | (idlwave-define-abbrev "co" "common" (idlwave-keyword-abbrev 0 t)) | |
1665 | (idlwave-define-abbrev "cb" "byte()" (idlwave-keyword-abbrev 1)) | |
1666 | (idlwave-define-abbrev "cx" "fix()" (idlwave-keyword-abbrev 1)) | |
1667 | (idlwave-define-abbrev "cl" "long()" (idlwave-keyword-abbrev 1)) | |
1668 | (idlwave-define-abbrev "cf" "float()" (idlwave-keyword-abbrev 1)) | |
1669 | (idlwave-define-abbrev "cs" "string()" (idlwave-keyword-abbrev 1)) | |
1670 | (idlwave-define-abbrev "cc" "complex()" (idlwave-keyword-abbrev 1)) | |
1671 | (idlwave-define-abbrev "cd" "double()" (idlwave-keyword-abbrev 1)) | |
1672 | (idlwave-define-abbrev "e" "else" (idlwave-keyword-abbrev 0 t)) | |
1673 | (idlwave-define-abbrev "ec" "endcase" 'idlwave-show-begin) | |
1674 | (idlwave-define-abbrev "es" "endswitch" 'idlwave-show-begin) | |
1675 | (idlwave-define-abbrev "ee" "endelse" 'idlwave-show-begin) | |
1676 | (idlwave-define-abbrev "ef" "endfor" 'idlwave-show-begin) | |
1677 | (idlwave-define-abbrev "ei" "endif else if" 'idlwave-show-begin) | |
1678 | (idlwave-define-abbrev "el" "endif else" 'idlwave-show-begin) | |
1679 | (idlwave-define-abbrev "en" "endif" 'idlwave-show-begin) | |
1680 | (idlwave-define-abbrev "er" "endrep" 'idlwave-show-begin) | |
1681 | (idlwave-define-abbrev "ew" "endwhile" 'idlwave-show-begin) | |
1682 | (idlwave-define-abbrev "g" "goto," (idlwave-keyword-abbrev 0 t)) | |
1683 | (idlwave-define-abbrev "h" "help," (idlwave-keyword-abbrev 0)) | |
1684 | (idlwave-define-abbrev "k" "keyword_set()" (idlwave-keyword-abbrev 1)) | |
1685 | (idlwave-define-abbrev "n" "n_elements()" (idlwave-keyword-abbrev 1)) | |
1686 | (idlwave-define-abbrev "on" "on_error," (idlwave-keyword-abbrev 0)) | |
1687 | (idlwave-define-abbrev "oi" "on_ioerror," (idlwave-keyword-abbrev 0 1)) | |
1688 | (idlwave-define-abbrev "ow" "openw," (idlwave-keyword-abbrev 0)) | |
1689 | (idlwave-define-abbrev "or" "openr," (idlwave-keyword-abbrev 0)) | |
1690 | (idlwave-define-abbrev "ou" "openu," (idlwave-keyword-abbrev 0)) | |
1691 | (idlwave-define-abbrev "p" "print," (idlwave-keyword-abbrev 0)) | |
1692 | (idlwave-define-abbrev "pt" "plot," (idlwave-keyword-abbrev 0)) | |
1693 | (idlwave-define-abbrev "re" "read," (idlwave-keyword-abbrev 0)) | |
1694 | (idlwave-define-abbrev "rf" "readf," (idlwave-keyword-abbrev 0)) | |
1695 | (idlwave-define-abbrev "ru" "readu," (idlwave-keyword-abbrev 0)) | |
1696 | (idlwave-define-abbrev "rt" "return" (idlwave-keyword-abbrev 0)) | |
1697 | (idlwave-define-abbrev "sc" "strcompress()" (idlwave-keyword-abbrev 1)) | |
1698 | (idlwave-define-abbrev "sn" "strlen()" (idlwave-keyword-abbrev 1)) | |
1699 | (idlwave-define-abbrev "sl" "strlowcase()" (idlwave-keyword-abbrev 1)) | |
1700 | (idlwave-define-abbrev "su" "strupcase()" (idlwave-keyword-abbrev 1)) | |
1701 | (idlwave-define-abbrev "sm" "strmid()" (idlwave-keyword-abbrev 1)) | |
1702 | (idlwave-define-abbrev "sp" "strpos()" (idlwave-keyword-abbrev 1)) | |
1703 | (idlwave-define-abbrev "st" "strput()" (idlwave-keyword-abbrev 1)) | |
1704 | (idlwave-define-abbrev "sr" "strtrim()" (idlwave-keyword-abbrev 1)) | |
1705 | (idlwave-define-abbrev "t" "then" (idlwave-keyword-abbrev 0 t)) | |
1706 | (idlwave-define-abbrev "u" "until" (idlwave-keyword-abbrev 0 t)) | |
1707 | (idlwave-define-abbrev "wu" "writeu," (idlwave-keyword-abbrev 0)) | |
1708 | (idlwave-define-abbrev "iap" "if arg_present() then" (idlwave-keyword-abbrev 6)) | |
1709 | (idlwave-define-abbrev "ik" "if keyword_set() then" (idlwave-keyword-abbrev 6)) | |
1710 | (idlwave-define-abbrev "ine" "if n_elements() eq 0 then" (idlwave-keyword-abbrev 11)) | |
1711 | (idlwave-define-abbrev "inn" "if n_elements() ne 0 then" (idlwave-keyword-abbrev 11)) | |
1712 | (idlwave-define-abbrev "np" "n_params()" (idlwave-keyword-abbrev 0)) | |
1713 | (idlwave-define-abbrev "s" "size()" (idlwave-keyword-abbrev 1)) | |
1714 | (idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1)) | |
1715 | (idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0)) | |
3938cb82 S |
1716 | (idlwave-define-abbrev "pv" "ptr_valid()" (idlwave-keyword-abbrev 1)) |
1717 | (idlwave-define-abbrev "ipv" "if ptr_valid() then" (idlwave-keyword-abbrev 6)) | |
ff689efd | 1718 | |
5e72c6b2 S |
1719 | ;; This section is reserved words only. (From IDL user manual) |
1720 | ;; | |
1721 | (idlwave-define-abbrev "and" "and" (idlwave-keyword-abbrev 0 t) t) | |
1722 | (idlwave-define-abbrev "begin" "begin" (idlwave-keyword-abbrev 0 t) t) | |
1723 | (idlwave-define-abbrev "break" "break" (idlwave-keyword-abbrev 0 t) t) | |
1724 | (idlwave-define-abbrev "case" "case" (idlwave-keyword-abbrev 0 t) t) | |
1725 | (idlwave-define-abbrev "common" "common" (idlwave-keyword-abbrev 0 t) t) | |
1726 | (idlwave-define-abbrev "continue" "continue" (idlwave-keyword-abbrev 0 t) t) | |
1727 | (idlwave-define-abbrev "do" "do" (idlwave-keyword-abbrev 0 t) t) | |
1728 | (idlwave-define-abbrev "else" "else" (idlwave-keyword-abbrev 0 t) t) | |
1729 | (idlwave-define-abbrev "end" "end" 'idlwave-show-begin-check t) | |
1730 | (idlwave-define-abbrev "endcase" "endcase" 'idlwave-show-begin-check t) | |
1731 | (idlwave-define-abbrev "endelse" "endelse" 'idlwave-show-begin-check t) | |
1732 | (idlwave-define-abbrev "endfor" "endfor" 'idlwave-show-begin-check t) | |
1733 | (idlwave-define-abbrev "endif" "endif" 'idlwave-show-begin-check t) | |
1734 | (idlwave-define-abbrev "endrep" "endrep" 'idlwave-show-begin-check t) | |
1735 | (idlwave-define-abbrev "endswitch" "endswitch" 'idlwave-show-begin-check t) | |
1736 | (idlwave-define-abbrev "endwhi" "endwhi" 'idlwave-show-begin-check t) | |
1737 | (idlwave-define-abbrev "endwhile" "endwhile" 'idlwave-show-begin-check t) | |
1738 | (idlwave-define-abbrev "eq" "eq" (idlwave-keyword-abbrev 0 t) t) | |
1739 | (idlwave-define-abbrev "for" "for" (idlwave-keyword-abbrev 0 t) t) | |
1740 | (idlwave-define-abbrev "function" "function" (idlwave-keyword-abbrev 0 t) t) | |
1741 | (idlwave-define-abbrev "ge" "ge" (idlwave-keyword-abbrev 0 t) t) | |
1742 | (idlwave-define-abbrev "goto" "goto" (idlwave-keyword-abbrev 0 t) t) | |
1743 | (idlwave-define-abbrev "gt" "gt" (idlwave-keyword-abbrev 0 t) t) | |
1744 | (idlwave-define-abbrev "if" "if" (idlwave-keyword-abbrev 0 t) t) | |
1745 | (idlwave-define-abbrev "le" "le" (idlwave-keyword-abbrev 0 t) t) | |
1746 | (idlwave-define-abbrev "lt" "lt" (idlwave-keyword-abbrev 0 t) t) | |
1747 | (idlwave-define-abbrev "mod" "mod" (idlwave-keyword-abbrev 0 t) t) | |
1748 | (idlwave-define-abbrev "ne" "ne" (idlwave-keyword-abbrev 0 t) t) | |
1749 | (idlwave-define-abbrev "not" "not" (idlwave-keyword-abbrev 0 t) t) | |
1750 | (idlwave-define-abbrev "of" "of" (idlwave-keyword-abbrev 0 t) t) | |
1751 | (idlwave-define-abbrev "on_ioerror" "on_ioerror" (idlwave-keyword-abbrev 0 t) t) | |
1752 | (idlwave-define-abbrev "or" "or" (idlwave-keyword-abbrev 0 t) t) | |
1753 | (idlwave-define-abbrev "pro" "pro" (idlwave-keyword-abbrev 0 t) t) | |
1754 | (idlwave-define-abbrev "repeat" "repeat" (idlwave-keyword-abbrev 0 t) t) | |
1755 | (idlwave-define-abbrev "switch" "switch" (idlwave-keyword-abbrev 0 t) t) | |
1756 | (idlwave-define-abbrev "then" "then" (idlwave-keyword-abbrev 0 t) t) | |
1757 | (idlwave-define-abbrev "until" "until" (idlwave-keyword-abbrev 0 t) t) | |
1758 | (idlwave-define-abbrev "while" "while" (idlwave-keyword-abbrev 0 t) t) | |
1759 | (idlwave-define-abbrev "xor" "xor" (idlwave-keyword-abbrev 0 t) t) | |
f32b3b91 CD |
1760 | |
1761 | (defvar imenu-create-index-function) | |
1762 | (defvar extract-index-name-function) | |
1763 | (defvar prev-index-position-function) | |
1764 | (defvar imenu-extract-index-name-function) | |
1765 | (defvar imenu-prev-index-position-function) | |
5e72c6b2 | 1766 | ;; defined later - so just make the compiler hush |
4b1aaa8b | 1767 | (defvar idlwave-mode-menu) |
f32b3b91 CD |
1768 | (defvar idlwave-mode-debug-menu) |
1769 | ||
1770 | ;;;###autoload | |
175069ef | 1771 | (define-derived-mode idlwave-mode prog-mode "IDLWAVE" |
e08734e2 | 1772 | "Major mode for editing IDL source files (version 6.1_em22). |
f32b3b91 CD |
1773 | |
1774 | The main features of this mode are | |
1775 | ||
1776 | 1. Indentation and Formatting | |
1777 | -------------------------- | |
1778 | Like other Emacs programming modes, C-j inserts a newline and indents. | |
1779 | TAB is used for explicit indentation of the current line. | |
1780 | ||
5e72c6b2 S |
1781 | To start a continuation line, use \\[idlwave-split-line]. This |
1782 | function can also be used in the middle of a line to split the line | |
1783 | at that point. When used inside a long constant string, the string | |
1784 | is split at that point with the `+' concatenation operator. | |
f32b3b91 CD |
1785 | |
1786 | Comments are indented as follows: | |
1787 | ||
1788 | `;;;' Indentation remains unchanged. | |
1789 | `;;' Indent like the surrounding code | |
1790 | `;' Indent to a minimum column. | |
1791 | ||
1792 | The indentation of comments starting in column 0 is never changed. | |
1793 | ||
5e72c6b2 S |
1794 | Use \\[idlwave-fill-paragraph] to refill a paragraph inside a |
1795 | comment. The indentation of the second line of the paragraph | |
1796 | relative to the first will be retained. Use | |
1797 | \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these | |
1798 | comments. When the variable `idlwave-fill-comment-line-only' is | |
52a244eb | 1799 | nil, code can also be auto-filled and auto-indented. |
f32b3b91 CD |
1800 | |
1801 | To convert pre-existing IDL code to your formatting style, mark the | |
5e72c6b2 S |
1802 | entire buffer with \\[mark-whole-buffer] and execute |
1803 | \\[idlwave-expand-region-abbrevs]. Then mark the entire buffer | |
1804 | again followed by \\[indent-region] (`indent-region'). | |
f32b3b91 CD |
1805 | |
1806 | 2. Routine Info | |
1807 | ------------ | |
5e72c6b2 S |
1808 | IDLWAVE displays information about the calling sequence and the |
1809 | accepted keyword parameters of a procedure or function with | |
1810 | \\[idlwave-routine-info]. \\[idlwave-find-module] jumps to the | |
1811 | source file of a module. These commands know about system | |
1812 | routines, all routines in idlwave-mode buffers and (when the | |
1813 | idlwave-shell is active) about all modules currently compiled under | |
52a244eb S |
1814 | this shell. It also makes use of pre-compiled or custom-scanned |
1815 | user and library catalogs many popular libraries ship with by | |
1816 | default. Use \\[idlwave-update-routine-info] to update this | |
15e42531 CD |
1817 | information, which is also used for completion (see item 4). |
1818 | ||
1819 | 3. Online IDL Help | |
1820 | --------------- | |
f66f03de | 1821 | |
15e42531 | 1822 | \\[idlwave-context-help] displays the IDL documentation relevant |
f66f03de S |
1823 | for the system variable, keyword, or routines at point. A single |
1824 | key stroke gets you directly to the right place in the docs. See | |
52a244eb | 1825 | the manual to configure where and how the HTML help is displayed. |
f32b3b91 | 1826 | |
15e42531 | 1827 | 4. Completion |
f32b3b91 | 1828 | ---------- |
15e42531 | 1829 | \\[idlwave-complete] completes the names of procedures, functions |
52a244eb S |
1830 | class names, keyword parameters, system variables and tags, class |
1831 | tags, structure tags, filenames and much more. It is context | |
1832 | sensitive and figures out what is expected at point. Lower case | |
1833 | strings are completed in lower case, other strings in mixed or | |
1834 | upper case. | |
f32b3b91 | 1835 | |
15e42531 | 1836 | 5. Code Templates and Abbreviations |
f32b3b91 CD |
1837 | -------------------------------- |
1838 | Many Abbreviations are predefined to expand to code fragments and templates. | |
5a0c3f56 | 1839 | The abbreviations start generally with a `\\`. Some examples: |
f32b3b91 CD |
1840 | |
1841 | \\pr PROCEDURE template | |
1842 | \\fu FUNCTION template | |
1843 | \\c CASE statement template | |
05a1abfc | 1844 | \\sw SWITCH statement template |
f32b3b91 CD |
1845 | \\f FOR loop template |
1846 | \\r REPEAT Loop template | |
1847 | \\w WHILE loop template | |
1848 | \\i IF statement template | |
1849 | \\elif IF-ELSE statement template | |
1850 | \\b BEGIN | |
4b1aaa8b | 1851 | |
52a244eb S |
1852 | For a full list, use \\[idlwave-list-abbrevs]. Some templates also |
1853 | have direct keybindings - see the list of keybindings below. | |
775591f7 | 1854 | |
52a244eb S |
1855 | \\[idlwave-doc-header] inserts a documentation header at the |
1856 | beginning of the current program unit (pro, function or main). | |
1857 | Change log entries can be added to the current program unit with | |
1858 | \\[idlwave-doc-modification]. | |
f32b3b91 | 1859 | |
15e42531 | 1860 | 6. Automatic Case Conversion |
f32b3b91 CD |
1861 | ------------------------- |
1862 | The case of reserved words and some abbrevs is controlled by | |
1863 | `idlwave-reserved-word-upcase' and `idlwave-abbrev-change-case'. | |
1864 | ||
15e42531 | 1865 | 7. Automatic END completion |
f32b3b91 CD |
1866 | ------------------------ |
1867 | If the variable `idlwave-expand-generic-end' is non-nil, each END typed | |
1868 | will be converted to the specific version, like ENDIF, ENDFOR, etc. | |
1869 | ||
15e42531 | 1870 | 8. Hooks |
f32b3b91 CD |
1871 | ----- |
1872 | Loading idlwave.el runs `idlwave-load-hook'. | |
1873 | Turning on `idlwave-mode' runs `idlwave-mode-hook'. | |
1874 | ||
15e42531 | 1875 | 9. Documentation and Customization |
f32b3b91 | 1876 | ------------------------------- |
5e72c6b2 S |
1877 | Info documentation for this package is available. Use |
1878 | \\[idlwave-info] to display (complain to your sysadmin if that does | |
1879 | not work). For Postscript, PDF, and HTML versions of the | |
855b42a2 | 1880 | documentation, check IDLWAVE's homepage at URL `http://idlwave.org'. |
f32b3b91 CD |
1881 | IDLWAVE has customize support - see the group `idlwave'. |
1882 | ||
15e42531 | 1883 | 10.Keybindings |
f32b3b91 CD |
1884 | ----------- |
1885 | Here is a list of all keybindings of this mode. | |
1886 | If some of the key bindings below show with ??, use \\[describe-key] | |
1887 | followed by the key sequence to see what the key sequence does. | |
1888 | ||
1889 | \\{idlwave-mode-map}" | |
175069ef | 1890 | :abbrev-table idlwave-mode-abbrev-table |
f32b3b91 CD |
1891 | (if idlwave-startup-message |
1892 | (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) | |
1893 | (setq idlwave-startup-message nil) | |
4b1aaa8b | 1894 | |
f32b3b91 | 1895 | (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) |
4b1aaa8b | 1896 | |
175069ef SM |
1897 | (set (make-local-variable idlwave-comment-indent-function) |
1898 | #'idlwave-comment-hook) | |
4b1aaa8b | 1899 | |
f32b3b91 CD |
1900 | (set (make-local-variable 'comment-start-skip) ";+[ \t]*") |
1901 | (set (make-local-variable 'comment-start) ";") | |
0dc2be2f | 1902 | (set (make-local-variable 'comment-add) 1) ; ";;" for new and regions |
f32b3b91 CD |
1903 | (set (make-local-variable 'abbrev-all-caps) t) |
1904 | (set (make-local-variable 'indent-tabs-mode) nil) | |
1905 | (set (make-local-variable 'completion-ignore-case) t) | |
4b1aaa8b | 1906 | |
f32b3b91 CD |
1907 | (when (featurep 'easymenu) |
1908 | (easy-menu-add idlwave-mode-menu idlwave-mode-map) | |
1909 | (easy-menu-add idlwave-mode-debug-menu idlwave-mode-map)) | |
1910 | ||
f32b3b91 | 1911 | (setq abbrev-mode t) |
4b1aaa8b | 1912 | |
f32b3b91 CD |
1913 | (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) |
1914 | (setq comment-end "") | |
1915 | (set (make-local-variable 'comment-multi-line) nil) | |
4b1aaa8b | 1916 | (set (make-local-variable 'paragraph-separate) |
5e72c6b2 | 1917 | "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$") |
f32b3b91 CD |
1918 | (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") |
1919 | (set (make-local-variable 'paragraph-ignore-fill-prefix) nil) | |
76959b77 | 1920 | (set (make-local-variable 'parse-sexp-ignore-comments) t) |
775591f7 | 1921 | |
e08734e2 | 1922 | ;; ChangeLog |
8c43762b | 1923 | (set (make-local-variable 'add-log-current-defun-function) |
e08734e2 S |
1924 | 'idlwave-current-routine-fullname) |
1925 | ||
f32b3b91 CD |
1926 | ;; Set tag table list to use IDLTAGS as file name. |
1927 | (if (boundp 'tag-table-alist) | |
1928 | (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) | |
4b1aaa8b | 1929 | |
e08734e2 | 1930 | ;; Font-lock additions |
52a244eb | 1931 | ;; Following line is for Emacs - XEmacs uses the corresponding property |
f32b3b91 CD |
1932 | ;; on the `idlwave-mode' symbol. |
1933 | (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) | |
0dc2be2f S |
1934 | (set (make-local-variable 'font-lock-mark-block-function) |
1935 | 'idlwave-mark-subprogram) | |
1936 | (set (make-local-variable 'font-lock-fontify-region-function) | |
1937 | 'idlwave-font-lock-fontify-region) | |
f32b3b91 CD |
1938 | |
1939 | ;; Imenu setup | |
1940 | (set (make-local-variable 'imenu-create-index-function) | |
1941 | 'imenu-default-create-index-function) | |
1942 | (set (make-local-variable 'imenu-extract-index-name-function) | |
1943 | 'idlwave-unit-name) | |
1944 | (set (make-local-variable 'imenu-prev-index-position-function) | |
1945 | 'idlwave-prev-index-position) | |
1946 | ||
0dc2be2f S |
1947 | ;; HideShow setup |
1948 | (add-to-list 'hs-special-modes-alist | |
1949 | (list 'idlwave-mode | |
1950 | idlwave-begin-block-reg | |
1951 | idlwave-end-block-reg | |
1952 | ";" | |
1953 | 'idlwave-forward-block nil)) | |
4b1aaa8b | 1954 | |
f32b3b91 | 1955 | ;; Make a local post-command-hook and add our hook to it |
f66f03de S |
1956 | ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility |
1957 | ;; (make-local-hook 'post-command-hook) | |
15e42531 CD |
1958 | (add-hook 'post-command-hook 'idlwave-command-hook nil 'local) |
1959 | ||
1960 | ;; Make local hooks for buffer updates | |
f66f03de S |
1961 | ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility |
1962 | ;; (make-local-hook 'kill-buffer-hook) | |
15e42531 | 1963 | (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local) |
f66f03de | 1964 | ;; (make-local-hook 'after-save-hook) |
e08734e2 | 1965 | (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) |
15e42531 CD |
1966 | (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) |
1967 | ||
52a244eb S |
1968 | ;; Setup directories and file, if necessary |
1969 | (idlwave-setup) | |
1970 | ||
15e42531 CD |
1971 | ;; Update the routine info with info about current buffer? |
1972 | (idlwave-new-buffer-update) | |
f32b3b91 | 1973 | |
f66f03de | 1974 | ;; Check help location |
175069ef | 1975 | (idlwave-help-check-locations)) |
f32b3b91 | 1976 | |
52a244eb S |
1977 | (defvar idlwave-setup-done nil) |
1978 | (defun idlwave-setup () | |
1979 | (unless idlwave-setup-done | |
1980 | (if (not (file-directory-p idlwave-config-directory)) | |
1981 | (make-directory idlwave-config-directory)) | |
4b1aaa8b PE |
1982 | (setq |
1983 | idlwave-user-catalog-file (expand-file-name | |
1984 | idlwave-user-catalog-file | |
f66f03de | 1985 | idlwave-config-directory) |
4b1aaa8b PE |
1986 | idlwave-xml-system-rinfo-converted-file |
1987 | (expand-file-name | |
f66f03de S |
1988 | idlwave-xml-system-rinfo-converted-file |
1989 | idlwave-config-directory) | |
4b1aaa8b PE |
1990 | idlwave-path-file (expand-file-name |
1991 | idlwave-path-file | |
f66f03de | 1992 | idlwave-config-directory)) |
52a244eb S |
1993 | (idlwave-read-paths) ; we may need these early |
1994 | (setq idlwave-setup-done t))) | |
1995 | ||
0dc2be2f S |
1996 | (defun idlwave-font-lock-fontify-region (beg end &optional verbose) |
1997 | "Fontify continuation lines correctly." | |
1998 | (let (pos) | |
1999 | (save-excursion | |
2000 | (goto-char beg) | |
2001 | (forward-line -1) | |
2002 | (when (setq pos (idlwave-is-continuation-line)) | |
2003 | (goto-char pos) | |
2004 | (idlwave-beginning-of-statement) | |
2005 | (setq beg (point))))) | |
2006 | (font-lock-default-fontify-region beg end verbose)) | |
2007 | ||
f32b3b91 | 2008 | ;; |
52a244eb | 2009 | ;; Code Formatting ---------------------------------------------------- |
4b1aaa8b | 2010 | ;; |
f32b3b91 | 2011 | |
f32b3b91 | 2012 | (defun idlwave-hard-tab () |
5a0c3f56 | 2013 | "Insert TAB in buffer in current position." |
f32b3b91 CD |
2014 | (interactive) |
2015 | (insert "\t")) | |
2016 | ||
2017 | ;;; This stuff is experimental | |
2018 | ||
2019 | (defvar idlwave-command-hook nil | |
2020 | "If non-nil, a list that can be evaluated using `eval'. | |
2021 | It is evaluated in the lisp function `idlwave-command-hook' which is | |
2022 | placed in `post-command-hook'.") | |
2023 | ||
2024 | (defun idlwave-command-hook () | |
2025 | "Command run after every command. | |
2026 | Evaluates a non-nil value of the *variable* `idlwave-command-hook' and | |
2027 | sets the variable to zero afterwards." | |
2028 | (and idlwave-command-hook | |
2029 | (listp idlwave-command-hook) | |
2030 | (condition-case nil | |
2031 | (eval idlwave-command-hook) | |
2032 | (error nil))) | |
2033 | (setq idlwave-command-hook nil)) | |
2034 | ||
2035 | ;;; End experiment | |
2036 | ||
2037 | ;; It would be better to use expand.el for better abbrev handling and | |
2038 | ;; versatility. | |
2039 | ||
2040 | (defun idlwave-check-abbrev (arg &optional reserved) | |
5a0c3f56 | 2041 | "Reverse abbrev expansion if in comment or string. |
f32b3b91 CD |
2042 | Argument ARG is the number of characters to move point |
2043 | backward if `idlwave-abbrev-move' is non-nil. | |
2044 | If optional argument RESERVED is non-nil then the expansion | |
2045 | consists of reserved words, which will be capitalized if | |
2046 | `idlwave-reserved-word-upcase' is non-nil. | |
2047 | Otherwise, the abbrev will be capitalized if `idlwave-abbrev-change-case' | |
2048 | is non-nil, unless its value is \`down in which case the abbrev will be | |
2049 | made into all lowercase. | |
2050 | Returns non-nil if abbrev is left expanded." | |
2051 | (if (idlwave-quoted) | |
2052 | (progn (unexpand-abbrev) | |
2053 | nil) | |
2054 | (if (and reserved idlwave-reserved-word-upcase) | |
2055 | (upcase-region last-abbrev-location (point)) | |
2056 | (cond | |
2057 | ((equal idlwave-abbrev-change-case 'down) | |
2058 | (downcase-region last-abbrev-location (point))) | |
2059 | (idlwave-abbrev-change-case | |
2060 | (upcase-region last-abbrev-location (point))))) | |
2061 | (if (and idlwave-abbrev-move (> arg 0)) | |
2062 | (if (boundp 'post-command-hook) | |
2063 | (setq idlwave-command-hook (list 'backward-char (1+ arg))) | |
2064 | (backward-char arg))) | |
2065 | t)) | |
2066 | ||
2067 | (defun idlwave-in-comment () | |
5a0c3f56 | 2068 | "Return t if point is inside a comment, nil otherwise." |
f32b3b91 CD |
2069 | (save-excursion |
2070 | (let ((here (point))) | |
2071 | (and (idlwave-goto-comment) (> here (point)))))) | |
2072 | ||
2073 | (defun idlwave-goto-comment () | |
2074 | "Move to start of comment delimiter on current line. | |
2075 | Moves to end of line if there is no comment delimiter. | |
2076 | Ignores comment delimiters in strings. | |
2077 | Returns point if comment found and nil otherwise." | |
9b026d9f | 2078 | (let ((eos (point-at-eol)) |
f32b3b91 CD |
2079 | (data (match-data)) |
2080 | found) | |
2081 | ;; Look for first comment delimiter not in a string | |
2082 | (beginning-of-line) | |
2083 | (setq found (search-forward comment-start eos 'lim)) | |
2084 | (while (and found (idlwave-in-quote)) | |
2085 | (setq found (search-forward comment-start eos 'lim))) | |
2086 | (store-match-data data) | |
2087 | (and found (not (idlwave-in-quote)) | |
2088 | (progn | |
2089 | (backward-char 1) | |
2090 | (point))))) | |
2091 | ||
5e72c6b2 | 2092 | (defun idlwave-region-active-p () |
a00e54f7 RS |
2093 | "Should we operate on an active region?" |
2094 | (if (fboundp 'use-region-p) | |
2095 | (use-region-p) | |
2096 | (region-active-p))) | |
5e72c6b2 | 2097 | |
f32b3b91 CD |
2098 | (defun idlwave-show-matching-quote () |
2099 | "Insert quote and show matching quote if this is end of a string." | |
2100 | (interactive) | |
2101 | (let ((bq (idlwave-in-quote)) | |
1ba983e8 | 2102 | (inq last-command-event)) |
f32b3b91 CD |
2103 | (if (and bq (not (idlwave-in-comment))) |
2104 | (let ((delim (char-after bq))) | |
2105 | (insert inq) | |
2106 | (if (eq inq delim) | |
2107 | (save-excursion | |
2108 | (goto-char bq) | |
2109 | (sit-for 1)))) | |
2110 | ;; Not the end of a string | |
2111 | (insert inq)))) | |
2112 | ||
2113 | (defun idlwave-show-begin-check () | |
2114 | "Ensure that the previous word was a token before `idlwave-show-begin'. | |
2115 | An END token must be preceded by whitespace." | |
5e72c6b2 S |
2116 | (if (not (idlwave-quoted)) |
2117 | (if | |
2118 | (save-excursion | |
2119 | (backward-word 1) | |
2120 | (backward-char 1) | |
2121 | (looking-at "[ \t\n\f]")) | |
2122 | (idlwave-show-begin)))) | |
f32b3b91 CD |
2123 | |
2124 | (defun idlwave-show-begin () | |
5a0c3f56 JB |
2125 | "Find the start of current block and blinks to it for a second. |
2126 | Also checks if the correct END statement has been used." | |
f32b3b91 | 2127 | ;; All end statements are reserved words |
76959b77 | 2128 | ;; Re-indent end line |
52a244eb S |
2129 | ;;(insert-char ?\ 1) ;; So indent, etc. work well |
2130 | ;;(backward-char 1) | |
76959b77 S |
2131 | (let* ((pos (point-marker)) |
2132 | (last-abbrev-marker (copy-marker last-abbrev-location)) | |
e180ab9f | 2133 | (eol-pos (point-at-eol)) |
76959b77 S |
2134 | begin-pos end-pos end end1 ) |
2135 | (if idlwave-reindent-end (idlwave-indent-line)) | |
52a244eb | 2136 | (setq last-abbrev-location (marker-position last-abbrev-marker)) |
f32b3b91 CD |
2137 | (when (and (idlwave-check-abbrev 0 t) |
2138 | idlwave-show-block) | |
2139 | (save-excursion | |
2140 | ;; Move inside current block | |
76959b77 | 2141 | (goto-char last-abbrev-marker) |
f32b3b91 | 2142 | (idlwave-block-jump-out -1 'nomark) |
76959b77 S |
2143 | (setq begin-pos (point)) |
2144 | (idlwave-block-jump-out 1 'nomark) | |
2145 | (setq end-pos (point)) | |
2146 | (if (> end-pos eol-pos) | |
2147 | (setq end-pos pos)) | |
2148 | (goto-char end-pos) | |
4b1aaa8b | 2149 | (setq end (buffer-substring |
76959b77 S |
2150 | (progn |
2151 | (skip-chars-backward "a-zA-Z") | |
2152 | (point)) | |
2153 | end-pos)) | |
2154 | (goto-char begin-pos) | |
f32b3b91 CD |
2155 | (when (setq end1 (cdr (idlwave-block-master))) |
2156 | (cond | |
5e72c6b2 | 2157 | ((null end1)) ; no-operation |
f32b3b91 CD |
2158 | ((string= (downcase end) (downcase end1)) |
2159 | (sit-for 1)) | |
2160 | ((string= (downcase end) "end") | |
2161 | ;; A generic end | |
2162 | (if idlwave-expand-generic-end | |
2163 | (save-excursion | |
2164 | (goto-char pos) | |
2165 | (backward-char 3) | |
2166 | (insert (if (string= end "END") (upcase end1) end1)) | |
2167 | (delete-char 3))) | |
2168 | (sit-for 1)) | |
2169 | (t | |
2170 | (beep) | |
4b1aaa8b | 2171 | (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" |
f32b3b91 | 2172 | end1 end) |
52a244eb S |
2173 | (sit-for 1)))))))) |
2174 | ;;(delete-char 1)) | |
f32b3b91 CD |
2175 | |
2176 | (defun idlwave-block-master () | |
2177 | (let ((case-fold-search t)) | |
2178 | (save-excursion | |
2179 | (cond | |
05a1abfc | 2180 | ((looking-at "pro\\|case\\|switch\\|function\\>") |
f32b3b91 CD |
2181 | (assoc (downcase (match-string 0)) idlwave-block-matches)) |
2182 | ((looking-at "begin\\>") | |
4b1aaa8b PE |
2183 | (let ((limit (save-excursion |
2184 | (idlwave-beginning-of-statement) | |
f32b3b91 CD |
2185 | (point)))) |
2186 | (cond | |
52a244eb S |
2187 | ((re-search-backward ":[ \t]*\\=" limit t) |
2188 | ;; seems to be a case thing | |
2189 | '("begin" . "end")) | |
f32b3b91 CD |
2190 | ((re-search-backward idlwave-block-match-regexp limit t) |
2191 | (assoc (downcase (match-string 1)) | |
2192 | idlwave-block-matches)) | |
f32b3b91 | 2193 | (t |
52a244eb | 2194 | ;; Just a normal block |
f32b3b91 CD |
2195 | '("begin" . "end"))))) |
2196 | (t nil))))) | |
2197 | ||
2198 | (defun idlwave-close-block () | |
2199 | "Terminate the current block with the correct END statement." | |
2200 | (interactive) | |
f32b3b91 CD |
2201 | ;; Start new line if we are not in a new line |
2202 | (unless (save-excursion | |
2203 | (skip-chars-backward " \t") | |
2204 | (bolp)) | |
2205 | (let ((idlwave-show-block nil)) | |
2206 | (newline-and-indent))) | |
5e72c6b2 S |
2207 | (let ((last-abbrev-location (point))) ; for upcasing |
2208 | (insert "end") | |
2209 | (idlwave-show-begin))) | |
2210 | ||
f66f03de | 2211 | (defun idlwave-custom-ampersand-surround (&optional is-action) |
5a0c3f56 | 2212 | "Surround &, leaving room for && (which surround as well)." |
f66f03de S |
2213 | (let* ((prev-char (char-after (- (point) 2))) |
2214 | (next-char (char-after (point))) | |
2215 | (amp-left (eq prev-char ?&)) | |
2216 | (amp-right (eq next-char ?&)) | |
2217 | (len (if amp-left 2 1))) | |
2218 | (unless amp-right ;no need to do it twice, amp-left will catch it. | |
2219 | (idlwave-surround -1 (if (or is-action amp-left) -1) len)))) | |
2220 | ||
2221 | (defun idlwave-custom-ltgtr-surround (gtr &optional is-action) | |
2222 | "Surround > and < by blanks, leaving room for >= and <=, and considering ->." | |
2223 | (let* ((prev-char (char-after (- (point) 2))) | |
2224 | (next-char (char-after (point))) | |
2225 | (method-invoke (and gtr (eq prev-char ?-))) | |
2226 | (len (if method-invoke 2 1))) | |
2227 | (unless (eq next-char ?=) | |
2228 | ;; Key binding: pad only on left, to save for possible >=/<= | |
2229 | (idlwave-surround -1 (if (or is-action method-invoke) -1) len)))) | |
2230 | ||
2231 | (defun idlwave-surround (&optional before after length is-action) | |
595ab50b CD |
2232 | "Surround the LENGTH characters before point with blanks. |
2233 | LENGTH defaults to 1. | |
f32b3b91 | 2234 | Optional arguments BEFORE and AFTER affect the behavior before and |
595ab50b CD |
2235 | after the characters (see also description of `idlwave-make-space'): |
2236 | ||
2237 | nil do nothing | |
2238 | 0 force no spaces | |
2239 | integer > 0 force exactly n spaces | |
2240 | integer < 0 at least |n| spaces | |
f32b3b91 CD |
2241 | |
2242 | The function does nothing if any of the following conditions is true: | |
2243 | - `idlwave-surround-by-blank' is nil | |
f66f03de | 2244 | - the character before point is inside a string or comment" |
5e72c6b2 | 2245 | (when (and idlwave-surround-by-blank (not (idlwave-quoted))) |
f66f03de S |
2246 | (let ((length (or length 1))) ; establish a default for LENGTH |
2247 | (backward-char length) | |
2248 | (save-restriction | |
2249 | (let ((here (point))) | |
2250 | (skip-chars-backward " \t") | |
2251 | (if (bolp) | |
2252 | ;; avoid clobbering indent | |
2253 | (progn | |
2254 | (move-to-column (idlwave-calculate-indent)) | |
2255 | (if (<= (point) here) | |
2256 | (narrow-to-region (point) here)) | |
2257 | (goto-char here))) | |
2258 | (idlwave-make-space before)) | |
2259 | (skip-chars-forward " \t")) | |
2260 | (forward-char length) | |
2261 | (idlwave-make-space after) | |
2262 | ;; Check to see if the line should auto wrap | |
2263 | (if (and (equal (char-after (1- (point))) ?\ ) | |
2264 | (> (current-column) fill-column)) | |
2265 | (funcall auto-fill-function))))) | |
f32b3b91 CD |
2266 | |
2267 | (defun idlwave-make-space (n) | |
2268 | "Make space at point. | |
2269 | The space affected is all the spaces and tabs around point. | |
2270 | If n is non-nil then point is left abs(n) spaces from the beginning of | |
2271 | the contiguous space. | |
2272 | The amount of space at point is determined by N. | |
2273 | If the value of N is: | |
2274 | nil - do nothing. | |
595ab50b CD |
2275 | > 0 - exactly N spaces. |
2276 | < 0 - a minimum of -N spaces, i.e., do not change if there are | |
2277 | already -N spaces. | |
2278 | 0 - no spaces (i.e. remove any existing space)." | |
f32b3b91 CD |
2279 | (if (integerp n) |
2280 | (let | |
2281 | ((start-col (progn (skip-chars-backward " \t") (current-column))) | |
2282 | (left (point)) | |
2283 | (end-col (progn (skip-chars-forward " \t") (current-column)))) | |
2284 | (delete-horizontal-space) | |
2285 | (cond | |
2286 | ((> n 0) | |
2287 | (idlwave-indent-to (+ start-col n)) | |
2288 | (goto-char (+ left n))) | |
2289 | ((< n 0) | |
2290 | (idlwave-indent-to end-col (- n)) | |
2291 | (goto-char (- left n))) | |
2292 | ;; n = 0, done | |
2293 | )))) | |
2294 | ||
2295 | (defun idlwave-newline () | |
5a0c3f56 | 2296 | "Insert a newline and indent the current and previous line." |
f32b3b91 CD |
2297 | (interactive) |
2298 | ;; | |
2299 | ;; Handle unterminated single and double quotes | |
2300 | ;; If not in a comment and in a string then insertion of a newline | |
2301 | ;; will mean unbalanced quotes. | |
2302 | ;; | |
2303 | (if (and (not (idlwave-in-comment)) (idlwave-in-quote)) | |
2304 | (progn (beep) | |
2305 | (message "Warning: unbalanced quotes?"))) | |
2306 | (newline) | |
2307 | ;; | |
2308 | ;; The current line is being split, the cursor should be at the | |
2309 | ;; beginning of the new line skipping the leading indentation. | |
2310 | ;; | |
2311 | ;; The reason we insert the new line before indenting is that the | |
2312 | ;; indenting could be confused by keywords (e.g. END) on the line | |
2313 | ;; after the split point. This prevents us from just using | |
2314 | ;; `indent-for-tab-command' followed by `newline-and-indent'. | |
2315 | ;; | |
2316 | (beginning-of-line 0) | |
2317 | (idlwave-indent-line) | |
2318 | (forward-line) | |
2319 | (idlwave-indent-line)) | |
2320 | ||
2321 | ;; | |
2322 | ;; Use global variable 'comment-column' to set parallel comment | |
2323 | ;; | |
2324 | ;; Modeled on lisp.el | |
2325 | ;; Emacs Lisp and IDL (Wave CL) have identical comment syntax | |
2326 | (defun idlwave-comment-hook () | |
2327 | "Compute indent for the beginning of the IDL comment delimiter." | |
2328 | (if (or (looking-at idlwave-no-change-comment) | |
8d222148 | 2329 | (looking-at (or idlwave-begin-line-comment "^;"))) |
f32b3b91 CD |
2330 | (current-column) |
2331 | (if (looking-at idlwave-code-comment) | |
2332 | (if (save-excursion (skip-chars-backward " \t") (bolp)) | |
2333 | ;; On line by itself, indent as code | |
2334 | (let ((tem (idlwave-calculate-indent))) | |
2335 | (if (listp tem) (car tem) tem)) | |
2336 | ;; after code - do not change | |
2337 | (current-column)) | |
2338 | (skip-chars-backward " \t") | |
2339 | (max (if (bolp) 0 (1+ (current-column))) | |
2340 | comment-column)))) | |
2341 | ||
2342 | (defun idlwave-split-line () | |
2343 | "Continue line by breaking line at point and indent the lines. | |
5a0c3f56 | 2344 | For a code line insert continuation marker. If the line is a line comment |
f32b3b91 CD |
2345 | then the new line will contain a comment with the same indentation. |
2346 | Splits strings with the IDL operator `+' if `idlwave-split-line-string' is | |
2347 | non-nil." | |
2348 | (interactive) | |
15e42531 CD |
2349 | ;; Expand abbreviation, just like normal RET would. |
2350 | (and abbrev-mode (expand-abbrev)) | |
f32b3b91 CD |
2351 | (let (beg) |
2352 | (if (not (idlwave-in-comment)) | |
2353 | ;; For code line add continuation. | |
2354 | ;; Check if splitting a string. | |
2355 | (progn | |
2356 | (if (setq beg (idlwave-in-quote)) | |
2357 | (if idlwave-split-line-string | |
2358 | ;; Split the string. | |
2359 | (progn (insert (setq beg (char-after beg)) " + " | |
2360 | idlwave-continuation-char beg) | |
5e72c6b2 S |
2361 | (backward-char 1) |
2362 | (newline-and-indent) | |
2363 | (forward-char 1)) | |
f32b3b91 CD |
2364 | ;; Do not split the string. |
2365 | (beep) | |
2366 | (message "Warning: continuation inside string!!") | |
2367 | (insert " " idlwave-continuation-char)) | |
2368 | ;; Not splitting a string. | |
15e42531 CD |
2369 | (if (not (member (char-before) '(?\ ?\t))) |
2370 | (insert " ")) | |
5e72c6b2 S |
2371 | (insert idlwave-continuation-char) |
2372 | (newline-and-indent))) | |
f32b3b91 CD |
2373 | (indent-new-comment-line)) |
2374 | ;; Indent previous line | |
2375 | (setq beg (- (point-max) (point))) | |
2376 | (forward-line -1) | |
2377 | (idlwave-indent-line) | |
2378 | (goto-char (- (point-max) beg)) | |
2379 | ;; Reindent new line | |
2380 | (idlwave-indent-line))) | |
2381 | ||
cca13260 | 2382 | (defun idlwave-beginning-of-subprogram (&optional nomark) |
5a0c3f56 | 2383 | "Move point to the beginning of the current program unit. |
cca13260 | 2384 | If NOMARK is non-nil, do not push mark." |
f32b3b91 | 2385 | (interactive) |
cca13260 | 2386 | (idlwave-find-key idlwave-begin-unit-reg -1 nomark)) |
f32b3b91 | 2387 | |
cca13260 | 2388 | (defun idlwave-end-of-subprogram (&optional nomark) |
5a0c3f56 | 2389 | "Move point to the start of the next program unit. |
cca13260 | 2390 | If NOMARK is non-nil, do not push mark." |
f32b3b91 CD |
2391 | (interactive) |
2392 | (idlwave-end-of-statement) | |
cca13260 | 2393 | (idlwave-find-key idlwave-end-unit-reg 1 nomark)) |
f32b3b91 CD |
2394 | |
2395 | (defun idlwave-mark-statement () | |
2396 | "Mark current IDL statement." | |
2397 | (interactive) | |
2398 | (idlwave-end-of-statement) | |
2399 | (let ((end (point))) | |
2400 | (idlwave-beginning-of-statement) | |
0dc2be2f | 2401 | (push-mark end nil t))) |
f32b3b91 CD |
2402 | |
2403 | (defun idlwave-mark-block () | |
2404 | "Mark containing block." | |
2405 | (interactive) | |
2406 | (idlwave-end-of-statement) | |
2407 | (idlwave-backward-up-block -1) | |
2408 | (idlwave-end-of-statement) | |
2409 | (let ((end (point))) | |
2410 | (idlwave-backward-block) | |
2411 | (idlwave-beginning-of-statement) | |
0dc2be2f | 2412 | (push-mark end nil t))) |
f32b3b91 CD |
2413 | |
2414 | ||
2415 | (defun idlwave-mark-subprogram () | |
2416 | "Put mark at beginning of program, point at end. | |
2417 | The marks are pushed." | |
2418 | (interactive) | |
2419 | (idlwave-end-of-statement) | |
2420 | (idlwave-beginning-of-subprogram) | |
2421 | (let ((beg (point))) | |
2422 | (idlwave-forward-block) | |
0dc2be2f | 2423 | (push-mark beg nil t)) |
f32b3b91 CD |
2424 | (exchange-point-and-mark)) |
2425 | ||
2426 | (defun idlwave-backward-up-block (&optional arg) | |
2427 | "Move to beginning of enclosing block if prefix ARG >= 0. | |
2428 | If prefix ARG < 0 then move forward to enclosing block end." | |
2429 | (interactive "p") | |
2430 | (idlwave-block-jump-out (- arg) 'nomark)) | |
2431 | ||
2432 | (defun idlwave-beginning-of-block () | |
2433 | "Go to the beginning of the current block." | |
2434 | (interactive) | |
2435 | (idlwave-block-jump-out -1 'nomark) | |
2436 | (forward-word 1)) | |
2437 | ||
2438 | (defun idlwave-end-of-block () | |
2439 | "Go to the beginning of the current block." | |
2440 | (interactive) | |
2441 | (idlwave-block-jump-out 1 'nomark) | |
2442 | (backward-word 1)) | |
2443 | ||
0dc2be2f | 2444 | (defun idlwave-forward-block (&optional arg) |
f32b3b91 CD |
2445 | "Move across next nested block." |
2446 | (interactive) | |
0dc2be2f S |
2447 | (let ((arg (or arg 1))) |
2448 | (if (idlwave-down-block arg) | |
2449 | (idlwave-block-jump-out arg 'nomark)))) | |
f32b3b91 CD |
2450 | |
2451 | (defun idlwave-backward-block () | |
2452 | "Move backward across previous nested block." | |
2453 | (interactive) | |
2454 | (if (idlwave-down-block -1) | |
2455 | (idlwave-block-jump-out -1 'nomark))) | |
2456 | ||
2457 | (defun idlwave-down-block (&optional arg) | |
2458 | "Go down a block. | |
2459 | With ARG: ARG >= 0 go forwards, ARG < 0 go backwards. | |
bbd240ce | 2460 | Returns non-nil if successful." |
f32b3b91 CD |
2461 | (interactive "p") |
2462 | (let (status) | |
2463 | (if (< arg 0) | |
2464 | ;; Backward | |
2465 | (let ((eos (save-excursion | |
2466 | (idlwave-block-jump-out -1 'nomark) | |
2467 | (point)))) | |
4b1aaa8b | 2468 | (if (setq status (idlwave-find-key |
f32b3b91 CD |
2469 | idlwave-end-block-reg -1 'nomark eos)) |
2470 | (idlwave-beginning-of-statement) | |
2471 | (message "No nested block before beginning of containing block."))) | |
2472 | ;; Forward | |
2473 | (let ((eos (save-excursion | |
2474 | (idlwave-block-jump-out 1 'nomark) | |
2475 | (point)))) | |
4b1aaa8b | 2476 | (if (setq status (idlwave-find-key |
f32b3b91 CD |
2477 | idlwave-begin-block-reg 1 'nomark eos)) |
2478 | (idlwave-end-of-statement) | |
2479 | (message "No nested block before end of containing block.")))) | |
2480 | status)) | |
2481 | ||
2482 | (defun idlwave-mark-doclib () | |
2483 | "Put point at beginning of doc library header, mark at end. | |
2484 | The marks are pushed." | |
2485 | (interactive) | |
2486 | (let (beg | |
2487 | (here (point))) | |
2488 | (goto-char (point-max)) | |
2489 | (if (re-search-backward idlwave-doclib-start nil t) | |
4b1aaa8b | 2490 | (progn |
f32b3b91 CD |
2491 | (setq beg (progn (beginning-of-line) (point))) |
2492 | (if (re-search-forward idlwave-doclib-end nil t) | |
2493 | (progn | |
2494 | (forward-line 1) | |
0dc2be2f | 2495 | (push-mark beg nil t) |
f32b3b91 CD |
2496 | (message "Could not find end of doc library header."))) |
2497 | (message "Could not find doc library header start.") | |
2498 | (goto-char here))))) | |
2499 | ||
e08734e2 S |
2500 | (defun idlwave-current-routine-fullname () |
2501 | (let ((name (idlwave-current-routine))) | |
2502 | (idlwave-make-full-name (nth 2 name) (car name)))) | |
2503 | ||
15e42531 CD |
2504 | (defun idlwave-current-routine () |
2505 | "Return (NAME TYPE CLASS) of current routine." | |
2506 | (idlwave-routines) | |
2507 | (save-excursion | |
cca13260 | 2508 | (idlwave-beginning-of-subprogram 'nomark) |
15e42531 CD |
2509 | (if (looking-at "[ \t]*\\<\\(pro\\|function\\)\\>\\s-+\\(\\([a-zA-Z0-9$_]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)") |
2510 | (let* ((type (if (string= (downcase (match-string 1)) "pro") | |
2511 | 'pro 'function)) | |
2512 | (class (idlwave-sintern-class (match-string 3))) | |
2513 | (name (idlwave-sintern-routine-or-method (match-string 4) class))) | |
2514 | (list name type class))))) | |
2515 | ||
f32b3b91 CD |
2516 | (defvar idlwave-shell-prompt-pattern) |
2517 | (defun idlwave-beginning-of-statement () | |
2518 | "Move to beginning of the current statement. | |
2519 | Skips back past statement continuations. | |
2520 | Point is placed at the beginning of the line whether or not this is an | |
2521 | actual statement." | |
2522 | (interactive) | |
2523 | (cond | |
175069ef | 2524 | ((derived-mode-p 'idlwave-shell-mode) |
f32b3b91 CD |
2525 | (if (re-search-backward idlwave-shell-prompt-pattern nil t) |
2526 | (goto-char (match-end 0)))) | |
4b1aaa8b | 2527 | (t |
f32b3b91 CD |
2528 | (if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) |
2529 | (idlwave-previous-statement) | |
2530 | (beginning-of-line))))) | |
2531 | ||
2532 | (defun idlwave-previous-statement () | |
5a0c3f56 | 2533 | "Move point to beginning of the previous statement. |
f32b3b91 CD |
2534 | Returns t if the current line before moving is the beginning of |
2535 | the first non-comment statement in the file, and nil otherwise." | |
2536 | (interactive) | |
2537 | (let (first-statement) | |
2538 | (if (not (= (forward-line -1) 0)) | |
2539 | ;; first line in file | |
2540 | t | |
2541 | ;; skip blank lines, label lines, include lines and line comments | |
2542 | (while (and | |
2543 | ;; The current statement is the first statement until we | |
2544 | ;; reach another statement. | |
2545 | (setq first-statement | |
2546 | (or | |
2547 | (looking-at idlwave-comment-line-start-skip) | |
2548 | (looking-at "[ \t]*$") | |
2549 | (looking-at (concat "[ \t]*" idlwave-label "[ \t]*$")) | |
2550 | (looking-at "^@"))) | |
2551 | (= (forward-line -1) 0))) | |
2552 | ;; skip continuation lines | |
2553 | (while (and | |
2554 | (save-excursion | |
2555 | (forward-line -1) | |
2556 | (idlwave-is-continuation-line)) | |
2557 | (= (forward-line -1) 0))) | |
2558 | first-statement))) | |
2559 | ||
f32b3b91 | 2560 | (defun idlwave-end-of-statement () |
5a0c3f56 | 2561 | "Move point to the end of the current IDL statement. |
05a1abfc CD |
2562 | If not in a statement just moves to end of line. Returns position." |
2563 | (interactive) | |
2564 | (while (and (idlwave-is-continuation-line) | |
2565 | (= (forward-line 1) 0)) | |
2566 | (while (and (idlwave-is-comment-or-empty-line) | |
2567 | (= (forward-line 1) 0)))) | |
2568 | (end-of-line) | |
2569 | (point)) | |
2570 | ||
2571 | (defun idlwave-end-of-statement0 () | |
5a0c3f56 JB |
2572 | "Move point to the end of the current IDL statement. |
2573 | If not in a statement just moves to end of line. Returns position." | |
f32b3b91 CD |
2574 | (interactive) |
2575 | (while (and (idlwave-is-continuation-line) | |
2576 | (= (forward-line 1) 0))) | |
2577 | (end-of-line) | |
2578 | (point)) | |
2579 | ||
2580 | (defun idlwave-next-statement () | |
5a0c3f56 JB |
2581 | "Move point to beginning of the next IDL statement. |
2582 | Returns t if that statement is the last non-comment IDL statement | |
2583 | in the file, and nil otherwise." | |
f32b3b91 CD |
2584 | (interactive) |
2585 | (let (last-statement) | |
2586 | (idlwave-end-of-statement) | |
2587 | ;; skip blank lines, label lines, include lines and line comments | |
2588 | (while (and (= (forward-line 1) 0) | |
2589 | ;; The current statement is the last statement until | |
2590 | ;; we reach a new statement. | |
2591 | (setq last-statement | |
2592 | (or | |
2593 | (looking-at idlwave-comment-line-start-skip) | |
2594 | (looking-at "[ \t]*$") | |
2595 | (looking-at (concat "[ \t]*" idlwave-label "[ \t]*$")) | |
2596 | (looking-at "^@"))))) | |
2597 | last-statement)) | |
2598 | ||
76959b77 S |
2599 | (defun idlwave-skip-multi-commands (&optional lim) |
2600 | "Skip past multiple commands on a line (with `&')." | |
2601 | (let ((save-point (point))) | |
2602 | (when (re-search-forward ".*&" lim t) | |
2603 | (goto-char (match-end 0)) | |
4b1aaa8b | 2604 | (if (idlwave-quoted) |
6b75c9af S |
2605 | (goto-char save-point) |
2606 | (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point)))) | |
76959b77 S |
2607 | (point))) |
2608 | ||
15e42531 | 2609 | (defun idlwave-skip-label-or-case () |
f32b3b91 CD |
2610 | "Skip label or case statement element. |
2611 | Returns position after label. | |
2612 | If there is no label point is not moved and nil is returned." | |
15e42531 CD |
2613 | ;; Case expressions and labels are terminated by a colon. |
2614 | ;; So we find the first colon in the line and make sure | |
2615 | ;; - no `?' is before it (might be a ? b : c) | |
2616 | ;; - it is not in a comment | |
2617 | ;; - not in a string constant | |
2618 | ;; - not in parenthesis (like a[0:3]) | |
5e72c6b2 | 2619 | ;; - not followed by another ":" in explicit class, ala a->b::c |
15e42531 | 2620 | ;; As many in this mode, this function is heuristic and not an exact |
4b1aaa8b | 2621 | ;; parser. |
5e72c6b2 S |
2622 | (let* ((start (point)) |
2623 | (eos (save-excursion (idlwave-end-of-statement) (point))) | |
2624 | (end (idlwave-find-key ":" 1 'nomark eos))) | |
f32b3b91 | 2625 | (if (and end |
15e42531 | 2626 | (= (nth 0 (parse-partial-sexp start end)) 0) |
5e72c6b2 S |
2627 | (not (string-match "\\?" (buffer-substring start end))) |
2628 | (not (string-match "^::" (buffer-substring end eos)))) | |
f32b3b91 CD |
2629 | (progn |
2630 | (forward-char) | |
2631 | (point)) | |
2632 | (goto-char start) | |
2633 | nil))) | |
2634 | ||
2635 | (defun idlwave-start-of-substatement (&optional pre) | |
2636 | "Move to start of next IDL substatement after point. | |
2637 | Uses the type of the current IDL statement to determine if the next | |
2638 | statement is on a new line or is a subpart of the current statement. | |
2639 | Returns point at start of substatement modulo whitespace. | |
2640 | If optional argument is non-nil move to beginning of current | |
15e42531 | 2641 | substatement." |
f32b3b91 CD |
2642 | (let ((orig (point)) |
2643 | (eos (idlwave-end-of-statement)) | |
2644 | (ifnest 0) | |
2645 | st nst last) | |
2646 | (idlwave-beginning-of-statement) | |
15e42531 | 2647 | (idlwave-skip-label-or-case) |
52a244eb S |
2648 | (if (< (point) orig) |
2649 | (idlwave-skip-multi-commands orig)) | |
f32b3b91 CD |
2650 | (setq last (point)) |
2651 | ;; Continue looking for substatements until we are past orig | |
2652 | (while (and (<= (point) orig) (not (eobp))) | |
2653 | (setq last (point)) | |
2654 | (setq nst (nth 1 (cdr (setq st (car (idlwave-statement-type)))))) | |
2655 | (if (equal (car st) 'if) (setq ifnest (1+ ifnest))) | |
2656 | (cond ((and nst | |
2657 | (idlwave-find-key nst 1 'nomark eos)) | |
2658 | (goto-char (match-end 0))) | |
2659 | ((and (> ifnest 0) (idlwave-find-key "\\<else\\>" 1 'nomark eos)) | |
2660 | (setq ifnest (1- ifnest)) | |
2661 | (goto-char (match-end 0))) | |
2662 | (t (setq ifnest 0) | |
2663 | (idlwave-next-statement)))) | |
2664 | (if pre (goto-char last)) | |
15e42531 CD |
2665 | ;; If a continuation line starts here, move to next line |
2666 | (if (looking-at "[ \t]*\\$\\([ \t]*\\(;\\|$\\)\\)") | |
2667 | (beginning-of-line 2)) | |
f32b3b91 CD |
2668 | (point))) |
2669 | ||
2670 | (defun idlwave-statement-type () | |
2671 | "Return the type of the current IDL statement. | |
2672 | Uses `idlwave-statement-match' to return a cons of (type . point) with | |
5a0c3f56 | 2673 | point the ending position where the type was determined. Type is the |
f32b3b91 | 2674 | association from `idlwave-statement-match', i.e. the cons cell from the |
5a0c3f56 | 2675 | list not just the type symbol. Returns nil if not an identifiable |
f32b3b91 CD |
2676 | statement." |
2677 | (save-excursion | |
2678 | ;; Skip whitespace within a statement which is spaces, tabs, continuations | |
76959b77 S |
2679 | ;; and possibly comments |
2680 | (while (looking-at "[ \t]*\\$") | |
f32b3b91 CD |
2681 | (forward-line 1)) |
2682 | (skip-chars-forward " \t") | |
2683 | (let ((st idlwave-statement-match) | |
2684 | (case-fold-search t)) | |
2685 | (while (and (not (looking-at (nth 0 (cdr (car st))))) | |
2686 | (setq st (cdr st)))) | |
2687 | (if st | |
2688 | (append st (match-end 0)))))) | |
2689 | ||
f66f03de | 2690 | (defun idlwave-expand-equal (&optional before after is-action) |
5a0c3f56 JB |
2691 | "Pad '=' with spaces. |
2692 | Two cases: Assignment statement, and keyword assignment. | |
2693 | Which case is determined using `idlwave-start-of-substatement' and | |
2694 | `idlwave-statement-type'. The equal sign will be surrounded by BEFORE | |
2695 | and AFTER blanks. If `idlwave-pad-keyword' is t then keyword assignment | |
2696 | is treated just like assignment statements. When nil, spaces are | |
2697 | removed for keyword assignment. Any other value keeps the current space | |
2698 | around the `='. Limits in for loops are treated as keyword assignment. | |
52a244eb S |
2699 | |
2700 | Starting with IDL 6.0, a number of op= assignments are available. | |
2701 | Since ambiguities of the form: | |
2702 | ||
2703 | r and= b | |
2704 | rand= b | |
2705 | ||
2706 | can occur, alphanumeric operator assignment will never be pre-padded, | |
2707 | only post-padded. You must use a space before these to disambiguate | |
2708 | \(not just for padding, but for proper parsing by IDL too!). Other | |
2709 | operators, such as ##=, ^=, etc., will be pre-padded. | |
2710 | ||
f66f03de S |
2711 | IS-ACTION is ignored. |
2712 | ||
52a244eb | 2713 | See `idlwave-surround'." |
f32b3b91 | 2714 | (if idlwave-surround-by-blank |
4b1aaa8b | 2715 | (let |
52a244eb | 2716 | ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=") |
4b1aaa8b | 2717 | (an-ops |
52a244eb S |
2718 | "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=") |
2719 | (len 1)) | |
4b1aaa8b PE |
2720 | |
2721 | (save-excursion | |
52a244eb S |
2722 | (let ((case-fold-search t)) |
2723 | (backward-char) | |
4b1aaa8b | 2724 | (if (or |
52a244eb S |
2725 | (re-search-backward non-an-ops nil t) |
2726 | ;; Why doesn't ##? work for both? | |
4b1aaa8b | 2727 | (re-search-backward "\\(#\\)\\=" nil t)) |
52a244eb S |
2728 | (setq len (1+ (length (match-string 1)))) |
2729 | (when (re-search-backward an-ops nil t) | |
3938cb82 | 2730 | ;(setq begin nil) ; won't modify begin |
52a244eb | 2731 | (setq len (1+ (length (match-string 1)))))))) |
4b1aaa8b PE |
2732 | |
2733 | (if (eq t idlwave-pad-keyword) | |
52a244eb | 2734 | ;; Everything gets padded equally |
f66f03de | 2735 | (idlwave-surround before after len) |
52a244eb S |
2736 | ;; Treating keywords/for variables specially... |
2737 | (let ((st (save-excursion ; To catch "for" variables | |
2738 | (idlwave-start-of-substatement t) | |
2739 | (idlwave-statement-type))) | |
2740 | (what (save-excursion ; To catch keywords | |
2741 | (skip-chars-backward "= \t") | |
2742 | (nth 2 (idlwave-where))))) | |
2743 | (cond ((or (memq what '(function-keyword procedure-keyword)) | |
4b1aaa8b PE |
2744 | (memq (caar st) '(for pdef))) |
2745 | (cond | |
52a244eb S |
2746 | ((null idlwave-pad-keyword) |
2747 | (idlwave-surround 0 0) | |
2748 | ) ; remove space | |
2749 | (t))) ; leave any spaces alone | |
f66f03de | 2750 | (t (idlwave-surround before after len)))))))) |
4b1aaa8b | 2751 | |
f32b3b91 | 2752 | |
5e72c6b2 S |
2753 | (defun idlwave-indent-and-action (&optional arg) |
2754 | "Call `idlwave-indent-line' and do expand actions. | |
2755 | With prefix ARG non-nil, indent the entire sub-statement." | |
2756 | (interactive "p") | |
05a1abfc | 2757 | (save-excursion |
4b1aaa8b PE |
2758 | (if (and idlwave-expand-generic-end |
2759 | (re-search-backward "\\<\\(end\\)\\s-*\\=" | |
05a1abfc CD |
2760 | (max 0 (- (point) 10)) t) |
2761 | (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)")) | |
2762 | (progn (goto-char (match-end 1)) | |
5e72c6b2 S |
2763 | ;;Expand the END abbreviation, just as RET or Space would have. |
2764 | (if abbrev-mode (expand-abbrev) | |
2765 | (idlwave-show-begin))))) | |
52a244eb S |
2766 | (when (and (not arg) current-prefix-arg) |
2767 | (setq arg current-prefix-arg) | |
2768 | (setq current-prefix-arg nil)) | |
4b1aaa8b | 2769 | (if arg |
5e72c6b2 S |
2770 | (idlwave-indent-statement) |
2771 | (idlwave-indent-line t))) | |
f32b3b91 CD |
2772 | |
2773 | (defun idlwave-indent-line (&optional expand) | |
5a0c3f56 | 2774 | "Indent current IDL line as code or as a comment. |
f32b3b91 CD |
2775 | The actions in `idlwave-indent-action-table' are performed. |
2776 | If the optional argument EXPAND is non-nil then the actions in | |
2777 | `idlwave-indent-expand-table' are performed." | |
2778 | (interactive) | |
2779 | ;; Move point out of left margin. | |
2780 | (if (save-excursion | |
2781 | (skip-chars-backward " \t") | |
2782 | (bolp)) | |
2783 | (skip-chars-forward " \t")) | |
2784 | (let ((mloc (point-marker))) | |
2785 | (save-excursion | |
2786 | (beginning-of-line) | |
2787 | (if (looking-at idlwave-comment-line-start-skip) | |
2788 | ;; Indentation for a line comment | |
2789 | (progn | |
2790 | (skip-chars-forward " \t") | |
2791 | (idlwave-indent-left-margin (idlwave-comment-hook))) | |
2792 | ;; | |
2793 | ;; Code Line | |
2794 | ;; | |
2795 | ;; Before indenting, run action routines. | |
2796 | ;; | |
2797 | (if (and expand idlwave-do-actions) | |
8ffcfb27 | 2798 | (mapc 'idlwave-do-action idlwave-indent-expand-table)) |
f32b3b91 CD |
2799 | ;; |
2800 | (if idlwave-do-actions | |
8ffcfb27 | 2801 | (mapc 'idlwave-do-action idlwave-indent-action-table)) |
f32b3b91 CD |
2802 | ;; |
2803 | ;; No longer expand abbrevs on the line. The user can do this | |
2804 | ;; manually using expand-region-abbrevs. | |
2805 | ;; | |
2806 | ;; Indent for code line | |
2807 | ;; | |
2808 | (beginning-of-line) | |
2809 | (if (or | |
2810 | ;; a label line | |
2811 | (looking-at (concat "^" idlwave-label "[ \t]*$")) | |
2812 | ;; a batch command | |
2813 | (looking-at "^[ \t]*@")) | |
2814 | ;; leave flush left | |
2815 | nil | |
2816 | ;; indent the line | |
2817 | (idlwave-indent-left-margin (idlwave-calculate-indent))) | |
2818 | ;; Adjust parallel comment | |
76959b77 S |
2819 | (end-of-line) |
2820 | (if (idlwave-in-comment) | |
2821 | ;; Emacs 21 is too smart with fill-column on comment indent | |
2822 | (let ((fill-column (if (fboundp 'comment-indent-new-line) | |
2823 | (1- (frame-width)) | |
2824 | fill-column))) | |
2825 | (indent-for-comment))))) | |
f32b3b91 CD |
2826 | (goto-char mloc) |
2827 | ;; Get rid of marker | |
76959b77 | 2828 | (set-marker mloc nil))) |
f32b3b91 CD |
2829 | |
2830 | (defun idlwave-do-action (action) | |
5a0c3f56 JB |
2831 | "Perform an action repeatedly on a line. |
2832 | ACTION is a list (REG . FUNC). REG is a regular expression. FUNC is | |
2833 | either a function name to be called with `funcall' or a list to be | |
2834 | evaluated with `eval'. The action performed by FUNC should leave | |
2835 | point after the match for REG - otherwise an infinite loop may be | |
2836 | entered. FUNC is always passed a final argument of 'is-action, so it | |
2837 | can discriminate between being run as an action, or a key binding." | |
f32b3b91 CD |
2838 | (let ((action-key (car action)) |
2839 | (action-routine (cdr action))) | |
2840 | (beginning-of-line) | |
2841 | (while (idlwave-look-at action-key) | |
2842 | (if (listp action-routine) | |
f66f03de S |
2843 | (eval (append action-routine '('is-action))) |
2844 | (funcall action-routine 'is-action))))) | |
f32b3b91 CD |
2845 | |
2846 | (defun idlwave-indent-to (col &optional min) | |
2847 | "Indent from point with spaces until column COL. | |
2848 | Inserts space before markers at point." | |
2849 | (if (not min) (setq min 0)) | |
2850 | (insert-before-markers | |
15e42531 | 2851 | (make-string (max min (- col (current-column))) ?\ ))) |
f32b3b91 CD |
2852 | |
2853 | (defun idlwave-indent-left-margin (col) | |
2854 | "Indent the current line to column COL. | |
2855 | Indents such that first non-whitespace character is at column COL | |
2856 | Inserts spaces before markers at point." | |
2857 | (save-excursion | |
2858 | (beginning-of-line) | |
2859 | (delete-horizontal-space) | |
2860 | (idlwave-indent-to col))) | |
2861 | ||
2862 | (defun idlwave-indent-subprogram () | |
5a0c3f56 | 2863 | "Indent program unit which contains point." |
f32b3b91 CD |
2864 | (interactive) |
2865 | (save-excursion | |
2866 | (idlwave-end-of-statement) | |
2867 | (idlwave-beginning-of-subprogram) | |
2868 | (let ((beg (point))) | |
2869 | (idlwave-forward-block) | |
2870 | (message "Indenting subprogram...") | |
2871 | (indent-region beg (point) nil)) | |
2872 | (message "Indenting subprogram...done."))) | |
2873 | ||
5e72c6b2 S |
2874 | (defun idlwave-indent-statement () |
2875 | "Indent current statement, including all continuation lines." | |
2876 | (interactive) | |
2877 | (save-excursion | |
2878 | (idlwave-beginning-of-statement) | |
2879 | (let ((beg (point))) | |
2880 | (idlwave-end-of-statement) | |
2881 | (indent-region beg (point) nil)))) | |
2882 | ||
f32b3b91 CD |
2883 | (defun idlwave-calculate-indent () |
2884 | "Return appropriate indentation for current line as IDL code." | |
2885 | (save-excursion | |
2886 | (beginning-of-line) | |
2887 | (cond | |
2888 | ;; Check for beginning of unit - main (beginning of buffer), pro, or | |
2889 | ;; function | |
2890 | ((idlwave-look-at idlwave-begin-unit-reg) | |
2891 | 0) | |
2892 | ;; Check for continuation line | |
2893 | ((save-excursion | |
2894 | (and (= (forward-line -1) 0) | |
2895 | (idlwave-is-continuation-line))) | |
2896 | (idlwave-calculate-cont-indent)) | |
2897 | ;; calculate indent based on previous and current statements | |
52a244eb S |
2898 | (t (let* (beg-prev-pos |
2899 | (the-indent | |
2900 | ;; calculate indent based on previous statement | |
2901 | (save-excursion | |
2902 | (cond | |
2903 | ;; Beginning of file | |
4b1aaa8b | 2904 | ((prog1 |
52a244eb S |
2905 | (idlwave-previous-statement) |
2906 | (setq beg-prev-pos (point))) | |
2907 | 0) | |
2908 | ;; Main block | |
2909 | ((idlwave-look-at idlwave-begin-unit-reg t) | |
2910 | (+ (idlwave-current-statement-indent) | |
2911 | idlwave-main-block-indent)) | |
2912 | ;; Begin block | |
2913 | ((idlwave-look-at idlwave-begin-block-reg t) | |
4b1aaa8b | 2914 | (+ (idlwave-min-current-statement-indent) |
52a244eb S |
2915 | idlwave-block-indent)) |
2916 | ;; End Block | |
2917 | ((idlwave-look-at idlwave-end-block-reg t) | |
2918 | (progn | |
2919 | ;; Match to the *beginning* of the block opener | |
2920 | (goto-char beg-prev-pos) | |
2921 | (idlwave-block-jump-out -1 'nomark) ; go to begin block | |
2922 | (idlwave-min-current-statement-indent))) | |
2923 | ;; idlwave-end-offset | |
2924 | ;; idlwave-block-indent)) | |
4b1aaa8b | 2925 | |
52a244eb S |
2926 | ;; Default to current indent |
2927 | ((idlwave-current-statement-indent)))))) | |
f32b3b91 CD |
2928 | ;; adjust the indentation based on the current statement |
2929 | (cond | |
2930 | ;; End block | |
5e72c6b2 S |
2931 | ((idlwave-look-at idlwave-end-block-reg) |
2932 | (+ the-indent idlwave-end-offset)) | |
f32b3b91 CD |
2933 | (the-indent))))))) |
2934 | ||
2935 | ;; | |
52a244eb | 2936 | ;; Parentheses indent |
f32b3b91 CD |
2937 | ;; |
2938 | ||
5e72c6b2 S |
2939 | (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) |
2940 | "Calculate the continuation indent inside a paren group. | |
4b1aaa8b | 2941 | Returns a cons-cell with (open . indent), where open is the |
5a0c3f56 | 2942 | location of the open paren." |
5e72c6b2 S |
2943 | (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) |
2944 | ;; Found an innermost open paren. | |
2945 | (when open | |
2946 | (goto-char open) | |
2947 | ;; Line up with next word unless this is a closing paren. | |
2948 | (cons open | |
2949 | (cond | |
52a244eb S |
2950 | ;; Plain Kernighan-style nested indent |
2951 | (idlwave-indent-parens-nested | |
2952 | (+ idlwave-continuation-indent (idlwave-current-indent))) | |
2953 | ||
5e72c6b2 S |
2954 | ;; This is a closed paren - line up under open paren. |
2955 | (close-exp | |
2956 | (current-column)) | |
52a244eb S |
2957 | |
2958 | ;; Empty (or just comment) follows -- revert to basic indent | |
5e72c6b2 S |
2959 | ((progn |
2960 | ;; Skip paren | |
2961 | (forward-char 1) | |
2962 | (looking-at "[ \t$]*\\(;.*\\)?$")) | |
52a244eb S |
2963 | nil) |
2964 | ||
2965 | ;; Line up with first word after any blank space | |
5e72c6b2 S |
2966 | ((progn |
2967 | (skip-chars-forward " \t") | |
2968 | (current-column)))))))) | |
2969 | ||
f32b3b91 | 2970 | (defun idlwave-calculate-cont-indent () |
5a0c3f56 JB |
2971 | "Calculates the IDL continuation indent column from the previous statement. |
2972 | Note that here previous statement usually means the beginning of the | |
2973 | current statement if this statement is a continuation of the previous | |
2974 | line. Various special types of continuations, including assignments, | |
2975 | routine definitions, and parenthetical groupings, are treated separately." | |
f32b3b91 | 2976 | (save-excursion |
52a244eb | 2977 | (let* ((case-fold-search t) |
f32b3b91 | 2978 | (end-reg (progn (beginning-of-line) (point))) |
52a244eb S |
2979 | (beg-last-statement (save-excursion (idlwave-previous-statement) |
2980 | (point))) | |
4b1aaa8b | 2981 | (beg-reg (progn (idlwave-start-of-substatement 'pre) |
52a244eb S |
2982 | (if (eq (line-beginning-position) end-reg) |
2983 | (goto-char beg-last-statement) | |
2984 | (point)))) | |
2985 | (basic-indent (+ (idlwave-min-current-statement-indent end-reg) | |
2986 | idlwave-continuation-indent)) | |
2987 | fancy-nonparen-indent fancy-paren-indent) | |
4b1aaa8b | 2988 | (cond |
52a244eb S |
2989 | ;; Align then with its matching if, etc. |
2990 | ((let ((matchers '(("\\<if\\>" . "[ \t]*then") | |
2991 | ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else") | |
2992 | ("\\<\\(for\\|while\\)\\>" . "[ \t]*do") | |
4b1aaa8b | 2993 | ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . |
52a244eb S |
2994 | "[ \t]*until") |
2995 | ("\\<case\\>" . "[ \t]*of"))) | |
2996 | match cont-re) | |
2997 | (goto-char end-reg) | |
4b1aaa8b | 2998 | (and |
52a244eb S |
2999 | (setq cont-re |
3000 | (catch 'exit | |
3001 | (while (setq match (car matchers)) | |
3002 | (if (looking-at (cdr match)) | |
3003 | (throw 'exit (car match))) | |
3004 | (setq matchers (cdr matchers))))) | |
3005 | (idlwave-find-key cont-re -1 'nomark beg-last-statement))) | |
3006 | (if (looking-at "end") ;; that one's special | |
4b1aaa8b | 3007 | (- (idlwave-current-indent) |
52a244eb S |
3008 | (+ idlwave-block-indent idlwave-end-offset)) |
3009 | (idlwave-current-indent))) | |
3010 | ||
3011 | ;; Indent in from the previous line for continuing statements | |
3012 | ((let ((matchers '("\\<then\\>" | |
3013 | "\\<do\\>" | |
3014 | "\\<repeat\\>" | |
3015 | "\\<else\\>")) | |
3016 | match) | |
3017 | (catch 'exit | |
3018 | (goto-char end-reg) | |
3019 | (if (/= (forward-line -1) 0) | |
3020 | (throw 'exit nil)) | |
3021 | (while (setq match (car matchers)) | |
3022 | (if (looking-at (concat ".*" match "[ \t]*\\$[ \t]*" | |
3023 | "\\(;.*\\)?$")) | |
3024 | (throw 'exit t)) | |
3025 | (setq matchers (cdr matchers))))) | |
3026 | (+ idlwave-continuation-indent (idlwave-current-indent))) | |
3027 | ||
3028 | ;; Parenthetical indent, either traditional or Kernighan style | |
3029 | ((setq fancy-paren-indent | |
3030 | (let* ((end-reg end-reg) | |
3031 | (close-exp (progn | |
3032 | (goto-char end-reg) | |
4b1aaa8b | 3033 | (skip-chars-forward " \t") |
52a244eb S |
3034 | (looking-at "\\s)"))) |
3035 | indent-cons) | |
3036 | (catch 'loop | |
3037 | (while (setq indent-cons (idlwave-calculate-paren-indent | |
3038 | beg-reg end-reg close-exp)) | |
3039 | ;; First permitted containing paren | |
3040 | (if (or | |
3041 | idlwave-indent-to-open-paren | |
3042 | idlwave-indent-parens-nested | |
3043 | (null (cdr indent-cons)) | |
3044 | (< (- (cdr indent-cons) basic-indent) | |
3045 | idlwave-max-extra-continuation-indent)) | |
3046 | (throw 'loop (cdr indent-cons))) | |
3047 | (setq end-reg (car indent-cons)))))) | |
5e72c6b2 S |
3048 | fancy-paren-indent) |
3049 | ||
52a244eb S |
3050 | ;; A continued assignment, or procedure call/definition |
3051 | ((and | |
3052 | (> idlwave-max-extra-continuation-indent 0) | |
3053 | (setq fancy-nonparen-indent | |
3054 | (progn | |
3055 | (goto-char beg-reg) | |
3056 | (while (idlwave-look-at "&")) ; skip continued statements | |
3057 | (cond | |
3058 | ;; A continued Procedure call or definition | |
3059 | ((progn | |
3060 | (idlwave-look-at "^[ \t]*\\(pro\\|function\\)") ;skip over | |
3061 | (looking-at "[ \t]*\\([a-zA-Z0-9.$_]+[ \t]*->[ \t]*\\)?[a-zA-Z][:a-zA-Z0-9$_]*[ \t]*\\(,\\)[ \t]*")) | |
3062 | (goto-char (match-end 0)) | |
3063 | ;; Comment only, or blank line with "$"? Basic indent. | |
3064 | (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) | |
3065 | nil | |
3066 | (current-column))) | |
4b1aaa8b | 3067 | |
52a244eb S |
3068 | ;; Continued assignment (with =): |
3069 | ((catch 'assign ; | |
3070 | (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*") | |
3071 | (goto-char (match-end 0)) | |
4b1aaa8b | 3072 | (if (null (idlwave-what-function beg-reg)) |
52a244eb S |
3073 | (throw 'assign t)))) |
3074 | (unless (or | |
3075 | (idlwave-in-quote) | |
3076 | (looking-at "[ \t$]*\\(;.*\\)?$") ; use basic | |
3077 | (save-excursion | |
3078 | (goto-char beg-last-statement) | |
3079 | (eq (caar (idlwave-statement-type)) 'for))) | |
3080 | (current-column)))))) | |
3081 | (< (- fancy-nonparen-indent basic-indent) | |
3082 | idlwave-max-extra-continuation-indent)) | |
3083 | (if fancy-paren-indent ;calculated but disallowed paren indent | |
3084 | (+ fancy-nonparen-indent idlwave-continuation-indent) | |
3085 | fancy-nonparen-indent)) | |
3086 | ||
3087 | ;; Basic indent, by default | |
3088 | (t basic-indent))))) | |
3089 | ||
3090 | ||
f32b3b91 | 3091 | |
15e42531 CD |
3092 | (defun idlwave-find-key (key-re &optional dir nomark limit) |
3093 | "Move to next match of the regular expression KEY-RE. | |
3094 | Matches inside comments or string constants will be ignored. | |
3095 | If DIR is negative, the search will be backwards. | |
3096 | At a successful match, the mark is pushed unless NOMARK is non-nil. | |
3097 | Searches are limited to LIMIT. | |
3098 | Searches are case-insensitive and use a special syntax table which | |
3099 | treats `$' and `_' as word characters. | |
3100 | Return value is the beginning of the match or (in case of failure) nil." | |
3101 | (setq dir (or dir 0)) | |
3102 | (let ((case-fold-search t) | |
3103 | (search-func (if (> dir 0) 're-search-forward 're-search-backward)) | |
3104 | found) | |
3105 | (idlwave-with-special-syntax | |
3106 | (save-excursion | |
3107 | (catch 'exit | |
3108 | (while (funcall search-func key-re limit t) | |
3109 | (if (not (idlwave-quoted)) | |
52a244eb S |
3110 | (throw 'exit (setq found (match-beginning 0))) |
3111 | (if (or (and (> dir 0) (eobp)) | |
3112 | (and (< dir 0) (bobp))) | |
3113 | (throw 'exit nil))))))) | |
15e42531 CD |
3114 | (if found |
3115 | (progn | |
3116 | (if (not nomark) (push-mark)) | |
3117 | (goto-char found) | |
3118 | found) | |
3119 | nil))) | |
3120 | ||
f32b3b91 CD |
3121 | (defun idlwave-block-jump-out (&optional dir nomark) |
3122 | "When optional argument DIR is non-negative, move forward to end of | |
3123 | current block using the `idlwave-begin-block-reg' and `idlwave-end-block-reg' | |
5a0c3f56 JB |
3124 | regular expressions. When DIR is negative, move backwards to block beginning. |
3125 | Recursively calls itself to skip over nested blocks. DIR defaults to | |
3126 | forward. Calls `push-mark' unless the optional argument NOMARK is | |
3127 | non-nil. Movement is limited by the start of program units because of | |
f32b3b91 CD |
3128 | possibility of unbalanced blocks." |
3129 | (interactive "P") | |
3130 | (or dir (setq dir 0)) | |
3131 | (let* ((here (point)) | |
3132 | (case-fold-search t) | |
3133 | (limit (if (>= dir 0) (point-max) (point-min))) | |
4b1aaa8b | 3134 | (block-limit (if (>= dir 0) |
f32b3b91 CD |
3135 | idlwave-begin-block-reg |
3136 | idlwave-end-block-reg)) | |
3137 | found | |
3138 | (block-reg (concat idlwave-begin-block-reg "\\|" | |
3139 | idlwave-end-block-reg)) | |
3140 | (unit-limit (or (save-excursion | |
3141 | (if (< dir 0) | |
3142 | (idlwave-find-key | |
3143 | idlwave-begin-unit-reg dir t limit) | |
3144 | (end-of-line) | |
4b1aaa8b | 3145 | (idlwave-find-key |
f32b3b91 CD |
3146 | idlwave-end-unit-reg dir t limit))) |
3147 | limit))) | |
3148 | (if (>= dir 0) (end-of-line)) ;Make sure we are in current block | |
3149 | (if (setq found (idlwave-find-key block-reg dir t unit-limit)) | |
3150 | (while (and found (looking-at block-limit)) | |
3151 | (if (>= dir 0) (forward-word 1)) | |
3152 | (idlwave-block-jump-out dir t) | |
3153 | (setq found (idlwave-find-key block-reg dir t unit-limit)))) | |
3154 | (if (not nomark) (push-mark here)) | |
3155 | (if (not found) (goto-char unit-limit) | |
3156 | (if (>= dir 0) (forward-word 1))))) | |
3157 | ||
52a244eb S |
3158 | (defun idlwave-min-current-statement-indent (&optional end-reg) |
3159 | "The minimum indent in the current statement." | |
3160 | (idlwave-beginning-of-statement) | |
3161 | (if (not (idlwave-is-continuation-line)) | |
3162 | (idlwave-current-indent) | |
3163 | (let ((min (idlwave-current-indent)) comm-or-empty) | |
3164 | (while (and (= (forward-line 1) 0) | |
3165 | (or (setq comm-or-empty (idlwave-is-comment-or-empty-line)) | |
3166 | (idlwave-is-continuation-line)) | |
3167 | (or (null end-reg) (< (point) end-reg))) | |
3168 | (unless comm-or-empty (setq min (min min (idlwave-current-indent))))) | |
3169 | (if (or comm-or-empty (and end-reg (>= (point) end-reg))) | |
4b1aaa8b | 3170 | min |
52a244eb S |
3171 | (min min (idlwave-current-indent)))))) |
3172 | ||
3173 | (defun idlwave-current-statement-indent (&optional last-line) | |
f32b3b91 CD |
3174 | "Return indentation of the current statement. |
3175 | If in a statement, moves to beginning of statement before finding indent." | |
52a244eb S |
3176 | (if last-line |
3177 | (idlwave-end-of-statement) | |
3178 | (idlwave-beginning-of-statement)) | |
f32b3b91 CD |
3179 | (idlwave-current-indent)) |
3180 | ||
3181 | (defun idlwave-current-indent () | |
3182 | "Return the column of the indentation of the current line. | |
5a0c3f56 | 3183 | Skips any whitespace. Returns 0 if the end-of-line follows the whitespace." |
f32b3b91 CD |
3184 | (save-excursion |
3185 | (beginning-of-line) | |
3186 | (skip-chars-forward " \t") | |
3187 | ;; if we are at the end of blank line return 0 | |
3188 | (cond ((eolp) 0) | |
3189 | ((current-column))))) | |
3190 | ||
3191 | (defun idlwave-is-continuation-line () | |
5a0c3f56 | 3192 | "Test if current line is continuation line. |
5e72c6b2 S |
3193 | Blank or comment-only lines following regular continuation lines (with |
3194 | `$') count as continuations too." | |
0dc2be2f S |
3195 | (let (p) |
3196 | (save-excursion | |
4b1aaa8b | 3197 | (or |
0dc2be2f S |
3198 | (idlwave-look-at "\\<\\$") |
3199 | (catch 'loop | |
4b1aaa8b | 3200 | (while (and (looking-at "^[ \t]*\\(;.*\\)?$") |
0dc2be2f S |
3201 | (eq (forward-line -1) 0)) |
3202 | (if (setq p (idlwave-look-at "\\<\\$")) (throw 'loop p)))))))) | |
f32b3b91 CD |
3203 | |
3204 | (defun idlwave-is-comment-line () | |
5a0c3f56 | 3205 | "Test if the current line is a comment line." |
f32b3b91 CD |
3206 | (save-excursion |
3207 | (beginning-of-line 1) | |
3208 | (looking-at "[ \t]*;"))) | |
3209 | ||
05a1abfc | 3210 | (defun idlwave-is-comment-or-empty-line () |
5a0c3f56 | 3211 | "Test if the current line is a comment line." |
05a1abfc CD |
3212 | (save-excursion |
3213 | (beginning-of-line 1) | |
3214 | (looking-at "[ \t]*[;\n]"))) | |
3215 | ||
f32b3b91 | 3216 | (defun idlwave-look-at (regexp &optional cont beg) |
5a0c3f56 | 3217 | "Search current line from current point for REGEXP. |
15e42531 CD |
3218 | If optional argument CONT is non-nil, searches to the end of |
3219 | the current statement. | |
3220 | If optional arg BEG is non-nil, search starts from the beginning of the | |
3221 | current statement. | |
3222 | Ignores matches that end in a comment or inside a string expression. | |
3223 | Returns point if successful, nil otherwise. | |
3224 | This function produces unexpected results if REGEXP contains quotes or | |
5a0c3f56 | 3225 | a comment delimiter. The search is case insensitive. |
15e42531 | 3226 | If successful leaves point after the match, otherwise, does not move point." |
f32b3b91 | 3227 | (let ((here (point)) |
f32b3b91 | 3228 | (case-fold-search t) |
15e42531 CD |
3229 | (eos (save-excursion |
3230 | (if cont (idlwave-end-of-statement) (end-of-line)) | |
3231 | (point))) | |
f32b3b91 | 3232 | found) |
15e42531 CD |
3233 | (idlwave-with-special-syntax |
3234 | (if beg (idlwave-beginning-of-statement)) | |
3235 | (while (and (setq found (re-search-forward regexp eos t)) | |
3236 | (idlwave-quoted)))) | |
f32b3b91 CD |
3237 | (if (not found) (goto-char here)) |
3238 | found)) | |
3239 | ||
3240 | (defun idlwave-fill-paragraph (&optional nohang) | |
5a0c3f56 | 3241 | "Fill paragraphs in comments. |
f32b3b91 CD |
3242 | A paragraph is made up of all contiguous lines having the same comment |
3243 | leader (the leading whitespace before the comment delimiter and the | |
3244 | comment delimiter). In addition, paragraphs are separated by blank | |
5a0c3f56 | 3245 | line comments. The indentation is given by the hanging indent of the |
f32b3b91 | 3246 | first line, otherwise by the minimum indentation of the lines after |
5a0c3f56 JB |
3247 | the first line. The indentation of the first line does not change. |
3248 | Does not effect code lines. Does not fill comments on the same line | |
f32b3b91 | 3249 | with code. The hanging indent is given by the end of the first match |
5a0c3f56 JB |
3250 | matching `idlwave-hang-indent-regexp' on the paragraph's first line. |
3251 | If the optional argument NOHANG is non-nil then the hanging indent is | |
f32b3b91 CD |
3252 | ignored." |
3253 | (interactive "P") | |
3254 | ;; check if this is a line comment | |
3255 | (if (save-excursion | |
3256 | (beginning-of-line) | |
3257 | (skip-chars-forward " \t") | |
3258 | (looking-at comment-start)) | |
3259 | (let | |
3260 | ((indent 999) | |
3261 | pre here diff fill-prefix-reg bcl first-indent | |
3262 | hang start end) | |
3263 | ;; Change tabs to spaces in the surrounding paragraph. | |
3264 | ;; The surrounding paragraph will be the largest containing block of | |
3265 | ;; contiguous line comments. Thus, we may be changing tabs in | |
3266 | ;; a much larger area than is needed, but this is the easiest | |
3267 | ;; brute force way to do it. | |
3268 | ;; | |
3269 | ;; This has the undesirable side effect of replacing the tabs | |
3270 | ;; permanently without the user's request or knowledge. | |
3271 | (save-excursion | |
3272 | (backward-paragraph) | |
3273 | (setq start (point))) | |
3274 | (save-excursion | |
3275 | (forward-paragraph) | |
3276 | (setq end (point))) | |
3277 | (untabify start end) | |
3278 | ;; | |
3279 | (setq here (point)) | |
3280 | (beginning-of-line) | |
3281 | (setq bcl (point)) | |
e180ab9f GM |
3282 | (re-search-forward (concat "^[ \t]*" comment-start "+") |
3283 | (point-at-eol) t) | |
f32b3b91 CD |
3284 | ;; Get the comment leader on the line and its length |
3285 | (setq pre (current-column)) | |
3286 | ;; the comment leader is the indentation plus exactly the | |
3287 | ;; number of consecutive ";". | |
3288 | (setq fill-prefix-reg | |
3289 | (concat | |
3290 | (setq fill-prefix | |
9b026d9f | 3291 | (regexp-quote (buffer-substring (point-at-bol) (point)))) |
f32b3b91 | 3292 | "[^;]")) |
4b1aaa8b | 3293 | |
f32b3b91 CD |
3294 | ;; Mark the beginning and end of the paragraph |
3295 | (goto-char bcl) | |
3296 | (while (and (looking-at fill-prefix-reg) | |
3297 | (not (looking-at paragraph-separate)) | |
3298 | (not (bobp))) | |
3299 | (forward-line -1)) | |
3300 | ;; Move to first line of paragraph | |
3301 | (if (/= (point) bcl) | |
3302 | (forward-line 1)) | |
3303 | (setq start (point)) | |
3304 | (goto-char bcl) | |
3305 | (while (and (looking-at fill-prefix-reg) | |
3306 | (not (looking-at paragraph-separate)) | |
3307 | (not (eobp))) | |
3308 | (forward-line 1)) | |
3309 | (beginning-of-line) | |
3310 | (if (or (not (looking-at fill-prefix-reg)) | |
3311 | (looking-at paragraph-separate)) | |
3312 | (forward-line -1)) | |
3313 | (end-of-line) | |
3314 | ;; if at end of buffer add a newline (need this because | |
3315 | ;; fill-region needs END to be at the beginning of line after | |
3316 | ;; the paragraph or it will add a line). | |
3317 | (if (eobp) | |
3318 | (progn (insert ?\n) (backward-char 1))) | |
3319 | ;; Set END to the beginning of line after the paragraph | |
3320 | ;; END is calculated as distance from end of buffer | |
3321 | (setq end (- (point-max) (point) 1)) | |
3322 | ;; | |
3323 | ;; Calculate the indentation for the paragraph. | |
3324 | ;; | |
3325 | ;; In the following while statements, after one iteration | |
3326 | ;; point will be at the beginning of a line in which case | |
3327 | ;; the while will not be executed for the | |
3328 | ;; the first paragraph line and thus will not affect the | |
3329 | ;; indentation. | |
3330 | ;; | |
3331 | ;; First check to see if indentation is based on hanging indent. | |
3332 | (if (and (not nohang) idlwave-hanging-indent | |
3333 | (setq hang | |
3334 | (save-excursion | |
3335 | (goto-char start) | |
3336 | (idlwave-calc-hanging-indent)))) | |
3337 | ;; Adjust lines of paragraph by inserting spaces so that | |
3338 | ;; each line's indent is at least as great as the hanging | |
3339 | ;; indent. This is needed for fill-paragraph to work with | |
3340 | ;; a fill-prefix. | |
3341 | (progn | |
3342 | (setq indent hang) | |
3343 | (beginning-of-line) | |
3344 | (while (> (point) start) | |
e180ab9f | 3345 | (re-search-forward comment-start-skip (point-at-eol) t) |
f32b3b91 CD |
3346 | (if (> (setq diff (- indent (current-column))) 0) |
3347 | (progn | |
3348 | (if (>= here (point)) | |
3349 | ;; adjust the original location for the | |
3350 | ;; inserted text. | |
3351 | (setq here (+ here diff))) | |
15e42531 | 3352 | (insert (make-string diff ?\ )))) |
f32b3b91 CD |
3353 | (forward-line -1)) |
3354 | ) | |
4b1aaa8b | 3355 | |
f32b3b91 CD |
3356 | ;; No hang. Instead find minimum indentation of paragraph |
3357 | ;; after first line. | |
3358 | ;; For the following while statement, since START is at the | |
aa87aafc | 3359 | ;; beginning of line and END is at the end of line |
f32b3b91 CD |
3360 | ;; point is greater than START at least once (which would |
3361 | ;; be the case for a single line paragraph). | |
3362 | (while (> (point) start) | |
3363 | (beginning-of-line) | |
3364 | (setq indent | |
3365 | (min indent | |
3366 | (progn | |
e180ab9f | 3367 | (re-search-forward comment-start-skip (point-at-eol) t) |
f32b3b91 | 3368 | (current-column)))) |
e180ab9f | 3369 | (forward-line -1))) |
f32b3b91 CD |
3370 | (setq fill-prefix (concat fill-prefix |
3371 | (make-string (- indent pre) | |
15e42531 | 3372 | ?\ ))) |
f32b3b91 CD |
3373 | ;; first-line indent |
3374 | (setq first-indent | |
3375 | (max | |
3376 | (progn | |
e180ab9f | 3377 | (re-search-forward comment-start-skip (point-at-eol) t) |
f32b3b91 CD |
3378 | (current-column)) |
3379 | indent)) | |
4b1aaa8b | 3380 | |
f32b3b91 CD |
3381 | ;; try to keep point at its original place |
3382 | (goto-char here) | |
3383 | ||
3384 | ;; In place of the more modern fill-region-as-paragraph, a hack | |
3385 | ;; to keep whitespace untouched on the first line within the | |
3386 | ;; indent length and to preserve any indent on the first line | |
3387 | ;; (first indent). | |
3388 | (save-excursion | |
3389 | (setq diff | |
3390 | (buffer-substring start (+ start first-indent -1))) | |
15e42531 | 3391 | (subst-char-in-region start (+ start first-indent -1) ?\ ?~ nil) |
f32b3b91 CD |
3392 | (fill-region-as-paragraph |
3393 | start | |
3394 | (- (point-max) end) | |
3395 | (current-justification) | |
3396 | nil) | |
3397 | (delete-region start (+ start first-indent -1)) | |
3398 | (goto-char start) | |
3399 | (insert diff)) | |
3400 | ;; When we want the point at the beginning of the comment | |
3401 | ;; body fill-region will put it at the beginning of the line. | |
3402 | (if (bolp) (skip-chars-forward (concat " \t" comment-start))) | |
3403 | (setq fill-prefix nil)))) | |
3404 | ||
3405 | (defun idlwave-calc-hanging-indent () | |
5a0c3f56 JB |
3406 | "Calculate the position of the hanging indent for the comment paragraph. |
3407 | The hanging indent position is given by the first match with the | |
3408 | `idlwave-hang-indent-regexp'. If `idlwave-use-last-hang-indent' is | |
3409 | non-nil then use last occurrence matching `idlwave-hang-indent-regexp' | |
3410 | on the line. | |
f32b3b91 CD |
3411 | If not found returns nil." |
3412 | (if idlwave-use-last-hang-indent | |
3413 | (save-excursion | |
3414 | (end-of-line) | |
e180ab9f | 3415 | (if (re-search-backward idlwave-hang-indent-regexp (point-at-bol) t) |
f32b3b91 CD |
3416 | (+ (current-column) (length idlwave-hang-indent-regexp)))) |
3417 | (save-excursion | |
3418 | (beginning-of-line) | |
e180ab9f | 3419 | (if (re-search-forward idlwave-hang-indent-regexp (point-at-eol) t) |
f32b3b91 CD |
3420 | (current-column))))) |
3421 | ||
3422 | (defun idlwave-auto-fill () | |
4b1aaa8b | 3423 | "Called to break lines in auto fill mode. |
52a244eb S |
3424 | Only fills non-comment lines if `idlwave-fill-comment-line-only' is |
3425 | non-nil. Places a continuation character at the end of the line if | |
3426 | not in a comment. Splits strings with IDL concatenation operator `+' | |
3427 | if `idlwave-auto-fill-split-string' is non-nil." | |
f32b3b91 CD |
3428 | (if (<= (current-column) fill-column) |
3429 | nil ; do not to fill | |
3430 | (if (or (not idlwave-fill-comment-line-only) | |
3431 | (save-excursion | |
3432 | ;; Check for comment line | |
3433 | (beginning-of-line) | |
3434 | (looking-at idlwave-comment-line-start-skip))) | |
3435 | (let (beg) | |
3436 | (idlwave-indent-line) | |
3437 | ;; Prevent actions do-auto-fill which calls indent-line-function. | |
3438 | (let (idlwave-do-actions | |
d6aac72d | 3439 | (paragraph-separate ".") |
52a244eb S |
3440 | (fill-nobreak-predicate |
3441 | (if (and (idlwave-in-quote) | |
3442 | idlwave-auto-fill-split-string) | |
3443 | (lambda () ;; We'll need 5 spaces for " ' + $" | |
3444 | (<= (- fill-column (current-column)) 5) | |
3445 | )))) | |
f32b3b91 CD |
3446 | (do-auto-fill)) |
3447 | (save-excursion | |
3448 | (end-of-line 0) | |
3449 | ;; Indent the split line | |
a86bd650 | 3450 | (idlwave-indent-line)) |
f32b3b91 CD |
3451 | (if (save-excursion |
3452 | (beginning-of-line) | |
3453 | (looking-at idlwave-comment-line-start-skip)) | |
3454 | ;; A continued line comment | |
3455 | ;; We treat continued line comments as part of a comment | |
3456 | ;; paragraph. So we check for a hanging indent. | |
3457 | (if idlwave-hanging-indent | |
3458 | (let ((here (- (point-max) (point))) | |
3459 | (indent | |
3460 | (save-excursion | |
3461 | (forward-line -1) | |
3462 | (idlwave-calc-hanging-indent)))) | |
e180ab9f GM |
3463 | (when indent |
3464 | ;; Remove whitespace between comment delimiter and | |
3465 | ;; text, insert spaces for appropriate indentation. | |
3466 | (beginning-of-line) | |
3467 | (re-search-forward comment-start-skip (point-at-eol) t) | |
3468 | (delete-horizontal-space) | |
3469 | (idlwave-indent-to indent) | |
3470 | (goto-char (- (point-max) here))))) | |
f32b3b91 CD |
3471 | ;; Split code or comment? |
3472 | (if (save-excursion | |
3473 | (end-of-line 0) | |
3474 | (idlwave-in-comment)) | |
52a244eb | 3475 | ;; Splitting a non-full-line comment. |
f32b3b91 CD |
3476 | ;; Insert the comment delimiter from split line |
3477 | (progn | |
3478 | (save-excursion | |
3479 | (beginning-of-line) | |
3480 | (skip-chars-forward " \t") | |
3481 | ;; Insert blank to keep off beginning of line | |
3482 | (insert " " | |
3483 | (save-excursion | |
3484 | (forward-line -1) | |
3485 | (buffer-substring (idlwave-goto-comment) | |
3486 | (progn | |
3487 | (skip-chars-forward "; ") | |
3488 | (point)))))) | |
3489 | (idlwave-indent-line)) | |
3490 | ;; Split code line - add continuation character | |
3491 | (save-excursion | |
3492 | (end-of-line 0) | |
3493 | ;; Check to see if we split a string | |
3494 | (if (and (setq beg (idlwave-in-quote)) | |
3495 | idlwave-auto-fill-split-string) | |
3496 | ;; Split the string and concatenate. | |
3497 | ;; The first extra space is for the space | |
3498 | ;; the line was split. That space was removed. | |
3499 | (insert " " (char-after beg) " +")) | |
3500 | (insert " $")) | |
3501 | (if beg | |
3502 | (if idlwave-auto-fill-split-string | |
3503 | ;; Make the second part of continued string | |
3504 | (save-excursion | |
3505 | (beginning-of-line) | |
3506 | (skip-chars-forward " \t") | |
3507 | (insert (char-after beg))) | |
3508 | ;; Warning | |
3509 | (beep) | |
3510 | (message "Warning: continuation inside a string."))) | |
3511 | ;; Although do-auto-fill (via indent-new-comment-line) calls | |
3512 | ;; idlwave-indent-line for the new line, re-indent again | |
3513 | ;; because of the addition of the continuation character. | |
3514 | (idlwave-indent-line)) | |
3515 | ))))) | |
3516 | ||
3517 | (defun idlwave-auto-fill-mode (arg) | |
3518 | "Toggle auto-fill mode for IDL mode. | |
3519 | With arg, turn auto-fill mode on if arg is positive. | |
3520 | In auto-fill mode, inserting a space at a column beyond `fill-column' | |
3521 | automatically breaks the line at a previous space." | |
3522 | (interactive "P") | |
3523 | (prog1 (set idlwave-fill-function | |
3524 | (if (if (null arg) | |
3525 | (not (symbol-value idlwave-fill-function)) | |
3526 | (> (prefix-numeric-value arg) 0)) | |
3527 | 'idlwave-auto-fill | |
3528 | nil)) | |
3529 | ;; update mode-line | |
3530 | (set-buffer-modified-p (buffer-modified-p)))) | |
3531 | ||
52a244eb S |
3532 | ;(defun idlwave-fill-routine-call () |
3533 | ; "Fill a routine definition or statement, indenting appropriately." | |
3534 | ; (let ((where (idlwave-where))))) | |
3535 | ||
3536 | ||
5a0c3f56 | 3537 | (defun idlwave-doc-header (&optional nomark) |
f32b3b91 | 3538 | "Insert a documentation header at the beginning of the unit. |
5a0c3f56 JB |
3539 | Inserts the value of the variable `idlwave-file-header'. Sets mark |
3540 | before moving to do insertion unless the optional prefix argument | |
3541 | NOMARK is non-nil." | |
f32b3b91 CD |
3542 | (interactive "P") |
3543 | (or nomark (push-mark)) | |
3544 | ;; make sure we catch the current line if it begins the unit | |
5e72c6b2 S |
3545 | (if idlwave-header-to-beginning-of-file |
3546 | (goto-char (point-min)) | |
3547 | (end-of-line) | |
3548 | (idlwave-beginning-of-subprogram) | |
3549 | (beginning-of-line) | |
3550 | ;; skip function or procedure line | |
3551 | (if (idlwave-look-at "\\<\\(pro\\|function\\)\\>") | |
3552 | (progn | |
3553 | (idlwave-end-of-statement) | |
3554 | (if (> (forward-line 1) 0) (insert "\n"))))) | |
3555 | (let ((pos (point))) | |
3556 | (if idlwave-file-header | |
3557 | (cond ((car idlwave-file-header) | |
a527b753 | 3558 | (insert-file-contents (car idlwave-file-header))) |
5e72c6b2 S |
3559 | ((stringp (car (cdr idlwave-file-header))) |
3560 | (insert (car (cdr idlwave-file-header)))))) | |
3561 | (goto-char pos))) | |
f32b3b91 CD |
3562 | |
3563 | (defun idlwave-default-insert-timestamp () | |
5a0c3f56 | 3564 | "Default timestamp insertion function." |
f32b3b91 CD |
3565 | (insert (current-time-string)) |
3566 | (insert ", " (user-full-name)) | |
5e72c6b2 | 3567 | (if (boundp 'user-mail-address) |
4b1aaa8b | 3568 | (insert " <" user-mail-address ">") |
5e72c6b2 | 3569 | (insert " <" (user-login-name) "@" (system-name) ">")) |
f32b3b91 CD |
3570 | ;; Remove extra spaces from line |
3571 | (idlwave-fill-paragraph) | |
3572 | ;; Insert a blank line comment to separate from the date entry - | |
3573 | ;; will keep the entry from flowing onto date line if re-filled. | |
5e72c6b2 | 3574 | (insert "\n;\n;\t\t")) |
f32b3b91 CD |
3575 | |
3576 | (defun idlwave-doc-modification () | |
3577 | "Insert a brief modification log at the beginning of the current program. | |
3578 | Looks for an occurrence of the value of user variable | |
5a0c3f56 JB |
3579 | `idlwave-doc-modifications-keyword' if non-nil. Inserts time and user |
3580 | name and places the point for the user to add a log. Before moving, saves | |
f32b3b91 CD |
3581 | location on mark ring so that the user can return to previous point." |
3582 | (interactive) | |
3583 | (push-mark) | |
05a1abfc CD |
3584 | (let* (beg end) |
3585 | (if (and (or (re-search-backward idlwave-doclib-start nil t) | |
3586 | (progn | |
3587 | (goto-char (point-min)) | |
3588 | (re-search-forward idlwave-doclib-start nil t))) | |
3589 | (setq beg (match-beginning 0)) | |
3590 | (re-search-forward idlwave-doclib-end nil t) | |
3591 | (setq end (match-end 0))) | |
3592 | (progn | |
3593 | (goto-char beg) | |
4b1aaa8b | 3594 | (if (re-search-forward |
05a1abfc CD |
3595 | (concat idlwave-doc-modifications-keyword ":") |
3596 | end t) | |
3597 | (end-of-line) | |
3598 | (goto-char end) | |
3599 | (end-of-line -1) | |
3600 | (insert "\n" comment-start "\n") | |
3601 | (insert comment-start " " idlwave-doc-modifications-keyword ":")) | |
3602 | (insert "\n;\n;\t") | |
3603 | (run-hooks 'idlwave-timestamp-hook)) | |
3604 | (error "No valid DOCLIB header")))) | |
f32b3b91 | 3605 | |
e08734e2 | 3606 | |
8d222148 SM |
3607 | ;; CJC 3/16/93 |
3608 | ;; Interface to expand-region-abbrevs which did not work when the | |
3609 | ;; abbrev hook associated with an abbrev moves point backwards | |
3610 | ;; after abbrev expansion, e.g., as with the abbrev '.n'. | |
3611 | ;; The original would enter an infinite loop in attempting to expand | |
3612 | ;; .n (it would continually expand and unexpand the abbrev without expanding | |
3613 | ;; because the point would keep going back to the beginning of the | |
3614 | ;; abbrev instead of to the end of the abbrev). We now keep the | |
3615 | ;; abbrev hook from moving backwards. | |
f32b3b91 CD |
3616 | ;;; |
3617 | (defun idlwave-expand-region-abbrevs (start end) | |
3618 | "Expand each abbrev occurrence in the region. | |
3619 | Calling from a program, arguments are START END." | |
3620 | (interactive "r") | |
3621 | (save-excursion | |
3622 | (goto-char (min start end)) | |
3623 | (let ((idlwave-show-block nil) ;Do not blink | |
3624 | (idlwave-abbrev-move nil)) ;Do not move | |
3625 | (expand-region-abbrevs start end 'noquery)))) | |
3626 | ||
3627 | (defun idlwave-quoted () | |
5a0c3f56 JB |
3628 | "Return t if point is in a comment or quoted string. |
3629 | Returns nil otherwise." | |
f32b3b91 CD |
3630 | (or (idlwave-in-comment) (idlwave-in-quote))) |
3631 | ||
3632 | (defun idlwave-in-quote () | |
5a0c3f56 | 3633 | "Return location of the opening quote |
f32b3b91 CD |
3634 | if point is in a IDL string constant, nil otherwise. |
3635 | Ignores comment delimiters on the current line. | |
3636 | Properly handles nested quotation marks and octal | |
3637 | constants - a double quote followed by an octal digit." | |
8d222148 SM |
3638 | ;; Treat an octal inside an apostrophe to be a normal string. Treat a |
3639 | ;; double quote followed by an octal digit to be an octal constant | |
3640 | ;; rather than a string. Therefore, there is no terminating double | |
3641 | ;; quote. | |
f32b3b91 CD |
3642 | (save-excursion |
3643 | ;; Because single and double quotes can quote each other we must | |
3644 | ;; search for the string start from the beginning of line. | |
3645 | (let* ((start (point)) | |
9b026d9f | 3646 | (eol (point-at-eol)) |
f32b3b91 CD |
3647 | (bq (progn (beginning-of-line) (point))) |
3648 | (endq (point)) | |
3649 | (data (match-data)) | |
3650 | delim | |
3651 | found) | |
3652 | (while (< endq start) | |
3653 | ;; Find string start | |
3654 | ;; Don't find an octal constant beginning with a double quote | |
52a244eb | 3655 | (if (re-search-forward "[\"']" eol 'lim) |
f32b3b91 CD |
3656 | ;; Find the string end. |
3657 | ;; In IDL, two consecutive delimiters after the start of a | |
3658 | ;; string act as an | |
3659 | ;; escape for the delimiter in the string. | |
3660 | ;; Two consecutive delimiters alone (i.e., not after the | |
aa87aafc | 3661 | ;; start of a string) is the null string. |
f32b3b91 CD |
3662 | (progn |
3663 | ;; Move to position after quote | |
3664 | (goto-char (1+ (match-beginning 0))) | |
3665 | (setq bq (1- (point))) | |
3666 | ;; Get the string delimiter | |
3667 | (setq delim (char-to-string (preceding-char))) | |
3668 | ;; Check for null string | |
3669 | (if (looking-at delim) | |
3670 | (progn (setq endq (point)) (forward-char 1)) | |
3671 | ;; Look for next unpaired delimiter | |
3672 | (setq found (search-forward delim eol 'lim)) | |
3673 | (while (looking-at delim) | |
3674 | (forward-char 1) | |
3675 | (setq found (search-forward delim eol 'lim))) | |
8d222148 | 3676 | (setq endq (if found (1- (point)) (point))) |
f32b3b91 CD |
3677 | )) |
3678 | (progn (setq bq (point)) (setq endq (point))))) | |
3679 | (store-match-data data) | |
3680 | ;; return string beginning position or nil | |
3681 | (if (> start bq) bq)))) | |
3682 | ||
76959b77 | 3683 | (defun idlwave-is-pointer-dereference (&optional limit) |
5a0c3f56 | 3684 | "Determine if the character after point is a pointer dereference *." |
8d222148 SM |
3685 | (and |
3686 | (eq (char-after) ?\*) | |
3687 | (not (idlwave-in-quote)) | |
3688 | (save-excursion | |
3689 | (forward-char) | |
3690 | (re-search-backward (concat "\\(" idlwave-idl-keywords | |
3691 | "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t)))) | |
76959b77 S |
3692 | |
3693 | ||
f32b3b91 CD |
3694 | ;; Statement templates |
3695 | ||
3696 | ;; Replace these with a general template function, something like | |
3697 | ;; expand.el (I think there was also something with a name similar to | |
3698 | ;; dmacro.el) | |
3699 | ||
3700 | (defun idlwave-template (s1 s2 &optional prompt noindent) | |
3701 | "Build a template with optional prompt expression. | |
3702 | ||
3703 | Opens a line if point is not followed by a newline modulo intervening | |
3704 | whitespace. S1 and S2 are strings. S1 is inserted at point followed | |
595ab50b | 3705 | by S2. Point is inserted between S1 and S2. The case of S1 and S2 is |
5a0c3f56 JB |
3706 | adjusted according to `idlwave-abbrev-change-case'. If optional |
3707 | argument PROMPT is a string then it is displayed as a message in the | |
f32b3b91 CD |
3708 | minibuffer. The PROMPT serves as a reminder to the user of an |
3709 | expression to enter. | |
3710 | ||
3711 | The lines containing S1 and S2 are reindented using `indent-region' | |
3712 | unless the optional second argument NOINDENT is non-nil." | |
175069ef | 3713 | (if (derived-mode-p 'idlwave-shell-mode) |
05a1abfc | 3714 | ;; This is a gross hack to avoit template abbrev expansion |
15e42531 CD |
3715 | ;; in the shell. FIXME: This is a dirty hack. |
3716 | (if (and (eq this-command 'self-insert-command) | |
3717 | (equal last-abbrev-location (point))) | |
3718 | (insert last-abbrev-text) | |
3719 | (error "No templates in idlwave-shell")) | |
3720 | (cond ((eq idlwave-abbrev-change-case 'down) | |
3721 | (setq s1 (downcase s1) s2 (downcase s2))) | |
3722 | (idlwave-abbrev-change-case | |
3723 | (setq s1 (upcase s1) s2 (upcase s2)))) | |
e180ab9f | 3724 | (let ((beg (point-at-bol)) |
15e42531 CD |
3725 | end) |
3726 | (if (not (looking-at "\\s-*\n")) | |
3727 | (open-line 1)) | |
3728 | (insert s1) | |
3729 | (save-excursion | |
3730 | (insert s2) | |
3731 | (setq end (point))) | |
3732 | (if (not noindent) | |
3733 | (indent-region beg end nil)) | |
3734 | (if (stringp prompt) | |
274f1353 | 3735 | (message "%s" prompt))))) |
4b1aaa8b | 3736 | |
595ab50b CD |
3737 | (defun idlwave-rw-case (string) |
3738 | "Make STRING have the case required by `idlwave-reserved-word-upcase'." | |
3739 | (if idlwave-reserved-word-upcase | |
3740 | (upcase string) | |
3741 | string)) | |
3742 | ||
f32b3b91 CD |
3743 | (defun idlwave-elif () |
3744 | "Build skeleton IDL if-else block." | |
3745 | (interactive) | |
595ab50b CD |
3746 | (idlwave-template |
3747 | (idlwave-rw-case "if") | |
3748 | (idlwave-rw-case " then begin\n\nendif else begin\n\nendelse") | |
3749 | "Condition expression")) | |
f32b3b91 CD |
3750 | |
3751 | (defun idlwave-case () | |
3752 | "Build skeleton IDL case statement." | |
3753 | (interactive) | |
4b1aaa8b | 3754 | (idlwave-template |
595ab50b CD |
3755 | (idlwave-rw-case "case") |
3756 | (idlwave-rw-case " of\n\nendcase") | |
3757 | "Selector expression")) | |
f32b3b91 | 3758 | |
05a1abfc CD |
3759 | (defun idlwave-switch () |
3760 | "Build skeleton IDL switch statement." | |
3761 | (interactive) | |
4b1aaa8b | 3762 | (idlwave-template |
05a1abfc CD |
3763 | (idlwave-rw-case "switch") |
3764 | (idlwave-rw-case " of\n\nendswitch") | |
3765 | "Selector expression")) | |
3766 | ||
f32b3b91 | 3767 | (defun idlwave-for () |
5a0c3f56 | 3768 | "Build skeleton IDL loop statement." |
f32b3b91 | 3769 | (interactive) |
4b1aaa8b | 3770 | (idlwave-template |
595ab50b CD |
3771 | (idlwave-rw-case "for") |
3772 | (idlwave-rw-case " do begin\n\nendfor") | |
3773 | "Loop expression")) | |
f32b3b91 CD |
3774 | |
3775 | (defun idlwave-if () | |
5a0c3f56 | 3776 | "Build skeleton IDL if statement." |
f32b3b91 | 3777 | (interactive) |
595ab50b CD |
3778 | (idlwave-template |
3779 | (idlwave-rw-case "if") | |
3780 | (idlwave-rw-case " then begin\n\nendif") | |
3781 | "Scalar logical expression")) | |
f32b3b91 CD |
3782 | |
3783 | (defun idlwave-procedure () | |
3784 | (interactive) | |
4b1aaa8b | 3785 | (idlwave-template |
595ab50b CD |
3786 | (idlwave-rw-case "pro") |
3787 | (idlwave-rw-case "\n\nreturn\nend") | |
3788 | "Procedure name")) | |
f32b3b91 CD |
3789 | |
3790 | (defun idlwave-function () | |
3791 | (interactive) | |
4b1aaa8b | 3792 | (idlwave-template |
595ab50b CD |
3793 | (idlwave-rw-case "function") |
3794 | (idlwave-rw-case "\n\nreturn\nend") | |
3795 | "Function name")) | |
f32b3b91 CD |
3796 | |
3797 | (defun idlwave-repeat () | |
3798 | (interactive) | |
595ab50b CD |
3799 | (idlwave-template |
3800 | (idlwave-rw-case "repeat begin\n\nendrep until") | |
3801 | (idlwave-rw-case "") | |
3802 | "Exit condition")) | |
f32b3b91 CD |
3803 | |
3804 | (defun idlwave-while () | |
3805 | (interactive) | |
4b1aaa8b | 3806 | (idlwave-template |
595ab50b CD |
3807 | (idlwave-rw-case "while") |
3808 | (idlwave-rw-case " do begin\n\nendwhile") | |
3809 | "Entry condition")) | |
f32b3b91 CD |
3810 | |
3811 | (defun idlwave-split-string (string &optional pattern) | |
3812 | "Return a list of substrings of STRING which are separated by PATTERN. | |
3813 | If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." | |
3814 | (or pattern | |
3815 | (setq pattern "[ \f\t\n\r\v]+")) | |
3816 | (let (parts (start 0)) | |
3817 | (while (string-match pattern string start) | |
3818 | (setq parts (cons (substring string start (match-beginning 0)) parts) | |
3819 | start (match-end 0))) | |
3820 | (nreverse (cons (substring string start) parts)))) | |
3821 | ||
3822 | (defun idlwave-replace-string (string replace_string replace_with) | |
3823 | (let* ((start 0) | |
3824 | (last (length string)) | |
3825 | (ret_string "") | |
3826 | end) | |
3827 | (while (setq end (string-match replace_string string start)) | |
3828 | (setq ret_string | |
3829 | (concat ret_string (substring string start end) replace_with)) | |
3830 | (setq start (match-end 0))) | |
3831 | (setq ret_string (concat ret_string (substring string start last))))) | |
3832 | ||
3833 | (defun idlwave-get-buffer-visiting (file) | |
3834 | ;; Return the buffer currently visiting FILE | |
3835 | (cond | |
3836 | ((boundp 'find-file-compare-truenames) ; XEmacs | |
3837 | (let ((find-file-compare-truenames t)) | |
3838 | (get-file-buffer file))) | |
3839 | ((fboundp 'find-buffer-visiting) ; Emacs | |
3840 | (find-buffer-visiting file)) | |
3841 | (t (error "This should not happen (idlwave-get-buffer-visiting)")))) | |
3842 | ||
15e42531 | 3843 | (defvar idlwave-outlawed-buffers nil |
5a0c3f56 | 3844 | "List of buffers pulled up by IDLWAVE for special reasons. |
15e42531 CD |
3845 | Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.") |
3846 | ||
3847 | (defun idlwave-find-file-noselect (file &optional why) | |
f32b3b91 CD |
3848 | ;; Return a buffer visiting file. |
3849 | (or (idlwave-get-buffer-visiting file) | |
15e42531 CD |
3850 | (let ((buf (find-file-noselect file))) |
3851 | (if why (add-to-list 'idlwave-outlawed-buffers (cons buf why))) | |
3852 | buf))) | |
3853 | ||
3854 | (defun idlwave-kill-autoloaded-buffers () | |
52a244eb | 3855 | "Kill buffers created automatically by IDLWAVE. |
15e42531 CD |
3856 | Function prompts for a letter to identify the buffers to kill. |
3857 | Possible letters are: | |
3858 | ||
3859 | f Buffers created by the command \\[idlwave-find-module] or mouse | |
3860 | clicks in the routine info window. | |
3861 | s Buffers created by the IDLWAVE Shell to display where execution | |
3862 | stopped or an error was found. | |
3863 | a Both of the above. | |
3864 | ||
5a0c3f56 | 3865 | Buffers containing unsaved changes require confirmation before they are killed." |
15e42531 CD |
3866 | (interactive) |
3867 | (if (null idlwave-outlawed-buffers) | |
3868 | (error "No IDLWAVE-created buffers available") | |
3869 | (princ (format "Kill IDLWAVE-created buffers: [f]ind source(%d), [s]hell display(%d), [a]ll ? " | |
3870 | (idlwave-count-outlawed-buffers 'find) | |
3871 | (idlwave-count-outlawed-buffers 'shell))) | |
3872 | (let ((c (read-char))) | |
3873 | (cond | |
3874 | ((member c '(?f ?\C-f)) | |
3875 | (idlwave-do-kill-autoloaded-buffers 'find)) | |
3876 | ((member c '(?s ?\C-s)) | |
3877 | (idlwave-do-kill-autoloaded-buffers 'shell)) | |
3878 | ((member c '(?a ?\C-a)) | |
3879 | (idlwave-do-kill-autoloaded-buffers t)) | |
3880 | (t (error "Abort")))))) | |
3881 | ||
3882 | (defun idlwave-count-outlawed-buffers (tag) | |
3883 | "How many outlawed buffers have tag TAG?" | |
3884 | (length (delq nil | |
4b1aaa8b PE |
3885 | (mapcar |
3886 | (lambda (x) (eq (cdr x) tag)) | |
15e42531 CD |
3887 | idlwave-outlawed-buffers)))) |
3888 | ||
3889 | (defun idlwave-do-kill-autoloaded-buffers (&rest reasons) | |
3890 | "Kill all buffers pulled up by IDLWAVE matching REASONS." | |
3891 | (let* ((list (copy-sequence idlwave-outlawed-buffers)) | |
3892 | (cnt 0) | |
3893 | entry) | |
3894 | (while (setq entry (pop list)) | |
3895 | (if (buffer-live-p (car entry)) | |
3896 | (and (or (memq t reasons) | |
3897 | (memq (cdr entry) reasons)) | |
3898 | (kill-buffer (car entry)) | |
3899 | (incf cnt) | |
4b1aaa8b | 3900 | (setq idlwave-outlawed-buffers |
15e42531 | 3901 | (delq entry idlwave-outlawed-buffers))) |
4b1aaa8b | 3902 | (setq idlwave-outlawed-buffers |
15e42531 CD |
3903 | (delq entry idlwave-outlawed-buffers)))) |
3904 | (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) | |
3905 | ||
3906 | (defun idlwave-revoke-license-to-kill () | |
3907 | "Remove BUFFER from the buffers which may be killed. | |
3908 | Killing would be done by `idlwave-do-kill-autoloaded-buffers'. | |
3909 | Intended for `after-save-hook'." | |
3910 | (let* ((buf (current-buffer)) | |
3911 | (entry (assq buf idlwave-outlawed-buffers))) | |
3912 | ;; Revoke license | |
3913 | (if entry | |
4b1aaa8b | 3914 | (setq idlwave-outlawed-buffers |
15e42531 CD |
3915 | (delq entry idlwave-outlawed-buffers))) |
3916 | ;; Remove this function from the hook. | |
3917 | (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) | |
3918 | ||
3919 | (defvar idlwave-path-alist) | |
3920 | (defun idlwave-locate-lib-file (file) | |
f32b3b91 | 3921 | ;; Find FILE on the scanned lib path and return a buffer visiting it |
15e42531 | 3922 | (let* ((dirs idlwave-path-alist) |
f32b3b91 CD |
3923 | dir efile) |
3924 | (catch 'exit | |
15e42531 | 3925 | (while (setq dir (car (pop dirs))) |
f32b3b91 CD |
3926 | (if (file-regular-p |
3927 | (setq efile (expand-file-name file dir))) | |
15e42531 | 3928 | (throw 'exit efile)))))) |
52a244eb | 3929 | |
15e42531 CD |
3930 | (defun idlwave-expand-lib-file-name (file) |
3931 | ;; Find FILE on the scanned lib path and return a buffer visiting it | |
52a244eb | 3932 | ;; This is for, e.g., finding source with no user catalog |
4b1aaa8b | 3933 | (cond |
15e42531 | 3934 | ((null file) nil) |
15e42531 CD |
3935 | ((file-name-absolute-p file) file) |
3936 | (t (idlwave-locate-lib-file file)))) | |
f32b3b91 CD |
3937 | |
3938 | (defun idlwave-make-tags () | |
5a0c3f56 JB |
3939 | "Create the IDL tags file IDLTAGS in the current directory from |
3940 | the list of directories specified in the minibuffer. Directories may be | |
3941 | for example: . /usr/local/rsi/idl/lib. All the subdirectories of the | |
f32b3b91 | 3942 | specified top directories are searched if the directory name is prefixed |
5a0c3f56 | 3943 | by @. Specify @ directories with care, it may take a long, long time if |
f32b3b91 CD |
3944 | you specify /." |
3945 | (interactive) | |
3946 | (let (directory directories cmd append status numdirs dir getsubdirs | |
3947 | buffer save_buffer files numfiles item errbuf) | |
4b1aaa8b | 3948 | |
f32b3b91 CD |
3949 | ;; |
3950 | ;; Read list of directories | |
3951 | (setq directory (read-string "Tag Directories: " ".")) | |
3952 | (setq directories (idlwave-split-string directory "[ \t]+")) | |
3953 | ;; | |
3954 | ;; Set etags command, vars | |
3955 | (setq cmd "etags --output=IDLTAGS --language=none --regex='/[ | |
3956 | \\t]*[pP][Rr][Oo][ \\t]+\\([^ \\t,]+\\)/' --regex='/[ | |
3957 | \\t]*[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn][ \\t]+\\([^ \\t,]+\\)/' ") | |
3958 | (setq append " ") | |
3959 | (setq status 0) | |
3960 | ;; | |
3961 | ;; For each directory | |
3962 | (setq numdirs 0) | |
3963 | (setq dir (nth numdirs directories)) | |
3964 | (while (and dir) | |
3965 | ;; | |
3966 | ;; Find the subdirectories | |
3967 | (if (string-match "^[@]\\(.+\\)$" dir) | |
3968 | (setq getsubdirs t) (setq getsubdirs nil)) | |
3969 | (if (and getsubdirs) (setq dir (substring dir 1 (length dir)))) | |
3970 | (setq dir (expand-file-name dir)) | |
3971 | (if (file-directory-p dir) | |
3972 | (progn | |
3973 | (if (and getsubdirs) | |
3974 | (progn | |
3975 | (setq buffer (get-buffer-create "*idltags*")) | |
3976 | (call-process "sh" nil buffer nil "-c" | |
3977 | (concat "find " dir " -type d -print")) | |
3978 | (setq save_buffer (current-buffer)) | |
3979 | (set-buffer buffer) | |
3980 | (setq files (idlwave-split-string | |
3981 | (idlwave-replace-string | |
3982 | (buffer-substring 1 (point-max)) | |
3983 | "\n" "/*.pro ") | |
3984 | "[ \t]+")) | |
3985 | (set-buffer save_buffer) | |
3986 | (kill-buffer buffer)) | |
3987 | (setq files (list (concat dir "/*.pro")))) | |
3988 | ;; | |
3989 | ;; For each subdirectory | |
3990 | (setq numfiles 0) | |
3991 | (setq item (nth numfiles files)) | |
3992 | (while (and item) | |
3993 | ;; | |
3994 | ;; Call etags | |
3995 | (if (not (string-match "^[ \\t]*$" item)) | |
3996 | (progn | |
29a4e67d | 3997 | (message "%s" (concat "Tagging " item "...")) |
f32b3b91 | 3998 | (setq errbuf (get-buffer-create "*idltags-error*")) |
52a244eb | 3999 | (setq status (+ status |
4b1aaa8b | 4000 | (if (eq 0 (call-process |
52a244eb S |
4001 | "sh" nil errbuf nil "-c" |
4002 | (concat cmd append item))) | |
4003 | 0 | |
4004 | 1))) | |
f32b3b91 CD |
4005 | ;; |
4006 | ;; Append additional tags | |
4007 | (setq append " --append ") | |
4008 | (setq numfiles (1+ numfiles)) | |
4009 | (setq item (nth numfiles files))) | |
4010 | (progn | |
4011 | (setq numfiles (1+ numfiles)) | |
4012 | (setq item (nth numfiles files)) | |
4013 | ))) | |
4b1aaa8b | 4014 | |
f32b3b91 CD |
4015 | (setq numdirs (1+ numdirs)) |
4016 | (setq dir (nth numdirs directories))) | |
4017 | (progn | |
4018 | (setq numdirs (1+ numdirs)) | |
4019 | (setq dir (nth numdirs directories))))) | |
4b1aaa8b | 4020 | |
f32b3b91 CD |
4021 | (setq errbuf (get-buffer-create "*idltags-error*")) |
4022 | (if (= status 0) | |
4023 | (kill-buffer errbuf)) | |
4024 | (message "") | |
4025 | )) | |
4026 | ||
4027 | (defun idlwave-toggle-comment-region (beg end &optional n) | |
4028 | "Comment the lines in the region if the first non-blank line is | |
5a0c3f56 | 4029 | commented, and conversely, uncomment region. If optional prefix arg |
f32b3b91 CD |
4030 | N is non-nil, then for N positive, add N comment delimiters or for N |
4031 | negative, remove N comment delimiters. | |
4032 | Uses `comment-region' which does not place comment delimiters on | |
4033 | blank lines." | |
4034 | (interactive "r\nP") | |
4035 | (if n | |
4036 | (comment-region beg end (prefix-numeric-value n)) | |
4037 | (save-excursion | |
4038 | (goto-char beg) | |
4039 | (beginning-of-line) | |
4040 | ;; skip blank lines | |
4041 | (skip-chars-forward " \t\n") | |
4042 | (if (looking-at (concat "[ \t]*\\(" comment-start "+\\)")) | |
52a244eb S |
4043 | (if (fboundp 'uncomment-region) |
4044 | (uncomment-region beg end) | |
4045 | (comment-region beg end | |
4046 | (- (length (buffer-substring | |
4047 | (match-beginning 1) | |
4048 | (match-end 1)))))) | |
4049 | (comment-region beg end))))) | |
f32b3b91 CD |
4050 | |
4051 | ||
4052 | ;; ---------------------------------------------------------------------------- | |
4053 | ;; ---------------------------------------------------------------------------- | |
4054 | ;; ---------------------------------------------------------------------------- | |
4055 | ;; ---------------------------------------------------------------------------- | |
4056 | ;; | |
4057 | ;; Completion and Routine Info | |
4058 | ;; | |
4059 | ||
4060 | ;; String "intern" functions | |
4061 | ||
4062 | ;; For the completion and routine info function, we want to normalize | |
4063 | ;; the case of procedure names etc. We do this by "interning" these | |
4064 | ;; string is a hand-crafted way. Hashes are used to map the downcase | |
52a244eb S |
4065 | ;; version of the strings to the cased versions. Most *-sint-* |
4066 | ;; variables consist of *two* hashes, a buffer+shell, followed by a | |
4067 | ;; system hash. The former is re-scanned, and the latter takes case | |
4068 | ;; precedence. | |
4069 | ;; | |
4070 | ;; Since these cased versions are really lisp objects, we can use `eq' | |
4071 | ;; to search, which is a large performance boost. All new strings | |
4072 | ;; need to be "sinterned". We do this as early as possible after | |
4073 | ;; getting these strings from completion or buffer substrings. So | |
4074 | ;; most of the code can simply assume to deal with "sinterned" | |
4075 | ;; strings. The only exception is that the functions which scan whole | |
4076 | ;; buffers for routine information do not intern the grabbed strings. | |
4077 | ;; This is only done afterwards. Therefore in these functions it is | |
4078 | ;; *not* safe to assume the strings can be compared with `eq' and be | |
4079 | ;; fed into the routine assq functions. | |
f32b3b91 CD |
4080 | |
4081 | ;; Here we define the hashing functions. | |
4082 | ||
4083 | ;; The variables which hold the hashes. | |
4084 | (defvar idlwave-sint-routines '(nil)) | |
4085 | (defvar idlwave-sint-keywords '(nil)) | |
4086 | (defvar idlwave-sint-methods '(nil)) | |
4087 | (defvar idlwave-sint-classes '(nil)) | |
52a244eb S |
4088 | (defvar idlwave-sint-dirs '(nil)) |
4089 | (defvar idlwave-sint-libnames '(nil)) | |
f32b3b91 CD |
4090 | |
4091 | (defun idlwave-reset-sintern (&optional what) | |
4092 | "Reset all sintern hashes." | |
4093 | ;; Make sure the hash functions are accessible. | |
8d222148 SM |
4094 | (unless (and (fboundp 'gethash) |
4095 | (fboundp 'puthash)) | |
4096 | (require 'cl) | |
4097 | (or (fboundp 'puthash) | |
4098 | (defalias 'puthash 'cl-puthash))) | |
f32b3b91 CD |
4099 | (let ((entries '((idlwave-sint-routines 1000 10) |
4100 | (idlwave-sint-keywords 1000 10) | |
4101 | (idlwave-sint-methods 100 10) | |
4102 | (idlwave-sint-classes 10 10)))) | |
4103 | ||
4104 | ;; Make sure these are lists | |
4105 | (loop for entry in entries | |
4106 | for var = (car entry) | |
4107 | do (if (not (consp (symbol-value var))) (set var (list nil)))) | |
4108 | ||
f66f03de | 4109 | ;; Reset the system & library hash |
f32b3b91 CD |
4110 | (when (or (eq what t) (eq what 'syslib) |
4111 | (null (cdr idlwave-sint-routines))) | |
f32b3b91 CD |
4112 | (loop for entry in entries |
4113 | for var = (car entry) for size = (nth 1 entry) | |
4b1aaa8b | 4114 | do (setcdr (symbol-value var) |
f32b3b91 | 4115 | (make-hash-table ':size size ':test 'equal))) |
52a244eb S |
4116 | (setq idlwave-sint-dirs nil |
4117 | idlwave-sint-libnames nil)) | |
f32b3b91 | 4118 | |
f66f03de | 4119 | ;; Reset the buffer & shell hash |
f32b3b91 CD |
4120 | (when (or (eq what t) (eq what 'bufsh) |
4121 | (null (car idlwave-sint-routines))) | |
f32b3b91 CD |
4122 | (loop for entry in entries |
4123 | for var = (car entry) for size = (nth 1 entry) | |
4b1aaa8b | 4124 | do (setcar (symbol-value var) |
f32b3b91 CD |
4125 | (make-hash-table ':size size ':test 'equal)))))) |
4126 | ||
4127 | (defun idlwave-sintern-routine-or-method (name &optional class set) | |
4128 | (if class | |
4129 | (idlwave-sintern-method name set) | |
4130 | (idlwave-sintern-routine name set))) | |
4131 | ||
4132 | (defun idlwave-sintern (stype &rest args) | |
4133 | (apply (intern (concat "idlwave-sintern-" (symbol-name stype))) args)) | |
4134 | ||
4135 | ;;(defmacro idlwave-sintern (type var) | |
4136 | ;; `(cond ((not (stringp name)) name) | |
4137 | ;; ((gethash (downcase name) (cdr ,var))) | |
4138 | ;; ((gethash (downcase name) (car ,var))) | |
4139 | ;; (set (idlwave-sintern-set name ,type ,var set)) | |
4140 | ;; (name))) | |
4141 | ||
4142 | (defun idlwave-sintern-routine (name &optional set) | |
4143 | (cond ((not (stringp name)) name) | |
4144 | ((gethash (downcase name) (cdr idlwave-sint-routines))) | |
4145 | ((gethash (downcase name) (car idlwave-sint-routines))) | |
4146 | (set (idlwave-sintern-set name 'routine idlwave-sint-routines set)) | |
4147 | (name))) | |
4148 | (defun idlwave-sintern-keyword (name &optional set) | |
4149 | (cond ((not (stringp name)) name) | |
4150 | ((gethash (downcase name) (cdr idlwave-sint-keywords))) | |
4151 | ((gethash (downcase name) (car idlwave-sint-keywords))) | |
4152 | (set (idlwave-sintern-set name 'keyword idlwave-sint-keywords set)) | |
4153 | (name))) | |
4154 | (defun idlwave-sintern-method (name &optional set) | |
4155 | (cond ((not (stringp name)) name) | |
4156 | ((gethash (downcase name) (cdr idlwave-sint-methods))) | |
4157 | ((gethash (downcase name) (car idlwave-sint-methods))) | |
4158 | (set (idlwave-sintern-set name 'method idlwave-sint-methods set)) | |
4159 | (name))) | |
4160 | (defun idlwave-sintern-class (name &optional set) | |
4161 | (cond ((not (stringp name)) name) | |
4162 | ((gethash (downcase name) (cdr idlwave-sint-classes))) | |
4163 | ((gethash (downcase name) (car idlwave-sint-classes))) | |
4164 | (set (idlwave-sintern-set name 'class idlwave-sint-classes set)) | |
4165 | (name))) | |
4166 | ||
52a244eb S |
4167 | (defun idlwave-sintern-dir (dir &optional set) |
4168 | (car (or (member dir idlwave-sint-dirs) | |
4169 | (setq idlwave-sint-dirs (cons dir idlwave-sint-dirs))))) | |
4170 | (defun idlwave-sintern-libname (name &optional set) | |
4171 | (car (or (member name idlwave-sint-libnames) | |
4172 | (setq idlwave-sint-libnames (cons name idlwave-sint-libnames))))) | |
f32b3b91 CD |
4173 | |
4174 | (defun idlwave-sintern-set (name type tables set) | |
4175 | (let* ((func (or (cdr (assq type idlwave-completion-case)) | |
4176 | 'identity)) | |
4177 | (iname (funcall (if (eq func 'preserve) 'identity func) name)) | |
4178 | (table (if (eq set 'sys) (cdr tables) (car tables)))) | |
4179 | (puthash (downcase name) iname table) | |
4180 | iname)) | |
4181 | ||
52a244eb S |
4182 | (defun idlwave-sintern-keyword-list (kwd-list &optional set) |
4183 | "Sintern a set of keywords (file (key . link) (key2 . link2) ...)" | |
8ffcfb27 GM |
4184 | (mapc (lambda(x) |
4185 | (setcar x (idlwave-sintern-keyword (car x) set))) | |
4186 | (cdr kwd-list)) | |
52a244eb S |
4187 | kwd-list) |
4188 | ||
4189 | (defun idlwave-sintern-rinfo-list (list &optional set default-dir) | |
5a0c3f56 JB |
4190 | "Sintern all strings in the rinfo LIST. |
4191 | With optional parameter SET: also set new patterns. Probably this | |
4192 | will always have to be t. If DEFAULT-DIR is passed, it is used as | |
4193 | the base of the directory." | |
52a244eb | 4194 | (let (entry name type class kwds res source call new) |
f32b3b91 CD |
4195 | (while list |
4196 | (setq entry (car list) | |
4197 | list (cdr list) | |
4198 | name (car entry) | |
4199 | type (nth 1 entry) | |
4200 | class (nth 2 entry) | |
4201 | source (nth 3 entry) | |
4202 | call (nth 4 entry) | |
52a244eb S |
4203 | kwds (nthcdr 5 entry)) |
4204 | ||
4205 | ;; The class and name | |
f32b3b91 CD |
4206 | (if class |
4207 | (progn | |
4208 | (if (symbolp class) (setq class (symbol-name class))) | |
4209 | (setq class (idlwave-sintern-class class set)) | |
4210 | (setq name (idlwave-sintern-method name set))) | |
4211 | (setq name (idlwave-sintern-routine name set))) | |
4b1aaa8b | 4212 | |
52a244eb S |
4213 | ;; The source |
4214 | (let ((source-type (car source)) | |
4215 | (source-file (nth 1 source)) | |
4b1aaa8b | 4216 | (source-dir (if default-dir |
52a244eb S |
4217 | (file-name-as-directory default-dir) |
4218 | (nth 2 source))) | |
4219 | (source-lib (nth 3 source))) | |
4220 | (if (stringp source-dir) | |
4221 | (setq source-dir (idlwave-sintern-dir source-dir set))) | |
4222 | (if (stringp source-lib) | |
4223 | (setq source-lib (idlwave-sintern-libname source-lib set))) | |
4224 | (setq source (list source-type source-file source-dir source-lib))) | |
4b1aaa8b | 4225 | |
52a244eb S |
4226 | ;; The keywords |
4227 | (setq kwds (mapcar (lambda (x) | |
4228 | (idlwave-sintern-keyword-list x set)) | |
4229 | kwds)) | |
4230 | ||
4231 | ;; Build a canonicalized list | |
4232 | (setq new (nconc (list name type class source call) kwds) | |
4233 | res (cons new res))) | |
f32b3b91 CD |
4234 | (nreverse res))) |
4235 | ||
05a1abfc CD |
4236 | ;; Creating new sintern tables |
4237 | ||
4238 | (defun idlwave-new-sintern-type (tag) | |
4239 | "Define a variable and a function to sintern the new type TAG. | |
4240 | This defines the function `idlwave-sintern-TAG' and the variable | |
4241 | `idlwave-sint-TAGs'." | |
4242 | (let* ((name (symbol-name tag)) | |
4243 | (names (concat name "s")) | |
4244 | (var (intern (concat "idlwave-sint-" names))) | |
4245 | (func (intern (concat "idlwave-sintern-" name)))) | |
4246 | (set var nil) ; initial value of the association list | |
4247 | (fset func ; set the function | |
4248 | `(lambda (name &optional set) | |
4249 | (cond ((not (stringp name)) name) | |
4250 | ((cdr (assoc (downcase name) ,var))) | |
4251 | (set | |
4252 | (setq ,var (cons (cons (downcase name) name) ,var)) | |
4253 | name) | |
4254 | (name)))))) | |
4255 | ||
4256 | (defun idlwave-reset-sintern-type (tag) | |
4257 | "Reset the sintern variable associated with TAG." | |
4258 | (set (intern (concat "idlwave-sint-" (symbol-name tag) "s")) nil)) | |
4259 | ||
f32b3b91 CD |
4260 | ;;--------------------------------------------------------------------------- |
4261 | ||
4262 | ||
4263 | ;; The variables which hold the information | |
15e42531 | 4264 | (defvar idlwave-system-routines nil |
f32b3b91 CD |
4265 | "Holds the routine-info obtained by scanning buffers.") |
4266 | (defvar idlwave-buffer-routines nil | |
4267 | "Holds the routine-info obtained by scanning buffers.") | |
4268 | (defvar idlwave-compiled-routines nil | |
15e42531 CD |
4269 | "Holds the routine-info obtained by asking the shell.") |
4270 | (defvar idlwave-unresolved-routines nil | |
4271 | "Holds the unresolved routine-info obtained by asking the shell.") | |
52a244eb S |
4272 | (defvar idlwave-user-catalog-routines nil |
4273 | "Holds the procedure routine-info from the user scan.") | |
4274 | (defvar idlwave-library-catalog-routines nil | |
3938cb82 S |
4275 | "Holds the procedure routine-info from the .idlwave_catalog library files.") |
4276 | (defvar idlwave-library-catalog-libname nil | |
4277 | "Name of library catalog loaded from .idlwave_catalog files.") | |
15e42531 | 4278 | (defvar idlwave-path-alist nil |
52a244eb S |
4279 | "Alist with !PATH directories and zero or more flags if the dir has |
4280 | been scanned in a user catalog ('user) or discovered in a library | |
4281 | catalog \('lib).") | |
15e42531 CD |
4282 | (defvar idlwave-true-path-alist nil |
4283 | "Like `idlwave-path-alist', but with true filenames.") | |
f32b3b91 | 4284 | (defvar idlwave-routines nil |
b9e4fbd3 | 4285 | "Holds the combined procedure/function/method routine-info.") |
f32b3b91 CD |
4286 | (defvar idlwave-class-alist nil |
4287 | "Holds the class names known to IDLWAVE.") | |
4288 | (defvar idlwave-class-history nil | |
4289 | "The history of classes selected with the minibuffer.") | |
4290 | (defvar idlwave-force-class-query nil) | |
4291 | (defvar idlwave-before-completion-wconf nil | |
4292 | "The window configuration just before the completion buffer was displayed.") | |
15e42531 CD |
4293 | (defvar idlwave-last-system-routine-info-cons-cell nil |
4294 | "The last cons cell in the system routine info.") | |
f32b3b91 CD |
4295 | |
4296 | ;; | |
4297 | ;; The code to get routine info from different sources. | |
4298 | ||
15e42531 | 4299 | (defvar idlwave-system-routines) |
5e72c6b2 S |
4300 | (defvar idlwave-catalog-process nil |
4301 | "The background process currently updating the catalog.") | |
4302 | ||
f32b3b91 CD |
4303 | (defun idlwave-routines () |
4304 | "Provide a list of IDL routines. | |
5a0c3f56 JB |
4305 | This routine loads the builtin routines on the first call. |
4306 | Later it only returns the value of the variable." | |
5e72c6b2 S |
4307 | (if (and idlwave-catalog-process |
4308 | (processp idlwave-catalog-process)) | |
4309 | (progn | |
4310 | (cond | |
4311 | ((equal (process-status idlwave-catalog-process) 'exit) | |
4312 | (message "updating........") | |
4313 | (setq idlwave-catalog-process nil) | |
4314 | (idlwave-update-routine-info '(4))) | |
4315 | ((equal (process-status idlwave-catalog-process) 'run) | |
4316 | ;; Keep it running... | |
4317 | ) | |
4318 | (t | |
4319 | ;; Something is wrong, get rid of the process | |
4320 | (message "Problem with catalog process") (beep) | |
4321 | (condition-case nil | |
4322 | (kill-process idlwave-catalog-process) | |
4323 | (error nil)) | |
4324 | (setq idlwave-catalog-process nil))))) | |
f32b3b91 CD |
4325 | (or idlwave-routines |
4326 | (progn | |
4327 | (idlwave-update-routine-info) | |
4328 | ;; return the current value | |
4329 | idlwave-routines))) | |
4330 | ||
05a1abfc CD |
4331 | (defvar idlwave-update-rinfo-hook nil |
4332 | "List of functions which should run after a global rinfo update. | |
4333 | Does not run after automatic updates of buffer or the shell.") | |
4334 | ||
5e72c6b2 | 4335 | (defun idlwave-rescan-catalog-directories () |
5a0c3f56 | 4336 | "Rescan the previously selected directories. For batch processing." |
5e72c6b2 S |
4337 | (idlwave-update-routine-info '(16))) |
4338 | ||
4339 | (defun idlwave-rescan-asynchronously () | |
8a6a28ac | 4340 | "Dispatch another Emacs instance to update the idlwave catalog. |
5e72c6b2 S |
4341 | After the process finishes normally, the first access to routine info |
4342 | will re-read the catalog." | |
4343 | (interactive) | |
4344 | (if (processp idlwave-catalog-process) | |
4345 | (if (eq (process-status idlwave-catalog-process) 'run) | |
4346 | (if (yes-or-no-p "A catalog-updating process is running. Kill it? ") | |
4347 | (progn | |
4348 | (condition-case nil | |
4349 | (kill-process idlwave-catalog-process) | |
4350 | (error nil)) | |
4351 | (error "Process killed, no new process started")) | |
4352 | (error "Quit")) | |
4353 | (condition-case nil | |
4354 | (kill-process idlwave-catalog-process) | |
4355 | (error nil)))) | |
52a244eb S |
4356 | (if (or (not idlwave-user-catalog-file) |
4357 | (not (stringp idlwave-user-catalog-file)) | |
4358 | (not (file-regular-p idlwave-user-catalog-file))) | |
5e72c6b2 | 4359 | (error "No catalog has been produced yet")) |
4b1aaa8b | 4360 | (let* ((emacs (concat invocation-directory invocation-name)) |
5e72c6b2 S |
4361 | (args (list "-batch" |
4362 | "-l" (expand-file-name "~/.emacs") | |
4363 | "-l" "idlwave" | |
4364 | "-f" "idlwave-rescan-catalog-directories")) | |
4b1aaa8b | 4365 | (process (apply 'start-process "idlcat" |
5e72c6b2 S |
4366 | nil emacs args))) |
4367 | (setq idlwave-catalog-process process) | |
4b1aaa8b | 4368 | (set-process-sentinel |
5e72c6b2 S |
4369 | process |
4370 | (lambda (pro why) | |
4371 | (when (string-match "finished" why) | |
4372 | (setq idlwave-routines nil | |
4373 | idlwave-system-routines nil | |
4374 | idlwave-catalog-process nil) | |
4375 | (or (idlwave-start-load-rinfo-timer) | |
4376 | (idlwave-update-routine-info '(4)))))) | |
4377 | (message "Background job started to update catalog file"))) | |
4378 | ||
4379 | ||
52a244eb S |
4380 | ;; Format for all routine info user catalog, library catalogs, etc.: |
4381 | ;; | |
4382 | ;; ("ROUTINE" type class | |
4383 | ;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | | |
4384 | ;; (buffer pro_file dir) | (compiled pro_file dir) | |
4b1aaa8b | 4385 | ;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) |
f66f03de | 4386 | ;; ("HELPFILE2" (("KWD2" . link) ...)) ...) |
52a244eb S |
4387 | ;; |
4388 | ;; DIR will be supplied dynamically while loading library catalogs, | |
4389 | ;; and is sinterned to save space, as is LIBNAME. PRO_FILE can be a | |
4390 | ;; complete filepath, in which case DIR is unnecessary. HELPFILE can | |
4391 | ;; be nil, as can LINK1, etc., if no HTML help is available. | |
4392 | ||
4393 | ||
5e72c6b2 | 4394 | (defvar idlwave-load-rinfo-idle-timer) |
3938cb82 S |
4395 | (defvar idlwave-shell-path-query) |
4396 | ||
52a244eb | 4397 | (defun idlwave-update-routine-info (&optional arg no-concatenate) |
f32b3b91 CD |
4398 | "Update the internal routine-info lists. |
4399 | These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info]) | |
4400 | and by `idlwave-complete' (\\[idlwave-complete]) to provide information | |
4401 | about individual routines. | |
4402 | ||
4403 | The information can come from 4 sources: | |
4404 | 1. IDL programs in the current editing session | |
4405 | 2. Compiled modules in an IDL shell running as Emacs subprocess | |
4406 | 3. A list which covers the IDL system routines. | |
4407 | 4. A list which covers the prescanned library files. | |
4408 | ||
4409 | Scans all IDLWAVE-mode buffers of the current editing session (see | |
4410 | `idlwave-scan-all-buffers-for-routine-info'). | |
4411 | When an IDL shell is running, this command also queries the IDL program | |
4412 | for currently compiled routines. | |
4413 | ||
4414 | With prefix ARG, also reload the system and library lists. | |
52a244eb S |
4415 | With two prefix ARG's, also rescans the chosen user catalog tree. |
4416 | With three prefix args, dispatch asynchronous process to do the update. | |
4417 | ||
4418 | If NO-CONCATENATE is non-nil, don't pre-concatenate the routine info | |
4419 | lists, but instead wait for the shell query to complete and | |
4420 | asynchronously finish updating routine info. This is set | |
4421 | automatically when called interactively. When you need routine | |
4422 | information updated immediately, leave NO-CONCATENATE nil." | |
751adbde | 4423 | (interactive "P\np") |
5e72c6b2 S |
4424 | ;; Stop any idle processing |
4425 | (if (or (and (fboundp 'itimerp) | |
4426 | (itimerp idlwave-load-rinfo-idle-timer)) | |
4427 | (and (fboundp 'timerp) | |
4428 | (timerp idlwave-load-rinfo-idle-timer))) | |
4429 | (cancel-timer idlwave-load-rinfo-idle-timer)) | |
4430 | (cond | |
4431 | ((equal arg '(64)) | |
4432 | ;; Start a background process which updates the catalog. | |
4433 | (idlwave-rescan-asynchronously)) | |
4434 | ((equal arg '(16)) | |
52a244eb S |
4435 | ;; Update the user catalog now, and wait for them. |
4436 | (idlwave-create-user-catalog-file t)) | |
5e72c6b2 S |
4437 | (t |
4438 | (let* ((load (or arg | |
4439 | idlwave-buffer-case-takes-precedence | |
4440 | (null idlwave-routines))) | |
4441 | ;; The override-idle means, even if the idle timer has done some | |
4442 | ;; preparing work, load and renormalize everything anyway. | |
4443 | (override-idle (or arg idlwave-buffer-case-takes-precedence))) | |
4b1aaa8b | 4444 | |
f32b3b91 | 4445 | (setq idlwave-buffer-routines nil |
15e42531 CD |
4446 | idlwave-compiled-routines nil |
4447 | idlwave-unresolved-routines nil) | |
f32b3b91 | 4448 | ;; Reset the appropriate hashes |
5e72c6b2 S |
4449 | (if (get 'idlwave-reset-sintern 'done-by-idle) |
4450 | ;; reset was already done in idle time, so skip this step now once | |
4451 | (put 'idlwave-reset-sintern 'done-by-idle nil) | |
4452 | (idlwave-reset-sintern (cond (load t) | |
4453 | ((null idlwave-system-routines) t) | |
4454 | (t 'bufsh)))) | |
4b1aaa8b | 4455 | |
f32b3b91 CD |
4456 | (if idlwave-buffer-case-takes-precedence |
4457 | ;; We can safely scan the buffer stuff first | |
4458 | (progn | |
4459 | (idlwave-update-buffer-routine-info) | |
f66f03de | 4460 | (and load (idlwave-load-all-rinfo override-idle))) |
f32b3b91 | 4461 | ;; We first do the system info, and then the buffers |
f66f03de | 4462 | (and load (idlwave-load-all-rinfo override-idle)) |
f32b3b91 CD |
4463 | (idlwave-update-buffer-routine-info)) |
4464 | ||
4465 | ;; Let's see if there is a shell | |
4466 | (let* ((shell-is-running (and (fboundp 'idlwave-shell-is-running) | |
4467 | (idlwave-shell-is-running))) | |
4468 | (ask-shell (and shell-is-running | |
4469 | idlwave-query-shell-for-routine-info))) | |
4b1aaa8b | 4470 | |
52a244eb | 4471 | ;; Load the library catalogs again, first re-scanning the path |
4b1aaa8b | 4472 | (when arg |
52a244eb S |
4473 | (if shell-is-running |
4474 | (idlwave-shell-send-command idlwave-shell-path-query | |
4475 | '(progn | |
4476 | (idlwave-shell-get-path-info) | |
4477 | (idlwave-scan-library-catalogs)) | |
4478 | 'hide) | |
4479 | (idlwave-scan-library-catalogs))) | |
775591f7 | 4480 | |
f32b3b91 | 4481 | (if (or (not ask-shell) |
52a244eb | 4482 | (not no-concatenate)) |
f32b3b91 CD |
4483 | ;; 1. If we are not going to ask the shell, we need to do the |
4484 | ;; concatenation now. | |
52a244eb S |
4485 | ;; 2. When this function is called non-interactively, it |
4486 | ;; means that someone needs routine info *now*. The | |
4487 | ;; shell update causes the concatenation to be | |
4488 | ;; *delayed*, so not in time for the current command. | |
4489 | ;; Therefore, we do a concatenation now, even though | |
4490 | ;; the shell might do it again. | |
4491 | (idlwave-concatenate-rinfo-lists nil 'run-hooks)) | |
4b1aaa8b | 4492 | |
f32b3b91 | 4493 | (when ask-shell |
52a244eb | 4494 | ;; Ask the shell about the routines it knows of. |
f32b3b91 | 4495 | (message "Querying the shell") |
5e72c6b2 S |
4496 | (idlwave-shell-update-routine-info nil t))))))) |
4497 | ||
52a244eb S |
4498 | |
4499 | (defvar idlwave-load-rinfo-steps-done (make-vector 6 nil)) | |
5e72c6b2 S |
4500 | (defvar idlwave-load-rinfo-idle-timer nil) |
4501 | (defun idlwave-start-load-rinfo-timer () | |
4502 | (if (or (and (fboundp 'itimerp) | |
4503 | (itimerp idlwave-load-rinfo-idle-timer)) | |
4504 | (and (fboundp 'timerp) | |
4505 | (timerp idlwave-load-rinfo-idle-timer))) | |
4506 | (cancel-timer idlwave-load-rinfo-idle-timer)) | |
52a244eb | 4507 | (setq idlwave-load-rinfo-steps-done (make-vector 6 nil)) |
5e72c6b2 S |
4508 | (setq idlwave-load-rinfo-idle-timer nil) |
4509 | (if (and idlwave-init-rinfo-when-idle-after | |
4510 | (numberp idlwave-init-rinfo-when-idle-after) | |
4511 | (not (equal 0 idlwave-init-rinfo-when-idle-after)) | |
4512 | (not idlwave-routines)) | |
4513 | (condition-case nil | |
4514 | (progn | |
4515 | (setq idlwave-load-rinfo-idle-timer | |
4516 | (run-with-idle-timer | |
4517 | idlwave-init-rinfo-when-idle-after | |
4518 | nil 'idlwave-load-rinfo-next-step))) | |
4519 | (error nil)))) | |
4520 | ||
f66f03de S |
4521 | ;;------ XML Help routine info system |
4522 | (defun idlwave-load-system-routine-info () | |
4523 | ;; Load the system routine info from the cached routine info file, | |
4524 | ;; which, if necessary, will be re-created from the XML file on | |
4525 | ;; disk. As a last fallback, load the (likely outdated) idlw-rinfo | |
4526 | ;; file distributed with older IDLWAVE versions (<6.0) | |
4b1aaa8b | 4527 | (unless (and (load idlwave-xml-system-rinfo-converted-file |
f66f03de S |
4528 | 'noerror 'nomessage) |
4529 | (idlwave-xml-system-routine-info-up-to-date)) | |
4530 | ;; See if we can create it from XML source | |
4531 | (condition-case nil | |
4532 | (idlwave-convert-xml-system-routine-info) | |
4b1aaa8b PE |
4533 | (error |
4534 | (unless (load idlwave-xml-system-rinfo-converted-file | |
f66f03de S |
4535 | 'noerror 'nomessage) |
4536 | (if idlwave-system-routines | |
4b1aaa8b | 4537 | (message |
f66f03de | 4538 | "Failed to load converted routine info, using old conversion.") |
4b1aaa8b | 4539 | (message |
f66f03de S |
4540 | "Failed to convert XML routine info, falling back on idlw-rinfo.") |
4541 | (if (not (load "idlw-rinfo" 'noerror 'nomessage)) | |
4b1aaa8b | 4542 | (message |
f66f03de S |
4543 | "Could not locate any system routine information.")))))))) |
4544 | ||
4545 | (defun idlwave-xml-system-routine-info-up-to-date() | |
4b1aaa8b | 4546 | (let* ((dir (file-name-as-directory |
f66f03de S |
4547 | (expand-file-name "help/online_help" (idlwave-sys-dir)))) |
4548 | (catalog-file (expand-file-name "idl_catalog.xml" dir))) | |
4549 | (file-newer-than-file-p ;converted file is newer than catalog | |
4550 | idlwave-xml-system-rinfo-converted-file | |
4551 | catalog-file))) | |
4552 | ||
4553 | (defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo | |
4554 | (defvar idlwave-system-variables-alist nil | |
4555 | "Alist of system variables and the associated structure tags. | |
4556 | Gets set in cached XML rinfo, or `idlw-rinfo.el'.") | |
4557 | (defvar idlwave-executive-commands-alist nil | |
4558 | "Alist of system variables and their help files.") | |
4559 | (defvar idlwave-help-special-topic-words nil) | |
4560 | ||
4b1aaa8b | 4561 | |
f66f03de | 4562 | (defun idlwave-shorten-syntax (syntax name &optional class) |
5a89f0a7 | 4563 | ;; From a list of syntax statements, shorten with %s and group with "or" |
f66f03de | 4564 | (let ((case-fold-search t)) |
4b1aaa8b | 4565 | (mapconcat |
f66f03de S |
4566 | (lambda (x) |
4567 | (while (string-match name x) | |
4568 | (setq x (replace-match "%s" t t x))) | |
4b1aaa8b | 4569 | (if class |
f66f03de S |
4570 | (while (string-match class x) |
4571 | (setq x (replace-match "%s" t t x)))) | |
4572 | x) | |
4573 | (nreverse syntax) | |
4574 | " or "))) | |
4575 | ||
4576 | (defun idlwave-xml-create-class-method-lists (xml-entry) | |
4577 | ;; Create a class list entry from the xml parsed list., returning a | |
4578 | ;; cons of form (class-entry method-entries). | |
4579 | (let* ((nameblock (nth 1 xml-entry)) | |
4580 | (class (cdr (assq 'name nameblock))) | |
4581 | (link (cdr (assq 'link nameblock))) | |
4582 | (params (cddr xml-entry)) | |
4583 | (case-fold-search t) | |
4584 | class-entry | |
4585 | method methods-entry extra-kwds | |
4586 | props get-props set-props init-props inherits | |
4587 | pelem ptype) | |
4588 | (while params | |
4589 | (setq pelem (car params)) | |
4590 | (when (listp pelem) | |
4591 | (setq ptype (car pelem) | |
4592 | props (car (cdr pelem))) | |
4593 | (cond | |
4594 | ((eq ptype 'SUPERCLASS) | |
58c8f915 S |
4595 | (let ((pname (cdr (assq 'name props))) |
4596 | (plink (cdr (assq 'link props)))) | |
4597 | (unless (and (string= pname "None") | |
4598 | (string= plink "None")) | |
4599 | (push pname inherits)))) | |
f66f03de S |
4600 | |
4601 | ((eq ptype 'PROPERTY) | |
4602 | (let ((pname (cdr (assq 'name props))) | |
4603 | (plink (cdr (assq 'link props))) | |
4604 | (get (string= (cdr (assq 'get props)) "Yes")) | |
4605 | (set (string= (cdr (assq 'set props)) "Yes")) | |
4606 | (init (string= (cdr (assq 'init props)) "Yes"))) | |
4607 | (if get (push (list pname plink) get-props)) | |
4608 | (if set (push (list pname plink) set-props)) | |
4609 | (if init (push (list pname plink) init-props)))) | |
4610 | ||
4611 | ((eq ptype 'METHOD) | |
4612 | (setq method (cdr (assq 'name props))) | |
4613 | (setq extra-kwds ;;Assume all property keywords are gathered already | |
4614 | (cond | |
4615 | ((string-match (concat class "::Init") method) | |
4616 | (put 'init-props 'matched t) | |
4617 | init-props) | |
4618 | ((string-match (concat class "::GetProperty") method) | |
4619 | (put 'get-props 'matched t) | |
4620 | get-props) | |
4621 | ((string-match (concat class "::SetProperty") method) | |
4622 | (put 'set-props 'matched t) | |
4623 | set-props) | |
4624 | (t nil))) | |
4b1aaa8b PE |
4625 | (setq methods-entry |
4626 | (nconc (idlwave-xml-create-rinfo-list pelem class extra-kwds) | |
f66f03de S |
4627 | methods-entry))) |
4628 | (t))) | |
4629 | (setq params (cdr params))) | |
8d222148 SM |
4630 | ;;(unless (get 'init-props 'matched) |
4631 | ;; (message "Failed to match Init in class %s" class)) | |
4632 | ;;(unless (get 'get-props 'matched) | |
4633 | ;; (message "Failed to match GetProperty in class %s" class)) | |
4634 | ;;(unless (get 'set-props 'matched) | |
4635 | ;; (message "Failed to match SetProperty in class %s" class)) | |
4b1aaa8b PE |
4636 | (setq class-entry |
4637 | (if inherits | |
f66f03de S |
4638 | (list class (append '(inherits) inherits) (list 'link link)) |
4639 | (list class (list 'link link)))) | |
4640 | (cons class-entry methods-entry))) | |
4b1aaa8b | 4641 | |
f66f03de S |
4642 | (defun idlwave-xml-create-rinfo-list (xml-entry &optional class extra-kws) |
4643 | ;; Create correctly structured list elements from ROUTINE or METHOD | |
4644 | ;; XML list structures. Return a list of list elements, with more | |
4645 | ;; than one sub-list possible if a routine can serve as both | |
4646 | ;; procedure and function (e.g. call_method). | |
4647 | (let* ((nameblock (nth 1 xml-entry)) | |
4648 | (name (cdr (assq 'name nameblock))) | |
4649 | (link (cdr (assq 'link nameblock))) | |
4650 | (params (cddr xml-entry)) | |
4651 | (syntax-vec (make-vector 3 nil)) ; procedure, function, exec command | |
4652 | (case-fold-search t) | |
8d222148 | 4653 | syntax kwd klink pref-list kwds pelem ptype props result type) |
f66f03de S |
4654 | (if class ;; strip out class name from class method name string |
4655 | (if (string-match (concat class "::") name) | |
4656 | (setq name (substring name (match-end 0))))) | |
4657 | (while params | |
4658 | (setq pelem (car params)) | |
4659 | (when (listp pelem) | |
4660 | (setq ptype (car pelem) | |
4661 | props (car (cdr pelem))) | |
4662 | (cond | |
4663 | ((eq ptype 'SYNTAX) | |
4664 | (setq syntax (cdr (assq 'name props))) | |
4665 | (if (string-match "->" syntax) | |
4666 | (setq syntax (replace-match "->" t nil syntax))) | |
4667 | (setq type (cdr (assq 'type props))) | |
4668 | (push syntax | |
4669 | (aref syntax-vec (cond | |
4670 | ((string-match "^pro" type) 0) | |
4671 | ((string-match "^fun" type) 1) | |
4672 | ((string-match "^exec" type) 2))))) | |
4673 | ((eq ptype 'KEYWORD) | |
4674 | (setq kwd (cdr (assq 'name props)) | |
4675 | klink (cdr (assq 'link props))) | |
4676 | (if (string-match "^\\[XY\\(Z?\\)\\]" kwd) | |
4b1aaa8b PE |
4677 | (progn |
4678 | (setq pref-list | |
f66f03de S |
4679 | (if (match-string 1 kwd) '("X" "Y" "Z") '("X" "Y")) |
4680 | kwd (substring kwd (match-end 0))) | |
4681 | (loop for x in pref-list do | |
4682 | (push (list (concat x kwd) klink) kwds))) | |
4683 | (push (list kwd klink) kwds))) | |
4684 | ||
4685 | (t))); Do nothing for the others | |
4686 | (setq params (cdr params))) | |
4b1aaa8b | 4687 | |
f66f03de | 4688 | ;; Debug |
8d222148 SM |
4689 | ;; (if (and (null (aref syntax-vec 0)) |
4690 | ;; (null (aref syntax-vec 1)) | |
4691 | ;; (null (aref syntax-vec 2))) | |
4692 | ;; (with-current-buffer (get-buffer-create "IDL_XML_catalog_complaints") | |
4693 | ;; (if class | |
4694 | ;; (insert (format "Missing SYNTAX entry for %s::%s\n" class name)) | |
4695 | ;; (insert (message "Missing SYNTAX entry for %s\n" name))))) | |
f66f03de S |
4696 | |
4697 | ;; Executive commands are treated specially | |
4698 | (if (aref syntax-vec 2) | |
4699 | (cons (substring name 1) link) | |
4700 | (if extra-kws (setq kwds (nconc kwds extra-kws))) | |
4701 | (setq kwds (idlwave-rinfo-group-keywords kwds link)) | |
4702 | (loop for idx from 0 to 1 do | |
4703 | (if (aref syntax-vec idx) | |
4b1aaa8b | 4704 | (push (append (list name (if (eq idx 0) 'pro 'fun) |
f66f03de | 4705 | class '(system) |
4b1aaa8b | 4706 | (idlwave-shorten-syntax |
f66f03de S |
4707 | (aref syntax-vec idx) name class)) |
4708 | kwds) result))) | |
4709 | result))) | |
4710 | ||
4711 | ||
4712 | (defun idlwave-rinfo-group-keywords (kwds master-link) | |
4b1aaa8b | 4713 | ;; Group keywords by link file, as a list with elements |
f66f03de S |
4714 | ;; (linkfile ( ("KWD1" . link1) ("KWD2" . link2)) |
4715 | (let (kwd link anchor linkfiles block master-elt) | |
4716 | (while kwds | |
4717 | (setq kwd (car kwds) | |
4718 | link (idlwave-split-link-target (nth 1 kwd)) | |
4719 | anchor (cdr link) | |
4720 | link (car link) | |
4721 | kwd (car kwd)) | |
4722 | (if (setq block (assoc link linkfiles)) | |
4723 | (push (cons kwd anchor) (cdr block)) | |
4724 | (push (list link (cons kwd anchor)) linkfiles)) | |
4725 | (setq kwds (cdr kwds))) | |
4726 | ;; Ensure the master link is there | |
4727 | (if (setq master-elt (assoc master-link linkfiles)) | |
4728 | (if (eq (car linkfiles) master-elt) | |
4729 | linkfiles | |
4730 | (cons master-elt (delq master-elt linkfiles))) | |
4731 | (push (list master-link) linkfiles)))) | |
4b1aaa8b | 4732 | |
f66f03de S |
4733 | (defun idlwave-convert-xml-clean-statement-aliases (aliases) |
4734 | ;; Clean up the syntax of routines which are actually aliases by | |
4735 | ;; removing the "OR" from the statements | |
4736 | (let (syntax entry) | |
4737 | (loop for x in aliases do | |
4738 | (setq entry (assoc x idlwave-system-routines)) | |
4739 | (when entry | |
4740 | (while (string-match " +or +" (setq syntax (nth 4 entry))) | |
4741 | (setf (nth 4 entry) (replace-match ", " t t syntax))))))) | |
4742 | ||
4743 | (defun idlwave-convert-xml-clean-routine-aliases (aliases) | |
4744 | ;; Duplicate and trim original routine aliases from rinfo list | |
4b1aaa8b | 4745 | ;; This if for, e.g. OPENR/OPENW/OPENU |
f66f03de S |
4746 | (let (alias remove-list new parts all-parts) |
4747 | (loop for x in aliases do | |
4748 | (when (setq parts (split-string (cdr x) "/")) | |
4749 | (setq new (assoc (cdr x) all-parts)) | |
4750 | (unless new | |
4751 | (setq new (cons (cdr x) parts)) | |
4752 | (push new all-parts)) | |
4753 | (setcdr new (delete (car x) (cdr new))))) | |
4b1aaa8b | 4754 | |
f66f03de S |
4755 | ;; Add any missing aliases (separate by slashes) |
4756 | (loop for x in all-parts do | |
4757 | (if (cdr x) | |
4758 | (push (cons (nth 1 x) (car x)) aliases))) | |
4759 | ||
4760 | (loop for x in aliases do | |
4761 | (when (setq alias (assoc (cdr x) idlwave-system-routines)) | |
4762 | (unless (memq alias remove-list) (push alias remove-list)) | |
4763 | (setq alias (copy-sequence alias)) | |
4764 | (setcar alias (car x)) | |
4765 | (push alias idlwave-system-routines))) | |
4766 | (loop for x in remove-list do | |
4767 | (delq x idlwave-system-routines)))) | |
4768 | ||
4769 | (defun idlwave-convert-xml-clean-sysvar-aliases (aliases) | |
4770 | ;; Duplicate and trim original routine aliases from rinfo list | |
4771 | ;; This if for, e.g. !X, !Y, !Z. | |
8d222148 | 4772 | (let (alias remove-list) |
f66f03de S |
4773 | (loop for x in aliases do |
4774 | (when (setq alias (assoc (cdr x) idlwave-system-variables-alist)) | |
4775 | (unless (memq alias remove-list) (push alias remove-list)) | |
4776 | (setq alias (copy-sequence alias)) | |
4777 | (setcar alias (car x)) | |
4778 | (push alias idlwave-system-variables-alist))) | |
4779 | (loop for x in remove-list do | |
4780 | (delq x idlwave-system-variables-alist)))) | |
4781 | ||
4782 | ||
4783 | (defun idlwave-xml-create-sysvar-alist (xml-entry) | |
4784 | ;; Create a sysvar list entry from the xml parsed list. | |
4785 | (let* ((nameblock (nth 1 xml-entry)) | |
a86bd650 | 4786 | (name (cdr (assq 'name nameblock))) |
b9e4fbd3 | 4787 | (sysvar (substring name (progn (string-match "^ *!" name) |
a86bd650 | 4788 | (match-end 0)))) |
f66f03de S |
4789 | (link (cdr (assq 'link nameblock))) |
4790 | (params (cddr xml-entry)) | |
4791 | (case-fold-search t) | |
8d222148 | 4792 | pelem ptype props tags) |
f66f03de S |
4793 | (while params |
4794 | (setq pelem (car params)) | |
4795 | (when (listp pelem) | |
4796 | (setq ptype (car pelem) | |
4797 | props (car (cdr pelem))) | |
4798 | (cond | |
4799 | ((eq ptype 'FIELD) | |
4b1aaa8b | 4800 | (push (cons (cdr (assq 'name props)) |
f66f03de S |
4801 | (cdr |
4802 | (idlwave-split-link-target (cdr (assq 'link props))))) | |
4803 | tags)))) | |
4804 | (setq params (cdr params))) | |
4805 | (delq nil | |
4806 | (list sysvar (if tags (cons 'tags tags)) (list 'link link))))) | |
4807 | ||
4808 | ||
4809 | (defvar idlwave-xml-routine-info-file nil) | |
4810 | ||
4811 | (defun idlwave-save-routine-info () | |
4812 | (if idlwave-xml-routine-info-file | |
4813 | (with-temp-file idlwave-xml-system-rinfo-converted-file | |
4b1aaa8b | 4814 | (insert |
f66f03de | 4815 | (concat ";; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* |
4b1aaa8b PE |
4816 | ;; IDLWAVE Routine Information File (IDLWAVE version " idlwave-mode-version ") |
4817 | ;; Automatically generated from source file: | |
f66f03de S |
4818 | ;; " idlwave-xml-routine-info-file " |
4819 | ;; on " (current-time-string) " | |
4820 | ;; Do not edit.")) | |
4821 | (insert (format "\n(setq idlwave-xml-routine-info-file \n \"%s\")" | |
4822 | idlwave-xml-routine-info-file)) | |
4823 | (insert "\n(setq idlwave-system-routines\n '") | |
4824 | (prin1 idlwave-system-routines (current-buffer)) | |
4825 | (insert ")") | |
4826 | (insert "\n(setq idlwave-system-variables-alist\n '") | |
4827 | (prin1 idlwave-system-variables-alist (current-buffer)) | |
4828 | (insert ")") | |
4829 | (insert "\n(setq idlwave-system-class-info\n '") | |
4830 | (prin1 idlwave-system-class-info (current-buffer)) | |
4831 | (insert ")") | |
4832 | (insert "\n(setq idlwave-executive-commands-alist\n '") | |
4833 | (prin1 idlwave-executive-commands-alist (current-buffer)) | |
4834 | (insert ")") | |
4835 | (insert "\n(setq idlwave-help-special-topic-words\n '") | |
4836 | (prin1 idlwave-help-special-topic-words (current-buffer)) | |
4837 | (insert ")")))) | |
4838 | ||
4839 | (defun idlwave-convert-xml-system-routine-info () | |
4840 | "Convert XML supplied IDL routine info into internal form. | |
4841 | Cache to disk for quick recovery." | |
4842 | (interactive) | |
4b1aaa8b | 4843 | (let* ((dir (file-name-as-directory |
f66f03de S |
4844 | (expand-file-name "help/online_help" (idlwave-sys-dir)))) |
4845 | (catalog-file (expand-file-name "idl_catalog.xml" dir)) | |
4846 | (elem-cnt 0) | |
4b1aaa8b | 4847 | props rinfo msg-cnt elem type nelem class-result alias |
8d222148 | 4848 | routines routine-aliases statement-aliases sysvar-aliases) |
f66f03de S |
4849 | (if (not (file-exists-p catalog-file)) |
4850 | (error "No such XML routine info file: %s" catalog-file) | |
4851 | (if (not (file-readable-p catalog-file)) | |
4852 | (error "Cannot read XML routine info file: %s" catalog-file))) | |
4b1aaa8b | 4853 | (message "Reading XML routine info...") |
e08734e2 | 4854 | (setq rinfo (xml-parse-file catalog-file)) |
f66f03de S |
4855 | (message "Reading XML routine info...done") |
4856 | (setq rinfo (assq 'CATALOG rinfo)) | |
4857 | (unless rinfo (error "Failed to parse XML routine info")) | |
4858 | ;;(setq rinfo (car rinfo)) ; Skip the catalog stuff. | |
4b1aaa8b | 4859 | |
8d222148 | 4860 | (setq rinfo (cddr rinfo)) |
f66f03de S |
4861 | |
4862 | (setq nelem (length rinfo) | |
4863 | msg-cnt (/ nelem 20)) | |
4b1aaa8b | 4864 | |
f66f03de S |
4865 | (setq idlwave-xml-routine-info-file nil) |
4866 | (message "Converting XML routine info...") | |
4867 | (setq idlwave-system-routines nil | |
4868 | idlwave-system-variables-alist nil | |
4869 | idlwave-system-class-info nil | |
4870 | idlwave-executive-commands-alist nil | |
4871 | idlwave-help-special-topic-words nil) | |
4872 | ||
4873 | (while rinfo | |
4874 | (setq elem (car rinfo) | |
4875 | rinfo (cdr rinfo)) | |
4876 | (incf elem-cnt) | |
4877 | (when (listp elem) | |
4878 | (setq type (car elem) | |
4879 | props (car (cdr elem))) | |
4880 | (if (= (mod elem-cnt msg-cnt) 0) | |
4b1aaa8b | 4881 | (message "Converting XML routine info...%2d%%" |
f66f03de | 4882 | (/ (* elem-cnt 100) nelem))) |
4b1aaa8b | 4883 | (cond |
f66f03de S |
4884 | ((eq type 'ROUTINE) |
4885 | (if (setq alias (assq 'alias_to props)) | |
4b1aaa8b | 4886 | (push (cons (cdr (assq 'name props)) (cdr alias)) |
f66f03de S |
4887 | routine-aliases) |
4888 | (setq routines (idlwave-xml-create-rinfo-list elem)) | |
4889 | (if (listp (cdr routines)) | |
4890 | (setq idlwave-system-routines | |
4891 | (nconc idlwave-system-routines routines)) | |
4892 | ;; a cons cell is an executive commands | |
4893 | (push routines idlwave-executive-commands-alist)))) | |
4b1aaa8b | 4894 | |
f66f03de S |
4895 | ((eq type 'CLASS) |
4896 | (setq class-result (idlwave-xml-create-class-method-lists elem)) | |
4897 | (push (car class-result) idlwave-system-class-info) | |
4898 | (setq idlwave-system-routines | |
4899 | (nconc idlwave-system-routines (cdr class-result)))) | |
4900 | ||
4901 | ((eq type 'STATEMENT) | |
4902 | (push (cons (cdr (assq 'name props)) | |
4903 | (cdr (assq 'link props))) | |
4904 | idlwave-help-special-topic-words) | |
4905 | ;; Save the links to those which are statement aliases (not routines) | |
4906 | (if (setq alias (assq 'alias_to props)) | |
4907 | (unless (member (cdr alias) statement-aliases) | |
4908 | (push (cdr alias) statement-aliases)))) | |
4909 | ||
4910 | ((eq type 'SYSVAR) | |
4911 | (if (setq alias (cdr (assq 'alias_to props))) | |
4b1aaa8b | 4912 | (push (cons (substring (cdr (assq 'name props)) 1) |
f66f03de S |
4913 | (substring alias 1)) |
4914 | sysvar-aliases) | |
4b1aaa8b | 4915 | (push (idlwave-xml-create-sysvar-alist elem) |
f66f03de S |
4916 | idlwave-system-variables-alist))) |
4917 | (t)))) | |
4918 | (idlwave-convert-xml-clean-routine-aliases routine-aliases) | |
4919 | (idlwave-convert-xml-clean-statement-aliases statement-aliases) | |
4920 | (idlwave-convert-xml-clean-sysvar-aliases sysvar-aliases) | |
4921 | ||
4922 | (setq idlwave-xml-routine-info-file catalog-file) | |
4923 | (idlwave-save-routine-info) | |
4924 | (message "Converting XML routine info...done"))) | |
4b1aaa8b PE |
4925 | |
4926 | ||
f66f03de S |
4927 | ;; ("ROUTINE" type class |
4928 | ;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | | |
4929 | ;; (buffer pro_file dir) | (compiled pro_file dir) | |
4b1aaa8b | 4930 | ;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) |
f66f03de S |
4931 | ;; ("HELPFILE2" (("KWD2" . link) ...)) ...) |
4932 | ||
4933 | ||
5e72c6b2 S |
4934 | (defun idlwave-load-rinfo-next-step () |
4935 | (let ((inhibit-quit t) | |
4936 | (arr idlwave-load-rinfo-steps-done)) | |
f66f03de | 4937 | (if (catch 'exit |
5e72c6b2 | 4938 | (when (not (aref arr 0)) |
f66f03de S |
4939 | (message "Loading system routine info in idle time...") |
4940 | (idlwave-load-system-routine-info) | |
4941 | ;;(load "idlw-rinfo" 'noerror 'nomessage) | |
4942 | (message "Loading system routine info in idle time...done") | |
5e72c6b2 S |
4943 | (aset arr 0 t) |
4944 | (throw 'exit t)) | |
4b1aaa8b | 4945 | |
5e72c6b2 S |
4946 | (when (not (aref arr 1)) |
4947 | (message "Normalizing idlwave-system-routines in idle time...") | |
4948 | (idlwave-reset-sintern t) | |
4949 | (put 'idlwave-reset-sintern 'done-by-idle t) | |
4950 | (setq idlwave-system-routines | |
4951 | (idlwave-sintern-rinfo-list idlwave-system-routines 'sys)) | |
4952 | (message "Normalizing idlwave-system-routines in idle time...done") | |
4953 | (aset arr 1 t) | |
4954 | (throw 'exit t)) | |
f66f03de | 4955 | |
5e72c6b2 | 4956 | (when (not (aref arr 2)) |
52a244eb S |
4957 | (when (and (stringp idlwave-user-catalog-file) |
4958 | (file-regular-p idlwave-user-catalog-file)) | |
4959 | (message "Loading user catalog in idle time...") | |
5e72c6b2 | 4960 | (condition-case nil |
52a244eb S |
4961 | (load-file idlwave-user-catalog-file) |
4962 | (error (throw 'exit nil))) | |
4963 | ;; Check for the old style catalog and warn | |
4964 | (if (and | |
4965 | (boundp 'idlwave-library-routines) | |
4966 | idlwave-library-routines) | |
775591f7 | 4967 | (progn |
52a244eb S |
4968 | (setq idlwave-library-routines nil) |
4969 | (ding) | |
4b1aaa8b | 4970 | (message "Outdated user catalog: %s... recreate" |
52a244eb | 4971 | idlwave-user-catalog-file)) |
f66f03de S |
4972 | (message "Loading user catalog in idle time...done"))) |
4973 | (aset arr 2 t) | |
4974 | (throw 'exit t)) | |
4975 | ||
5e72c6b2 | 4976 | (when (not (aref arr 3)) |
52a244eb S |
4977 | (when idlwave-user-catalog-routines |
4978 | (message "Normalizing user catalog routines in idle time...") | |
4b1aaa8b | 4979 | (setq idlwave-user-catalog-routines |
52a244eb S |
4980 | (idlwave-sintern-rinfo-list |
4981 | idlwave-user-catalog-routines 'sys)) | |
4b1aaa8b | 4982 | (message |
52a244eb | 4983 | "Normalizing user catalog routines in idle time...done")) |
5e72c6b2 S |
4984 | (aset arr 3 t) |
4985 | (throw 'exit t)) | |
f66f03de | 4986 | |
5e72c6b2 | 4987 | (when (not (aref arr 4)) |
4b1aaa8b | 4988 | (idlwave-scan-library-catalogs |
52a244eb S |
4989 | "Loading and normalizing library catalogs in idle time...") |
4990 | (aset arr 4 t) | |
4991 | (throw 'exit t)) | |
4992 | (when (not (aref arr 5)) | |
5e72c6b2 S |
4993 | (message "Finishing initialization in idle time...") |
4994 | (idlwave-routines) | |
4995 | (message "Finishing initialization in idle time...done") | |
4b1aaa8b | 4996 | (aset arr 5 t) |
5e72c6b2 | 4997 | (throw 'exit nil))) |
52a244eb S |
4998 | ;; restart the timer |
4999 | (if (sit-for 1) | |
5000 | (idlwave-load-rinfo-next-step) | |
5001 | (setq idlwave-load-rinfo-idle-timer | |
5002 | (run-with-idle-timer | |
5003 | idlwave-init-rinfo-when-idle-after | |
5004 | nil 'idlwave-load-rinfo-next-step)))))) | |
5e72c6b2 | 5005 | |
8d222148 SM |
5006 | (defvar idlwave-after-load-rinfo-hook nil) |
5007 | ||
f66f03de S |
5008 | (defun idlwave-load-all-rinfo (&optional force) |
5009 | ;; Load and case-treat the system, user catalog, and library routine | |
5010 | ;; info files. | |
5011 | ||
5012 | ;; System | |
5e72c6b2 | 5013 | (when (or force (not (aref idlwave-load-rinfo-steps-done 0))) |
f66f03de S |
5014 | ;;(load "idlw-rinfo" 'noerror 'nomessage)) |
5015 | (idlwave-load-system-routine-info)) | |
5e72c6b2 S |
5016 | (when (or force (not (aref idlwave-load-rinfo-steps-done 1))) |
5017 | (message "Normalizing idlwave-system-routines...") | |
5018 | (setq idlwave-system-routines | |
5019 | (idlwave-sintern-rinfo-list idlwave-system-routines 'sys)) | |
5020 | (message "Normalizing idlwave-system-routines...done")) | |
f66f03de S |
5021 | (when idlwave-system-routines |
5022 | (setq idlwave-routines (copy-sequence idlwave-system-routines)) | |
5023 | (setq idlwave-last-system-routine-info-cons-cell | |
5024 | (nthcdr (1- (length idlwave-routines)) idlwave-routines))) | |
5025 | ||
5026 | ;; User catalog | |
52a244eb S |
5027 | (when (and (stringp idlwave-user-catalog-file) |
5028 | (file-regular-p idlwave-user-catalog-file)) | |
f32b3b91 | 5029 | (condition-case nil |
52a244eb S |
5030 | (when (or force (not (aref idlwave-load-rinfo-steps-done 2))) |
5031 | (load-file idlwave-user-catalog-file)) | |
5032 | (error nil)) | |
4b1aaa8b | 5033 | (when (and |
f66f03de S |
5034 | (boundp 'idlwave-library-routines) |
5035 | idlwave-library-routines) | |
52a244eb | 5036 | (setq idlwave-library-routines nil) |
4b1aaa8b | 5037 | (error "Outdated user catalog: %s... recreate" |
f66f03de | 5038 | idlwave-user-catalog-file)) |
52a244eb S |
5039 | (setq idlwave-true-path-alist nil) |
5040 | (when (or force (not (aref idlwave-load-rinfo-steps-done 3))) | |
5041 | (message "Normalizing user catalog routines...") | |
4b1aaa8b PE |
5042 | (setq idlwave-user-catalog-routines |
5043 | (idlwave-sintern-rinfo-list | |
52a244eb S |
5044 | idlwave-user-catalog-routines 'sys)) |
5045 | (message "Normalizing user catalog routines...done"))) | |
f66f03de S |
5046 | |
5047 | ;; Library catalog | |
52a244eb S |
5048 | (when (or force (not (aref idlwave-load-rinfo-steps-done 4))) |
5049 | (idlwave-scan-library-catalogs | |
5050 | "Loading and normalizing library catalogs...")) | |
05a1abfc CD |
5051 | (run-hooks 'idlwave-after-load-rinfo-hook)) |
5052 | ||
f32b3b91 CD |
5053 | |
5054 | (defun idlwave-update-buffer-routine-info () | |
5055 | (let (res) | |
4b1aaa8b | 5056 | (cond |
15e42531 CD |
5057 | ((eq idlwave-scan-all-buffers-for-routine-info t) |
5058 | ;; Scan all buffers, current buffer last | |
5059 | (message "Scanning all buffers...") | |
4b1aaa8b | 5060 | (setq res (idlwave-get-routine-info-from-buffers |
15e42531 CD |
5061 | (reverse (buffer-list))))) |
5062 | ((null idlwave-scan-all-buffers-for-routine-info) | |
5063 | ;; Don't scan any buffers | |
5064 | (setq res nil)) | |
5065 | (t | |
f32b3b91 | 5066 | ;; Just scan this buffer |
175069ef | 5067 | (if (derived-mode-p 'idlwave-mode) |
f32b3b91 CD |
5068 | (progn |
5069 | (message "Scanning current buffer...") | |
5070 | (setq res (idlwave-get-routine-info-from-buffers | |
15e42531 | 5071 | (list (current-buffer)))))))) |
f32b3b91 | 5072 | ;; Put the result into the correct variable |
4b1aaa8b | 5073 | (setq idlwave-buffer-routines |
52a244eb | 5074 | (idlwave-sintern-rinfo-list res 'set)))) |
f32b3b91 | 5075 | |
05a1abfc | 5076 | (defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook) |
f32b3b91 | 5077 | "Put the different sources for routine information together." |
4b1aaa8b | 5078 | ;; The sequence here is important because earlier definitions shadow |
f32b3b91 | 5079 | ;; later ones. We assume that if things in the buffers are newer |
52a244eb | 5080 | ;; then in the shell of the system, they are meant to be different. |
15e42531 CD |
5081 | (setcdr idlwave-last-system-routine-info-cons-cell |
5082 | (append idlwave-buffer-routines | |
5083 | idlwave-compiled-routines | |
52a244eb S |
5084 | idlwave-library-catalog-routines |
5085 | idlwave-user-catalog-routines)) | |
f32b3b91 | 5086 | (setq idlwave-class-alist nil) |
15e42531 | 5087 | |
f32b3b91 | 5088 | ;; Give a message with information about the number of routines we have. |
15e42531 | 5089 | (unless quiet |
4b1aaa8b | 5090 | (message |
52a244eb | 5091 | "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)" |
15e42531 CD |
5092 | (length idlwave-buffer-routines) |
5093 | (length idlwave-compiled-routines) | |
52a244eb S |
5094 | (length idlwave-library-catalog-routines) |
5095 | (length idlwave-user-catalog-routines) | |
05a1abfc CD |
5096 | (length idlwave-system-routines))) |
5097 | (if run-hook | |
5098 | (run-hooks 'idlwave-update-rinfo-hook))) | |
15e42531 CD |
5099 | |
5100 | (defun idlwave-class-alist () | |
5101 | "Return the class alist - make it if necessary." | |
5102 | (or idlwave-class-alist | |
5103 | (let (class) | |
5104 | (loop for x in idlwave-routines do | |
5105 | (when (and (setq class (nth 2 x)) | |
5106 | (not (assq class idlwave-class-alist))) | |
5107 | (push (list class) idlwave-class-alist))) | |
4b1aaa8b | 5108 | idlwave-class-alist))) |
15e42531 CD |
5109 | |
5110 | ;; Three functions for the hooks | |
5111 | (defun idlwave-save-buffer-update () | |
5112 | (idlwave-update-current-buffer-info 'save-buffer)) | |
5113 | (defun idlwave-kill-buffer-update () | |
5114 | (idlwave-update-current-buffer-info 'kill-buffer)) | |
5115 | (defun idlwave-new-buffer-update () | |
5116 | (idlwave-update-current-buffer-info 'find-file)) | |
5117 | ||
5118 | (defun idlwave-update-current-buffer-info (why) | |
5a0c3f56 JB |
5119 | "Update `idlwave-routines' for current buffer. |
5120 | Can run from `after-save-hook'." | |
175069ef | 5121 | (when (and (derived-mode-p 'idlwave-mode) |
15e42531 CD |
5122 | (or (eq t idlwave-auto-routine-info-updates) |
5123 | (memq why idlwave-auto-routine-info-updates)) | |
5124 | idlwave-scan-all-buffers-for-routine-info | |
5125 | idlwave-routines) | |
5126 | (condition-case nil | |
5127 | (let (routines) | |
5128 | (idlwave-replace-buffer-routine-info | |
5129 | (buffer-file-name) | |
5130 | (if (eq why 'kill-buffer) | |
5131 | nil | |
5132 | (setq routines | |
5133 | (idlwave-sintern-rinfo-list | |
5134 | (idlwave-get-routine-info-from-buffers | |
5135 | (list (current-buffer))) 'set)))) | |
5136 | (idlwave-concatenate-rinfo-lists 'quiet) | |
5137 | routines) | |
5138 | (error nil)))) | |
5139 | ||
5140 | (defun idlwave-replace-buffer-routine-info (file new) | |
5141 | "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." | |
4b1aaa8b | 5142 | (let ((list idlwave-buffer-routines) |
15e42531 CD |
5143 | found) |
5144 | (while list | |
5145 | ;; The following test uses eq to make sure it works correctly | |
5146 | ;; when two buffers visit the same file. Then the file names | |
5147 | ;; will be equal, but not eq. | |
52a244eb | 5148 | (if (eq (idlwave-routine-source-file (nth 3 (car list))) file) |
15e42531 CD |
5149 | (progn |
5150 | (setcar list nil) | |
5151 | (setq found t)) | |
5152 | (if found | |
4b1aaa8b | 5153 | ;; End of that section reached. Jump. |
15e42531 CD |
5154 | (setq list nil))) |
5155 | (setq list (cdr list))) | |
5156 | (setq idlwave-buffer-routines | |
5157 | (append new (delq nil idlwave-buffer-routines))))) | |
f32b3b91 CD |
5158 | |
5159 | ;;----- Scanning buffers ------------------- | |
5160 | ||
5161 | (defun idlwave-get-routine-info-from-buffers (buffers) | |
5162 | "Call `idlwave-get-buffer-routine-info' on idlwave-mode buffers in BUFFERS." | |
5163 | (let (buf routine-lists res) | |
5164 | (save-excursion | |
5165 | (while (setq buf (pop buffers)) | |
5166 | (set-buffer buf) | |
175069ef | 5167 | (if (and (derived-mode-p 'idlwave-mode) |
05a1abfc | 5168 | buffer-file-name) |
f32b3b91 CD |
5169 | ;; yes, this buffer has the right mode. |
5170 | (progn (setq res (condition-case nil | |
5171 | (idlwave-get-buffer-routine-info) | |
5172 | (error nil))) | |
5173 | (push res routine-lists))))) | |
5174 | ;; Concatenate the individual lists and return the result | |
5175 | (apply 'nconc routine-lists))) | |
5176 | ||
5177 | (defun idlwave-get-buffer-routine-info () | |
5178 | "Scan the current buffer for routine info. Return (PRO-LIST FUNC-LIST)." | |
5179 | (let* ((case-fold-search t) | |
5180 | routine-list string entry) | |
5181 | (save-excursion | |
5182 | (save-restriction | |
5183 | (widen) | |
5184 | (goto-char (point-min)) | |
4b1aaa8b | 5185 | (while (re-search-forward |
15e42531 | 5186 | "^[ \t]*\\(pro\\|function\\)[ \t]" nil t) |
76959b77 | 5187 | (setq string (buffer-substring-no-properties |
f32b3b91 | 5188 | (match-beginning 0) |
4b1aaa8b | 5189 | (progn |
f32b3b91 CD |
5190 | (idlwave-end-of-statement) |
5191 | (point)))) | |
5192 | (setq entry (idlwave-parse-definition string)) | |
5193 | (push entry routine-list)))) | |
5194 | routine-list)) | |
5195 | ||
15e42531 | 5196 | (defvar idlwave-scanning-lib-dir) |
8d222148 | 5197 | (defvar idlwave-scanning-lib) |
f32b3b91 CD |
5198 | (defun idlwave-parse-definition (string) |
5199 | "Parse a module definition." | |
5200 | (let ((case-fold-search t) | |
5201 | start name args type keywords class) | |
5202 | ;; Remove comments | |
5203 | (while (string-match ";.*" string) | |
5204 | (setq string (replace-match "" t t string))) | |
5205 | ;; Remove the continuation line stuff | |
5206 | (while (string-match "\\([^a-zA-Z0-9$_]\\)\\$[ \t]*\n" string) | |
5207 | (setq string (replace-match "\\1 " t nil string))) | |
05a1abfc CD |
5208 | (while (string-match "\n" string) |
5209 | (setq string (replace-match " " t nil string))) | |
f32b3b91 CD |
5210 | ;; Match the name and type. |
5211 | (when (string-match | |
5212 | "\\<\\(pro\\|function\\)\\>\\s-+\\(\\([a-zA-Z0-9$_]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)" string) | |
5213 | (setq start (match-end 0)) | |
5214 | (setq type (downcase (match-string 1 string))) | |
5215 | (if (match-beginning 3) | |
5216 | (setq class (match-string 3 string))) | |
5217 | (setq name (match-string 4 string))) | |
5218 | ;; Match normal args and keyword args | |
5219 | (while (string-match | |
15e42531 | 5220 | ",\\s-*\\([a-zA-Z][a-zA-Z0-9$_]*\\|\\(_ref\\)?_extra\\)\\s-*\\(=\\)?" |
f32b3b91 CD |
5221 | string start) |
5222 | (setq start (match-end 0)) | |
15e42531 | 5223 | (if (match-beginning 3) |
f32b3b91 CD |
5224 | (push (match-string 1 string) keywords) |
5225 | (push (match-string 1 string) args))) | |
5226 | ;; Normalize and sort. | |
5227 | (setq args (nreverse args)) | |
4b1aaa8b | 5228 | (setq keywords (sort keywords (lambda (a b) |
f32b3b91 CD |
5229 | (string< (downcase a) (downcase b))))) |
5230 | ;; Make and return the entry | |
5231 | ;; We don't know which argument are optional, so this information | |
5232 | ;; will not be contained in the calling sequence. | |
5233 | (list name | |
5234 | (if (equal type "pro") 'pro 'fun) | |
5235 | class | |
5236 | (cond ((not (boundp 'idlwave-scanning-lib)) | |
52a244eb | 5237 | (list 'buffer (buffer-file-name))) |
4b1aaa8b | 5238 | ; ((string= (downcase |
15e42531 CD |
5239 | ; (file-name-sans-extension |
5240 | ; (file-name-nondirectory (buffer-file-name)))) | |
5241 | ; (downcase name)) | |
5242 | ; (list 'lib)) | |
5243 | ; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) | |
52a244eb S |
5244 | (t (list 'user (file-name-nondirectory (buffer-file-name)) |
5245 | idlwave-scanning-lib-dir "UserLib"))) | |
4b1aaa8b | 5246 | (concat |
f32b3b91 CD |
5247 | (if (string= type "function") "Result = " "") |
5248 | (if class "Obj ->[%s::]" "") | |
5249 | "%s" | |
5250 | (if args | |
5251 | (concat | |
5252 | (if (string= type "function") "(" ", ") | |
5253 | (mapconcat 'identity args ", ") | |
5254 | (if (string= type "function") ")" "")))) | |
5255 | (if keywords | |
52a244eb | 5256 | (cons nil (mapcar 'list keywords)) ;No help file |
f32b3b91 CD |
5257 | nil)))) |
5258 | ||
f32b3b91 | 5259 | |
52a244eb | 5260 | ;;----- Scanning the user catalog ------------------- |
15e42531 CD |
5261 | |
5262 | (defun idlwave-sys-dir () | |
5263 | "Return the syslib directory, or a dummy that never matches." | |
3938cb82 S |
5264 | (cond |
5265 | ((and idlwave-system-directory | |
5266 | (not (string= idlwave-system-directory ""))) | |
5267 | idlwave-system-directory) | |
5268 | ((getenv "IDL_DIR")) | |
5269 | (t "@@@@@@@@"))) | |
5270 | ||
52a244eb | 5271 | |
52a244eb | 5272 | (defun idlwave-create-user-catalog-file (&optional arg) |
f32b3b91 | 5273 | "Scan all files on selected dirs of IDL search path for routine information. |
52a244eb S |
5274 | |
5275 | A widget checklist will allow you to choose the directories. Write | |
5276 | the result as a file `idlwave-user-catalog-file'. When this file | |
5a0c3f56 JB |
5277 | exists, it will be automatically loaded to give routine information |
5278 | about library routines. With ARG, just rescan the same directories | |
5279 | as last time - so no widget will pop up." | |
f32b3b91 CD |
5280 | (interactive "P") |
5281 | ;; Make sure the file is loaded if it exists. | |
52a244eb S |
5282 | (if (and (stringp idlwave-user-catalog-file) |
5283 | (file-regular-p idlwave-user-catalog-file)) | |
f32b3b91 | 5284 | (condition-case nil |
52a244eb | 5285 | (load-file idlwave-user-catalog-file) |
f32b3b91 CD |
5286 | (error nil))) |
5287 | ;; Make sure the file name makes sense | |
52a244eb S |
5288 | (unless (and (stringp idlwave-user-catalog-file) |
5289 | (> (length idlwave-user-catalog-file) 0) | |
f32b3b91 | 5290 | (file-accessible-directory-p |
52a244eb | 5291 | (file-name-directory idlwave-user-catalog-file)) |
4b1aaa8b | 5292 | (not (string= "" (file-name-nondirectory |
52a244eb S |
5293 | idlwave-user-catalog-file)))) |
5294 | (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory")) | |
4b1aaa8b | 5295 | |
f32b3b91 | 5296 | (cond |
f32b3b91 | 5297 | ;; Rescan the known directories |
52a244eb S |
5298 | ((and arg idlwave-path-alist |
5299 | (consp (car idlwave-path-alist))) | |
5300 | (idlwave-scan-user-lib-files idlwave-path-alist)) | |
5301 | ||
5302 | ;; Expand the directories from library-path and run the widget | |
f32b3b91 | 5303 | (idlwave-library-path |
52a244eb | 5304 | (idlwave-display-user-catalog-widget |
4b1aaa8b | 5305 | (if idlwave-true-path-alist |
52a244eb S |
5306 | ;; Propagate any flags on the existing path-alist |
5307 | (mapcar (lambda (x) | |
5308 | (let ((path-entry (assoc (file-truename x) | |
5309 | idlwave-true-path-alist))) | |
5310 | (if path-entry | |
4b1aaa8b | 5311 | (cons x (cdr path-entry)) |
52a244eb S |
5312 | (list x)))) |
5313 | (idlwave-expand-path idlwave-library-path)) | |
5314 | (mapcar 'list (idlwave-expand-path idlwave-library-path))))) | |
5315 | ||
5316 | ;; Ask the shell for the path and then run the widget | |
f32b3b91 | 5317 | (t |
f32b3b91 | 5318 | (message "Asking the shell for IDL path...") |
15e42531 CD |
5319 | (require 'idlw-shell) |
5320 | (idlwave-shell-send-command idlwave-shell-path-query | |
52a244eb | 5321 | '(idlwave-user-catalog-command-hook nil) |
15e42531 | 5322 | 'hide)))) |
f32b3b91 | 5323 | |
52a244eb S |
5324 | |
5325 | ;; Parse shell path information and select among it. | |
5326 | (defun idlwave-user-catalog-command-hook (&optional arg) | |
5327 | ;; Command hook used by `idlwave-create-user-catalog-file'. | |
f32b3b91 CD |
5328 | (if arg |
5329 | ;; Scan immediately | |
52a244eb S |
5330 | (idlwave-scan-user-lib-files idlwave-path-alist) |
5331 | ;; Set the path and display the widget | |
5332 | (idlwave-shell-get-path-info 'no-write) ; set to something path-alist | |
5333 | (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load) | |
5334 | (idlwave-display-user-catalog-widget idlwave-path-alist))) | |
5335 | ||
4b1aaa8b | 5336 | (defconst idlwave-user-catalog-widget-help-string |
52a244eb S |
5337 | "This is the front-end to the creation of the IDLWAVE user catalog. |
5338 | Please select the directories on IDL's search path from which you | |
5339 | would like to extract routine information, to be stored in the file: | |
f32b3b91 CD |
5340 | |
5341 | %s | |
5342 | ||
52a244eb S |
5343 | If this is not the correct file, first set variable |
5344 | `idlwave-user-catalog-file', and call this command again. | |
15e42531 | 5345 | |
52a244eb S |
5346 | N.B. Many libraries include pre-scanned catalog files |
5347 | \(\".idlwave_catalog\"). These are marked with \"[LIB]\", and need | |
5348 | not be scanned. You can scan your own libraries off-line using the | |
5349 | perl script `idlwave_catalog'. | |
15e42531 | 5350 | |
f32b3b91 CD |
5351 | After selecting the directories, choose [Scan & Save] to scan the library |
5352 | directories and save the routine info. | |
5353 | \n") | |
5354 | ||
5355 | (defvar idlwave-widget) | |
5356 | (defvar widget-keymap) | |
52a244eb | 5357 | (defun idlwave-display-user-catalog-widget (dirs-list) |
f32b3b91 CD |
5358 | "Create the widget to select IDL search path directories for scanning." |
5359 | (interactive) | |
5360 | (require 'widget) | |
5361 | (require 'wid-edit) | |
52a244eb | 5362 | (unless dirs-list |
f32b3b91 CD |
5363 | (error "Don't know IDL's search path")) |
5364 | ||
f32b3b91 CD |
5365 | (kill-buffer (get-buffer-create "*IDLWAVE Widget*")) |
5366 | (switch-to-buffer (get-buffer-create "*IDLWAVE Widget*")) | |
5367 | (kill-all-local-variables) | |
5368 | (make-local-variable 'idlwave-widget) | |
52a244eb S |
5369 | (widget-insert (format idlwave-user-catalog-widget-help-string |
5370 | idlwave-user-catalog-file)) | |
4b1aaa8b | 5371 | |
f32b3b91 | 5372 | (widget-create 'push-button |
52a244eb | 5373 | :notify 'idlwave-widget-scan-user-lib-files |
f32b3b91 CD |
5374 | "Scan & Save") |
5375 | (widget-insert " ") | |
5376 | (widget-create 'push-button | |
52a244eb | 5377 | :notify 'idlwave-delete-user-catalog-file |
f32b3b91 CD |
5378 | "Delete File") |
5379 | (widget-insert " ") | |
5380 | (widget-create 'push-button | |
4b1aaa8b | 5381 | :notify |
8d222148 SM |
5382 | (lambda (&rest ignore) |
5383 | (let ((path-list (widget-get idlwave-widget :path-dirs))) | |
5384 | (dolist (x path-list) | |
5385 | (unless (memq 'lib (cdr x)) | |
5386 | (idlwave-path-alist-add-flag x 'user))) | |
5387 | (idlwave-display-user-catalog-widget path-list))) | |
52a244eb | 5388 | "Select All Non-Lib") |
f32b3b91 CD |
5389 | (widget-insert " ") |
5390 | (widget-create 'push-button | |
4b1aaa8b | 5391 | :notify |
8d222148 SM |
5392 | (lambda (&rest ignore) |
5393 | (let ((path-list (widget-get idlwave-widget :path-dirs))) | |
5394 | (dolist (x path-list) | |
5395 | (idlwave-path-alist-remove-flag x 'user)) | |
5396 | (idlwave-display-user-catalog-widget path-list))) | |
f32b3b91 | 5397 | "Deselect All") |
52a244eb S |
5398 | (widget-insert " ") |
5399 | (widget-create 'push-button | |
5400 | :notify (lambda (&rest ignore) | |
5401 | (kill-buffer (current-buffer))) | |
5402 | "Quit") | |
f32b3b91 CD |
5403 | (widget-insert "\n\n") |
5404 | ||
52a244eb | 5405 | (widget-insert "Select Directories: \n") |
4b1aaa8b | 5406 | |
f32b3b91 CD |
5407 | (setq idlwave-widget |
5408 | (apply 'widget-create | |
5409 | 'checklist | |
4b1aaa8b PE |
5410 | :value (delq nil (mapcar (lambda (x) |
5411 | (if (memq 'user (cdr x)) | |
52a244eb S |
5412 | (car x))) |
5413 | dirs-list)) | |
f32b3b91 CD |
5414 | :greedy t |
5415 | :tag "List of directories" | |
4b1aaa8b PE |
5416 | (mapcar (lambda (x) |
5417 | (list 'item | |
52a244eb S |
5418 | (if (memq 'lib (cdr x)) |
5419 | (concat "[LIB] " (car x) ) | |
5420 | (car x)))) dirs-list))) | |
5421 | (widget-put idlwave-widget :path-dirs dirs-list) | |
f32b3b91 CD |
5422 | (widget-insert "\n") |
5423 | (use-local-map widget-keymap) | |
5424 | (widget-setup) | |
5425 | (goto-char (point-min)) | |
5426 | (delete-other-windows)) | |
4b1aaa8b | 5427 | |
52a244eb | 5428 | (defun idlwave-delete-user-catalog-file (&rest ignore) |
f32b3b91 | 5429 | (if (yes-or-no-p |
52a244eb | 5430 | (format "Delete file %s " idlwave-user-catalog-file)) |
f32b3b91 | 5431 | (progn |
52a244eb S |
5432 | (delete-file idlwave-user-catalog-file) |
5433 | (message "%s has been deleted" idlwave-user-catalog-file)))) | |
f32b3b91 | 5434 | |
52a244eb S |
5435 | (defun idlwave-widget-scan-user-lib-files (&rest ignore) |
5436 | ;; Call `idlwave-scan-user-lib-files' with data taken from the widget. | |
f32b3b91 | 5437 | (let* ((widget idlwave-widget) |
15e42531 | 5438 | (selected-dirs (widget-value widget)) |
52a244eb S |
5439 | (path-alist (widget-get widget :path-dirs)) |
5440 | (this-path-alist path-alist) | |
5441 | dir-entry) | |
5442 | (while (setq dir-entry (pop this-path-alist)) | |
4b1aaa8b | 5443 | (if (member |
52a244eb S |
5444 | (if (memq 'lib (cdr dir-entry)) |
5445 | (concat "[LIB] " (car dir-entry)) | |
5446 | (car dir-entry)) | |
5447 | selected-dirs) | |
5448 | (idlwave-path-alist-add-flag dir-entry 'user) | |
5449 | (idlwave-path-alist-remove-flag dir-entry 'user))) | |
5450 | (idlwave-scan-user-lib-files path-alist))) | |
f32b3b91 CD |
5451 | |
5452 | (defvar font-lock-mode) | |
52a244eb S |
5453 | (defun idlwave-scan-user-lib-files (path-alist) |
5454 | ;; Scan the PRO files in PATH-ALIST and store the info in the user catalog | |
f32b3b91 | 5455 | (let* ((idlwave-scanning-lib t) |
15e42531 | 5456 | (idlwave-scanning-lib-dir "") |
f32b3b91 | 5457 | (idlwave-completion-case nil) |
15e42531 | 5458 | dirs-alist dir files file) |
52a244eb S |
5459 | (setq idlwave-user-catalog-routines nil |
5460 | idlwave-path-alist path-alist ; for library-path instead | |
5461 | idlwave-true-path-alist nil) | |
5462 | (if idlwave-auto-write-paths (idlwave-write-paths)) | |
9a529312 | 5463 | (with-current-buffer (get-buffer-create "*idlwave-scan.pro*") |
f32b3b91 | 5464 | (idlwave-mode) |
15e42531 CD |
5465 | (setq dirs-alist (reverse path-alist)) |
5466 | (while (setq dir (pop dirs-alist)) | |
52a244eb | 5467 | (when (memq 'user (cdr dir)) ; Has it marked for scan? |
15e42531 | 5468 | (setq dir (car dir)) |
52a244eb | 5469 | (setq idlwave-scanning-lib-dir dir) |
15e42531 CD |
5470 | (when (file-directory-p dir) |
5471 | (setq files (directory-files dir 'full "\\.[pP][rR][oO]\\'")) | |
5472 | (while (setq file (pop files)) | |
5473 | (when (file-regular-p file) | |
5474 | (if (not (file-readable-p file)) | |
5475 | (message "Skipping %s (no read permission)" file) | |
5476 | (message "Scanning %s..." file) | |
5477 | (erase-buffer) | |
5478 | (insert-file-contents file 'visit) | |
52a244eb | 5479 | (setq idlwave-user-catalog-routines |
15e42531 CD |
5480 | (append (idlwave-get-routine-info-from-buffers |
5481 | (list (current-buffer))) | |
52a244eb S |
5482 | idlwave-user-catalog-routines))))))))) |
5483 | (message "Creating user catalog file...") | |
f32b3b91 CD |
5484 | (kill-buffer "*idlwave-scan.pro*") |
5485 | (kill-buffer (get-buffer-create "*IDLWAVE Widget*")) | |
15e42531 CD |
5486 | (let ((font-lock-maximum-size 0) |
5487 | (auto-mode-alist nil)) | |
52a244eb | 5488 | (find-file idlwave-user-catalog-file)) |
f32b3b91 CD |
5489 | (if (and (boundp 'font-lock-mode) |
5490 | font-lock-mode) | |
5491 | (font-lock-mode 0)) | |
5492 | (erase-buffer) | |
52a244eb | 5493 | (insert ";; IDLWAVE user catalog file\n") |
f32b3b91 CD |
5494 | (insert (format ";; Created %s\n\n" (current-time-string))) |
5495 | ||
f32b3b91 | 5496 | ;; Define the routine info list |
52a244eb | 5497 | (insert "\n(setq idlwave-user-catalog-routines\n '(") |
5e72c6b2 | 5498 | (let ((standard-output (current-buffer))) |
8ffcfb27 GM |
5499 | (mapc (lambda (x) |
5500 | (insert "\n ") | |
5501 | (prin1 x) | |
5502 | (goto-char (point-max))) | |
5503 | idlwave-user-catalog-routines)) | |
f32b3b91 | 5504 | (insert (format "))\n\n;;; %s ends here\n" |
52a244eb | 5505 | (file-name-nondirectory idlwave-user-catalog-file))) |
f32b3b91 CD |
5506 | (goto-char (point-min)) |
5507 | ;; Save the buffer | |
5508 | (save-buffer 0) | |
5509 | (kill-buffer (current-buffer))) | |
52a244eb | 5510 | (message "Creating user catalog file...done") |
f32b3b91 | 5511 | (message "Info for %d routines saved in %s" |
52a244eb S |
5512 | (length idlwave-user-catalog-routines) |
5513 | idlwave-user-catalog-file) | |
f32b3b91 CD |
5514 | (sit-for 2) |
5515 | (idlwave-update-routine-info t)) | |
5516 | ||
52a244eb S |
5517 | (defun idlwave-read-paths () |
5518 | (if (and (stringp idlwave-path-file) | |
5519 | (file-regular-p idlwave-path-file)) | |
5520 | (condition-case nil | |
5521 | (load idlwave-path-file t t t) | |
5522 | (error nil)))) | |
5523 | ||
5524 | (defun idlwave-write-paths () | |
5525 | (interactive) | |
5526 | (when (and idlwave-path-alist idlwave-system-directory) | |
5527 | (let ((font-lock-maximum-size 0) | |
5528 | (auto-mode-alist nil)) | |
5529 | (find-file idlwave-path-file)) | |
5530 | (if (and (boundp 'font-lock-mode) | |
5531 | font-lock-mode) | |
5532 | (font-lock-mode 0)) | |
5533 | (erase-buffer) | |
5534 | (insert ";; IDLWAVE paths\n") | |
5535 | (insert (format ";; Created %s\n\n" (current-time-string))) | |
5536 | ;; Define the variable which knows the value of "!DIR" | |
5537 | (insert (format "\n(setq idlwave-system-directory \"%s\")\n" | |
5538 | idlwave-system-directory)) | |
4b1aaa8b | 5539 | |
52a244eb S |
5540 | ;; Define the variable which contains a list of all scanned directories |
5541 | (insert "\n(setq idlwave-path-alist\n '(") | |
5542 | (let ((standard-output (current-buffer))) | |
8ffcfb27 GM |
5543 | (mapc (lambda (x) |
5544 | (insert "\n ") | |
5545 | (prin1 x) | |
5546 | (goto-char (point-max))) | |
5547 | idlwave-path-alist)) | |
52a244eb S |
5548 | (insert "))\n") |
5549 | (save-buffer 0) | |
5550 | (kill-buffer (current-buffer)))) | |
5551 | ||
5552 | ||
f32b3b91 CD |
5553 | (defun idlwave-expand-path (path &optional default-dir) |
5554 | ;; Expand parts of path starting with '+' recursively into directory list. | |
5555 | ;; Relative recursive path elements are expanded relative to DEFAULT-DIR. | |
5556 | (message "Expanding path...") | |
5557 | (let (path1 dir recursive) | |
5558 | (while (setq dir (pop path)) | |
5559 | (if (setq recursive (string= (substring dir 0 1) "+")) | |
5560 | (setq dir (substring dir 1))) | |
5561 | (if (and recursive | |
5562 | (not (file-name-absolute-p dir))) | |
5563 | (setq dir (expand-file-name dir default-dir))) | |
5564 | (if recursive | |
5565 | ;; Expand recursively | |
5566 | (setq path1 (append (idlwave-recursive-directory-list dir) path1)) | |
5567 | ;; Keep unchanged | |
5568 | (push dir path1))) | |
5569 | (message "Expanding path...done") | |
5570 | (nreverse path1))) | |
5571 | ||
5572 | (defun idlwave-recursive-directory-list (dir) | |
5573 | ;; Return a list of all directories below DIR, including DIR itself | |
5574 | (let ((path (list dir)) path1 file files) | |
5575 | (while (setq dir (pop path)) | |
5576 | (when (file-directory-p dir) | |
5577 | (setq files (nreverse (directory-files dir t "[^.]"))) | |
5578 | (while (setq file (pop files)) | |
4b1aaa8b | 5579 | (if (file-directory-p file) |
f32b3b91 CD |
5580 | (push (file-name-as-directory file) path))) |
5581 | (push dir path1))) | |
5582 | path1)) | |
5583 | ||
52a244eb S |
5584 | |
5585 | ;;----- Scanning the library catalogs ------------------ | |
5586 | ||
3938cb82 S |
5587 | |
5588 | ||
5589 | ||
52a244eb | 5590 | (defun idlwave-scan-library-catalogs (&optional message-base no-load) |
4b1aaa8b | 5591 | "Scan for library catalog files (.idlwave_catalog) and ingest. |
52a244eb S |
5592 | |
5593 | All directories on `idlwave-path-alist' (or `idlwave-library-path' | |
5594 | instead, if present) are searched. Print MESSAGE-BASE along with the | |
5595 | libraries being loaded, if passed, and skip loading/normalizing if | |
5596 | NO-LOAD is non-nil. The variable `idlwave-use-library-catalogs' can | |
5597 | be set to nil to disable library catalog scanning." | |
5598 | (when idlwave-use-library-catalogs | |
4b1aaa8b | 5599 | (let ((dirs |
52a244eb S |
5600 | (if idlwave-library-path |
5601 | (idlwave-expand-path idlwave-library-path) | |
5602 | (mapcar 'car idlwave-path-alist))) | |
5603 | (old-libname "") | |
8d222148 | 5604 | dir-entry dir catalog all-routines) |
52a244eb S |
5605 | (if message-base (message message-base)) |
5606 | (while (setq dir (pop dirs)) | |
5607 | (catch 'continue | |
4b1aaa8b | 5608 | (when (file-readable-p |
52a244eb S |
5609 | (setq catalog (expand-file-name ".idlwave_catalog" dir))) |
5610 | (unless no-load | |
5611 | (setq idlwave-library-catalog-routines nil) | |
5612 | ;; Load the catalog file | |
5613 | (condition-case nil | |
5614 | (load catalog t t t) | |
5615 | (error (throw 'continue t))) | |
4b1aaa8b PE |
5616 | (when (and |
5617 | message-base | |
5618 | (not (string= idlwave-library-catalog-libname | |
52a244eb | 5619 | old-libname))) |
4b1aaa8b | 5620 | (message "%s" (concat message-base |
f66f03de | 5621 | idlwave-library-catalog-libname)) |
52a244eb S |
5622 | (setq old-libname idlwave-library-catalog-libname)) |
5623 | (when idlwave-library-catalog-routines | |
5624 | (setq all-routines | |
4b1aaa8b | 5625 | (append |
52a244eb S |
5626 | (idlwave-sintern-rinfo-list |
5627 | idlwave-library-catalog-routines 'sys dir) | |
5628 | all-routines)))) | |
4b1aaa8b | 5629 | |
52a244eb S |
5630 | ;; Add a 'lib flag if on path-alist |
5631 | (when (and idlwave-path-alist | |
5632 | (setq dir-entry (assoc dir idlwave-path-alist))) | |
5633 | (idlwave-path-alist-add-flag dir-entry 'lib))))) | |
5634 | (unless no-load (setq idlwave-library-catalog-routines all-routines)) | |
5635 | (if message-base (message (concat message-base "done")))))) | |
5636 | ||
5637 | ;;----- Communicating with the Shell ------------------- | |
f32b3b91 CD |
5638 | |
5639 | ;; First, here is the idl program which can be used to query IDL for | |
4b1aaa8b | 5640 | ;; defined routines. |
f32b3b91 CD |
5641 | (defconst idlwave-routine-info.pro |
5642 | " | |
05a1abfc | 5643 | ;; START OF IDLWAVE SUPPORT ROUTINES |
f66f03de S |
5644 | pro idlwave_print_safe,item,limit |
5645 | catch,err | |
5646 | if err ne 0 then begin | |
5647 | print,'Could not print item.' | |
5648 | return | |
5649 | endif | |
5650 | if n_elements(item) gt limit then $ | |
5651 | print,item[0:limit-1],'<... truncated at ',strtrim(limit,2),' elements>' $ | |
5652 | else print,item | |
5653 | end | |
5654 | ||
15e42531 | 5655 | pro idlwave_print_info_entry,name,func=func,separator=sep |
f32b3b91 | 5656 | ;; See if it's an object method |
15e42531 | 5657 | if name eq '' then return |
4b1aaa8b | 5658 | func = keyword_set(func) |
f32b3b91 CD |
5659 | methsep = strpos(name,'::') |
5660 | meth = methsep ne -1 | |
4b1aaa8b | 5661 | |
f32b3b91 CD |
5662 | ;; Get routine info |
5663 | pars = routine_info(name,/parameters,functions=func) | |
5664 | source = routine_info(name,/source,functions=func) | |
5665 | nargs = pars.num_args | |
5666 | nkw = pars.num_kw_args | |
5667 | if nargs gt 0 then args = pars.args | |
5668 | if nkw gt 0 then kwargs = pars.kw_args | |
4b1aaa8b | 5669 | |
f32b3b91 | 5670 | ;; Trim the class, and make the name |
4b1aaa8b | 5671 | if meth then begin |
f32b3b91 CD |
5672 | class = strmid(name,0,methsep) |
5673 | name = strmid(name,methsep+2,strlen(name)-1) | |
4b1aaa8b | 5674 | if nargs gt 0 then begin |
f32b3b91 CD |
5675 | ;; remove the self argument |
5676 | wh = where(args ne 'SELF',nargs) | |
52a244eb | 5677 | if nargs gt 0 then args = args[wh] |
f32b3b91 CD |
5678 | endif |
5679 | endif else begin | |
5680 | ;; No class, just a normal routine. | |
5681 | class = \"\" | |
5682 | endelse | |
4b1aaa8b | 5683 | |
f32b3b91 CD |
5684 | ;; Calling sequence |
5685 | cs = \"\" | |
5686 | if func then cs = 'Result = ' | |
5687 | if meth then cs = cs + 'Obj -> [' + '%s' + '::]' | |
5688 | cs = cs + '%s' | |
5689 | if func then cs = cs + '(' else if nargs gt 0 then cs = cs + ', ' | |
5690 | if nargs gt 0 then begin | |
5691 | for j=0,nargs-1 do begin | |
52a244eb | 5692 | cs = cs + args[j] |
f32b3b91 CD |
5693 | if j lt nargs-1 then cs = cs + ', ' |
5694 | endfor | |
5695 | end | |
5696 | if func then cs = cs + ')' | |
5697 | ;; Keyword arguments | |
5698 | kwstring = '' | |
5699 | if nkw gt 0 then begin | |
5700 | for j=0,nkw-1 do begin | |
52a244eb | 5701 | kwstring = kwstring + ' ' + kwargs[j] |
f32b3b91 CD |
5702 | endfor |
5703 | endif | |
4b1aaa8b | 5704 | |
52a244eb | 5705 | ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func] |
4b1aaa8b | 5706 | |
52a244eb | 5707 | print,ret + ': ' + name + sep + class + sep + source[0].path $ |
f32b3b91 CD |
5708 | + sep + cs + sep + kwstring |
5709 | end | |
5710 | ||
f66f03de | 5711 | pro idlwave_routine_info,file |
52a244eb | 5712 | on_error,1 |
f32b3b91 CD |
5713 | sep = '<@>' |
5714 | print,'>>>BEGIN OF IDLWAVE ROUTINE INFO (\"' + sep + '\" IS THE SEPARATOR)' | |
5715 | all = routine_info() | |
f66f03de S |
5716 | fileQ=n_elements(file) ne 0 |
5717 | if fileQ then file=strtrim(file,2) | |
4b1aaa8b PE |
5718 | for i=0L,n_elements(all)-1L do begin |
5719 | if fileQ then begin | |
f66f03de S |
5720 | if (routine_info(all[i],/SOURCE)).path eq file then $ |
5721 | idlwave_print_info_entry,all[i],separator=sep | |
5722 | endif else idlwave_print_info_entry,all[i],separator=sep | |
4b1aaa8b | 5723 | endfor |
f32b3b91 | 5724 | all = routine_info(/functions) |
4b1aaa8b PE |
5725 | for i=0L,n_elements(all)-1L do begin |
5726 | if fileQ then begin | |
f66f03de S |
5727 | if (routine_info(all[i],/FUNCTIONS,/SOURCE)).path eq file then $ |
5728 | idlwave_print_info_entry,all[i],separator=sep,/FUNC | |
5729 | endif else idlwave_print_info_entry,all[i],separator=sep,/FUNC | |
4b1aaa8b | 5730 | endfor |
f32b3b91 CD |
5731 | print,'>>>END OF IDLWAVE ROUTINE INFO' |
5732 | end | |
05a1abfc CD |
5733 | |
5734 | pro idlwave_get_sysvars | |
52a244eb | 5735 | on_error,1 |
05a1abfc CD |
5736 | catch,error_status |
5737 | if error_status ne 0 then begin | |
5738 | print, 'Cannot get info about system variables' | |
5739 | endif else begin | |
5740 | help,/brief,output=s,/system_variables ; ? unsafe use of OUTPUT= | |
5741 | s = strtrim(strjoin(s,' ',/single),2) ; make one line | |
5742 | v = strsplit(s,' +',/regex,/extract) ; get variables | |
f66f03de | 5743 | for i=0L,n_elements(v)-1 do begin |
05a1abfc CD |
5744 | t = [''] ; get tag list |
5745 | a=execute('if n_tags('+v[i]+') gt 0 then t=tag_names('+v[i]+')') | |
5746 | print, 'IDLWAVE-SYSVAR: '+v[i]+' '+strjoin(t,' ',/single) | |
5747 | endfor | |
5748 | endelse | |
5749 | end | |
5750 | ||
5751 | pro idlwave_get_class_tags, class | |
5752 | res = execute('tags=tag_names({'+class+'})') | |
5e72c6b2 | 5753 | if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single) |
05a1abfc CD |
5754 | end |
5755 | ;; END OF IDLWAVE SUPPORT ROUTINES | |
4b1aaa8b | 5756 | " |
5a0c3f56 | 5757 | "The IDL programs to get info from the shell.") |
f32b3b91 | 5758 | |
15e42531 | 5759 | (defvar idlwave-idlwave_routine_info-compiled nil |
5a0c3f56 | 5760 | "Remember if the routine info procedure is already compiled.") |
f32b3b91 CD |
5761 | |
5762 | (defvar idlwave-shell-temp-pro-file) | |
15e42531 | 5763 | (defvar idlwave-shell-temp-rinfo-save-file) |
f66f03de S |
5764 | |
5765 | (defun idlwave-shell-compile-helper-routines (&optional wait) | |
15e42531 | 5766 | (unless (and idlwave-idlwave_routine_info-compiled |
5e72c6b2 | 5767 | (file-readable-p (idlwave-shell-temp-file 'rinfo))) |
9a529312 SM |
5768 | (with-current-buffer (idlwave-find-file-noselect |
5769 | (idlwave-shell-temp-file 'pro)) | |
15e42531 CD |
5770 | (erase-buffer) |
5771 | (insert idlwave-routine-info.pro) | |
5772 | (save-buffer 0)) | |
4b1aaa8b | 5773 | (idlwave-shell-send-command |
f66f03de | 5774 | (concat ".run \"" idlwave-shell-temp-pro-file "\"") |
52a244eb | 5775 | nil 'hide wait) |
15e42531 | 5776 | (idlwave-shell-send-command |
4b1aaa8b | 5777 | (format "save,'idlwave_print_safe','idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" |
5e72c6b2 | 5778 | (idlwave-shell-temp-file 'rinfo)) |
f66f03de S |
5779 | nil 'hide) |
5780 | (setq idlwave-idlwave_routine_info-compiled t)) | |
15e42531 | 5781 | |
f66f03de | 5782 | ;; Restore if necessary. Must use execute to hide lame routine_info |
cd1181db | 5783 | ;; errors on undefined routine |
15e42531 | 5784 | (idlwave-shell-send-command |
f66f03de S |
5785 | (format "if execute(\"_v=routine_info('idlwave_routine_info',/SOURCE)\") eq 0 then restore,'%s' else if _v.path eq '' then restore,'%s'" |
5786 | idlwave-shell-temp-rinfo-save-file | |
15e42531 | 5787 | idlwave-shell-temp-rinfo-save-file) |
f66f03de S |
5788 | nil 'hide)) |
5789 | ||
5790 | ||
5791 | (defun idlwave-shell-update-routine-info (&optional quiet run-hooks wait file) | |
5792 | "Query the shell for routine_info of compiled modules and update the lists." | |
5793 | ;; Save and compile the procedure. The compiled procedure is then | |
5794 | ;; saved into an IDL SAVE file, to allow for fast RESTORE. We may | |
5795 | ;; need to test for and possibly RESTORE the procedure each time we | |
5796 | ;; use it, since the user may have killed or redefined it. In | |
5797 | ;; particular, .RESET_SESSION will kill all user procedures. If | |
5798 | ;; FILE is set, only update routine info for routines in that file. | |
5799 | ||
5800 | (idlwave-shell-compile-helper-routines wait) | |
5801 | ; execute the routine_info procedure, and analyze the output | |
5802 | (idlwave-shell-send-command | |
5803 | (format "idlwave_routine_info%s" (if file (concat ",'" file "'") "")) | |
15e42531 CD |
5804 | `(progn |
5805 | (idlwave-shell-routine-info-filter) | |
05a1abfc | 5806 | (idlwave-concatenate-rinfo-lists ,quiet ,run-hooks)) |
52a244eb | 5807 | 'hide wait)) |
f32b3b91 CD |
5808 | |
5809 | ;; --------------------------------------------------------------------------- | |
5810 | ;; | |
5811 | ;; Completion and displaying routine calling sequences | |
5812 | ||
15e42531 | 5813 | (defvar idlwave-completion-help-info nil) |
52a244eb | 5814 | (defvar idlwave-completion-help-links nil) |
15e42531 | 5815 | (defvar idlwave-current-obj_new-class nil) |
05a1abfc | 5816 | (defvar idlwave-complete-special nil) |
8d222148 SM |
5817 | (defvar method-selector) |
5818 | (defvar class-selector) | |
5819 | (defvar type-selector) | |
5820 | (defvar super-classes) | |
15e42531 | 5821 | |
f32b3b91 CD |
5822 | (defun idlwave-complete (&optional arg module class) |
5823 | "Complete a function, procedure or keyword name at point. | |
2e8b9c7d | 5824 | This function is smart and figures out what can be completed |
f32b3b91 CD |
5825 | at this point. |
5826 | - At the beginning of a statement it completes procedure names. | |
5827 | - In the middle of a statement it completes function names. | |
5a0c3f56 | 5828 | - After a `(' or `,' in the argument list of a function or procedure, |
f32b3b91 CD |
5829 | it completes a keyword of the relevant function or procedure. |
5830 | - In the first arg of `OBJ_NEW', it completes a class name. | |
5831 | ||
5a0c3f56 JB |
5832 | When several completions are possible, a list will be displayed in |
5833 | the *Completions* buffer. If this list is too long to fit into the | |
5e72c6b2 S |
5834 | window, scrolling can be achieved by repeatedly pressing |
5835 | \\[idlwave-complete]. | |
f32b3b91 CD |
5836 | |
5837 | The function also knows about object methods. When it needs a class | |
5838 | name, the action depends upon `idlwave-query-class', which see. You | |
5e72c6b2 S |
5839 | can force IDLWAVE to ask you for a class name with a |
5840 | \\[universal-argument] prefix argument to this command. | |
f32b3b91 CD |
5841 | |
5842 | See also the variables `idlwave-keyword-completion-adds-equal' and | |
5843 | `idlwave-function-completion-adds-paren'. | |
5844 | ||
5845 | The optional ARG can be used to specify the completion type in order | |
5846 | to override IDLWAVE's idea of what should be completed at point. | |
5847 | Possible values are: | |
5848 | ||
5849 | 0 <=> query for the completion type | |
5850 | 1 <=> 'procedure | |
5851 | 2 <=> 'procedure-keyword | |
5852 | 3 <=> 'function | |
5853 | 4 <=> 'function-keyword | |
5854 | 5 <=> 'procedure-method | |
5855 | 6 <=> 'procedure-method-keyword | |
5856 | 7 <=> 'function-method | |
5857 | 8 <=> 'function-method-keyword | |
5858 | 9 <=> 'class | |
5859 | ||
5e72c6b2 S |
5860 | As a special case, the universal argument C-u forces completion of |
5861 | function names in places where the default would be a keyword. | |
5862 | ||
52a244eb S |
5863 | Two prefix argument, C-u C-u, prompts for a regexp by which to limit |
5864 | completion. | |
5865 | ||
f32b3b91 CD |
5866 | For Lisp programmers only: |
5867 | When we force a keyword, optional argument MODULE can contain the module name. | |
5868 | When we force a method or a method keyword, CLASS can specify the class." | |
5869 | (interactive "P") | |
5870 | (idlwave-routines) | |
5871 | (let* ((where-list | |
5872 | (if (and arg | |
52a244eb | 5873 | (or (and (integerp arg) (not (equal arg '(16)))) |
f32b3b91 CD |
5874 | (symbolp arg))) |
5875 | (idlwave-make-force-complete-where-list arg module class) | |
5876 | (idlwave-where))) | |
5877 | (what (nth 2 where-list)) | |
52a244eb S |
5878 | (idlwave-force-class-query (equal arg '(4))) |
5879 | (completion-regexp-list | |
5880 | (if (equal arg '(16)) | |
5881 | (list (read-string (concat "Completion Regexp: ")))))) | |
4b1aaa8b | 5882 | |
f32b3b91 CD |
5883 | (if (and module (string-match "::" module)) |
5884 | (setq class (substring module 0 (match-beginning 0)) | |
5885 | module (substring module (match-end 0)))) | |
5886 | ||
5887 | (cond | |
5888 | ||
5889 | ((and (null arg) | |
5890 | (eq (car-safe last-command) 'idlwave-display-completion-list) | |
595ab50b | 5891 | (get-buffer-window "*Completions*")) |
f32b3b91 CD |
5892 | (setq this-command last-command) |
5893 | (idlwave-scroll-completions)) | |
5894 | ||
52a244eb | 5895 | ;; Complete a filename in quotes |
05a1abfc CD |
5896 | ((and (idlwave-in-quote) |
5897 | (not (eq what 'class))) | |
5898 | (idlwave-complete-filename)) | |
5899 | ||
52a244eb S |
5900 | ;; Check for any special completion functions |
5901 | ((and idlwave-complete-special | |
5902 | (idlwave-call-special idlwave-complete-special))) | |
4b1aaa8b | 5903 | |
f32b3b91 CD |
5904 | ((null what) |
5905 | (error "Nothing to complete here")) | |
5906 | ||
52a244eb | 5907 | ;; Complete a class |
f32b3b91 | 5908 | ((eq what 'class) |
15e42531 | 5909 | (setq idlwave-completion-help-info '(class)) |
f32b3b91 CD |
5910 | (idlwave-complete-class)) |
5911 | ||
5912 | ((eq what 'procedure) | |
5913 | ;; Complete a procedure name | |
5e72c6b2 S |
5914 | (let* ((cw-list (nth 3 where-list)) |
5915 | (class-selector (idlwave-determine-class cw-list 'pro)) | |
5916 | (super-classes (unless (idlwave-explicit-class-listed cw-list) | |
5917 | (idlwave-all-class-inherits class-selector))) | |
f32b3b91 CD |
5918 | (isa (concat "procedure" (if class-selector "-method" ""))) |
5919 | (type-selector 'pro)) | |
4b1aaa8b | 5920 | (setq idlwave-completion-help-info |
05a1abfc | 5921 | (list 'routine nil type-selector class-selector nil super-classes)) |
f32b3b91 CD |
5922 | (idlwave-complete-in-buffer |
5923 | 'procedure (if class-selector 'method 'routine) | |
5924 | (idlwave-routines) 'idlwave-selector | |
5925 | (format "Select a %s name%s" | |
5926 | isa | |
5927 | (if class-selector | |
4b1aaa8b PE |
5928 | (format " (class is %s)" |
5929 | (if (eq class-selector t) | |
76959b77 | 5930 | "unknown" class-selector)) |
f32b3b91 CD |
5931 | "")) |
5932 | isa | |
52a244eb | 5933 | 'idlwave-attach-method-classes 'idlwave-add-file-link-selector))) |
f32b3b91 CD |
5934 | |
5935 | ((eq what 'function) | |
5936 | ;; Complete a function name | |
5e72c6b2 S |
5937 | (let* ((cw-list (nth 3 where-list)) |
5938 | (class-selector (idlwave-determine-class cw-list 'fun)) | |
5939 | (super-classes (unless (idlwave-explicit-class-listed cw-list) | |
5940 | (idlwave-all-class-inherits class-selector))) | |
f32b3b91 CD |
5941 | (isa (concat "function" (if class-selector "-method" ""))) |
5942 | (type-selector 'fun)) | |
4b1aaa8b | 5943 | (setq idlwave-completion-help-info |
05a1abfc | 5944 | (list 'routine nil type-selector class-selector nil super-classes)) |
f32b3b91 CD |
5945 | (idlwave-complete-in-buffer |
5946 | 'function (if class-selector 'method 'routine) | |
5947 | (idlwave-routines) 'idlwave-selector | |
5948 | (format "Select a %s name%s" | |
5949 | isa | |
5950 | (if class-selector | |
4b1aaa8b | 5951 | (format " (class is %s)" |
76959b77 S |
5952 | (if (eq class-selector t) |
5953 | "unknown" class-selector)) | |
f32b3b91 CD |
5954 | "")) |
5955 | isa | |
52a244eb | 5956 | 'idlwave-attach-method-classes 'idlwave-add-file-link-selector))) |
f32b3b91 | 5957 | |
52a244eb | 5958 | ((and (memq what '(procedure-keyword function-keyword)) ; Special Case |
5e72c6b2 S |
5959 | (equal arg '(4))) |
5960 | (idlwave-complete 3)) | |
5961 | ||
f32b3b91 CD |
5962 | ((eq what 'procedure-keyword) |
5963 | ;; Complete a procedure keyword | |
5964 | (let* ((where (nth 3 where-list)) | |
5965 | (name (car where)) | |
5966 | (method-selector name) | |
5967 | (type-selector 'pro) | |
5968 | (class (idlwave-determine-class where 'pro)) | |
5969 | (class-selector class) | |
05a1abfc | 5970 | (super-classes (idlwave-all-class-inherits class-selector)) |
f32b3b91 | 5971 | (isa (format "procedure%s-keyword" (if class "-method" ""))) |
15e42531 | 5972 | (entry (idlwave-best-rinfo-assq |
f32b3b91 | 5973 | name 'pro class (idlwave-routines))) |
3938cb82 | 5974 | (system (if entry (eq (car (nth 3 entry)) 'system))) |
52a244eb | 5975 | (list (idlwave-entry-keywords entry 'do-link))) |
f32b3b91 CD |
5976 | (unless (or entry (eq class t)) |
5977 | (error "Nothing known about procedure %s" | |
5978 | (idlwave-make-full-name class name))) | |
4b1aaa8b | 5979 | (setq list (idlwave-fix-keywords name 'pro class list |
3938cb82 | 5980 | super-classes system)) |
b6a97790 | 5981 | (unless list (error "No keywords available for procedure %s" |
3938cb82 | 5982 | (idlwave-make-full-name class name))) |
4b1aaa8b | 5983 | (setq idlwave-completion-help-info |
52a244eb | 5984 | (list 'keyword name type-selector class-selector entry super-classes)) |
f32b3b91 CD |
5985 | (idlwave-complete-in-buffer |
5986 | 'keyword 'keyword list nil | |
5987 | (format "Select keyword for procedure %s%s" | |
5988 | (idlwave-make-full-name class name) | |
15e42531 | 5989 | (if (or (member '("_EXTRA") list) |
4b1aaa8b | 5990 | (member '("_REF_EXTRA") list)) |
15e42531 | 5991 | " (note _EXTRA)" "")) |
f32b3b91 CD |
5992 | isa |
5993 | 'idlwave-attach-keyword-classes))) | |
5994 | ||
5995 | ((eq what 'function-keyword) | |
5996 | ;; Complete a function keyword | |
5997 | (let* ((where (nth 3 where-list)) | |
5998 | (name (car where)) | |
5999 | (method-selector name) | |
6000 | (type-selector 'fun) | |
6001 | (class (idlwave-determine-class where 'fun)) | |
6002 | (class-selector class) | |
05a1abfc | 6003 | (super-classes (idlwave-all-class-inherits class-selector)) |
f32b3b91 | 6004 | (isa (format "function%s-keyword" (if class "-method" ""))) |
15e42531 | 6005 | (entry (idlwave-best-rinfo-assq |
f32b3b91 | 6006 | name 'fun class (idlwave-routines))) |
3938cb82 | 6007 | (system (if entry (eq (car (nth 3 entry)) 'system))) |
52a244eb | 6008 | (list (idlwave-entry-keywords entry 'do-link)) |
15e42531 | 6009 | msg-name) |
f32b3b91 CD |
6010 | (unless (or entry (eq class t)) |
6011 | (error "Nothing known about function %s" | |
6012 | (idlwave-make-full-name class name))) | |
4b1aaa8b | 6013 | (setq list (idlwave-fix-keywords name 'fun class list |
3938cb82 | 6014 | super-classes system)) |
15e42531 CD |
6015 | ;; OBJ_NEW: Messages mention the proper Init method |
6016 | (setq msg-name (if (and (null class) | |
6017 | (string= (upcase name) "OBJ_NEW")) | |
6018 | (concat idlwave-current-obj_new-class | |
6019 | "::Init (via OBJ_NEW)") | |
6020 | (idlwave-make-full-name class name))) | |
b6a97790 | 6021 | (unless list (error "No keywords available for function %s" |
3938cb82 | 6022 | msg-name)) |
4b1aaa8b | 6023 | (setq idlwave-completion-help-info |
05a1abfc | 6024 | (list 'keyword name type-selector class-selector nil super-classes)) |
f32b3b91 CD |
6025 | (idlwave-complete-in-buffer |
6026 | 'keyword 'keyword list nil | |
15e42531 CD |
6027 | (format "Select keyword for function %s%s" msg-name |
6028 | (if (or (member '("_EXTRA") list) | |
4b1aaa8b | 6029 | (member '("_REF_EXTRA") list)) |
15e42531 | 6030 | " (note _EXTRA)" "")) |
f32b3b91 CD |
6031 | isa |
6032 | 'idlwave-attach-keyword-classes))) | |
15e42531 | 6033 | |
f32b3b91 CD |
6034 | (t (error "This should not happen (idlwave-complete)"))))) |
6035 | ||
05a1abfc CD |
6036 | (defvar idlwave-complete-special nil |
6037 | "List of special completion functions. | |
52a244eb S |
6038 | These functions are called for each completion. Each function must |
6039 | check if its own special completion context is present. If yes, it | |
6040 | should use `idlwave-complete-in-buffer' to do some completion and | |
6041 | return t. If such a function returns t, *no further* attempts to | |
6042 | complete other contexts will be done. If the function returns nil, | |
6043 | other completions will be tried.") | |
76959b77 S |
6044 | |
6045 | (defun idlwave-call-special (functions &rest args) | |
6046 | (let ((funcs functions) | |
6047 | fun ret) | |
05a1abfc | 6048 | (catch 'exit |
76959b77 S |
6049 | (while (setq fun (pop funcs)) |
6050 | (if (setq ret (apply fun args)) | |
6051 | (throw 'exit ret))) | |
05a1abfc CD |
6052 | nil))) |
6053 | ||
f32b3b91 CD |
6054 | (defun idlwave-make-force-complete-where-list (what &optional module class) |
6055 | ;; Return an artificial WHERE specification to force the completion | |
6056 | ;; routine to complete a specific item independent of context. | |
6057 | ;; WHAT is the prefix arg of `idlwave-complete', see there for details. | |
6058 | ;; MODULE and CLASS can be used to specify the routine name and class. | |
6059 | ;; The class name will also be found in MODULE if that is like "class::mod". | |
6060 | (let* ((what-list '(("procedure") ("procedure-keyword") | |
6061 | ("function") ("function-keyword") | |
6062 | ("procedure-method") ("procedure-method-keyword") | |
6063 | ("function-method") ("function-method-keyword") | |
6064 | ("class"))) | |
6065 | (module (idlwave-sintern-routine-or-method module class)) | |
6066 | (class (idlwave-sintern-class class)) | |
4b1aaa8b | 6067 | (what (cond |
f32b3b91 CD |
6068 | ((equal what 0) |
6069 | (setq what | |
4b1aaa8b | 6070 | (intern (completing-read |
f32b3b91 CD |
6071 | "Complete what? " what-list nil t)))) |
6072 | ((integerp what) | |
6073 | (setq what (intern (car (nth (1- what) what-list))))) | |
6074 | ((and what | |
6075 | (symbolp what) | |
6076 | (assoc (symbol-name what) what-list)) | |
6077 | what) | |
eac9c0ef | 6078 | (t (error "Invalid WHAT")))) |
f32b3b91 CD |
6079 | (nil-list '(nil nil nil nil)) |
6080 | (class-list (list nil nil (or class t) nil))) | |
6081 | ||
6082 | (cond | |
6083 | ||
6084 | ((eq what 'procedure) | |
6085 | (list nil-list nil-list 'procedure nil-list nil)) | |
6086 | ||
6087 | ((eq what 'procedure-keyword) | |
6088 | (let* ((class-selector nil) | |
05a1abfc | 6089 | (super-classes nil) |
f32b3b91 CD |
6090 | (type-selector 'pro) |
6091 | (pro (or module | |
4b1aaa8b | 6092 | (idlwave-completing-read |
f32b3b91 CD |
6093 | "Procedure: " (idlwave-routines) 'idlwave-selector)))) |
6094 | (setq pro (idlwave-sintern-routine pro)) | |
6095 | (list nil-list nil-list 'procedure-keyword | |
6096 | (list pro nil nil nil) nil))) | |
6097 | ||
6098 | ((eq what 'function) | |
6099 | (list nil-list nil-list 'function nil-list nil)) | |
6100 | ||
6101 | ((eq what 'function-keyword) | |
6102 | (let* ((class-selector nil) | |
05a1abfc | 6103 | (super-classes nil) |
f32b3b91 CD |
6104 | (type-selector 'fun) |
6105 | (func (or module | |
4b1aaa8b | 6106 | (idlwave-completing-read |
f32b3b91 CD |
6107 | "Function: " (idlwave-routines) 'idlwave-selector)))) |
6108 | (setq func (idlwave-sintern-routine func)) | |
6109 | (list nil-list nil-list 'function-keyword | |
6110 | (list func nil nil nil) nil))) | |
6111 | ||
6112 | ((eq what 'procedure-method) | |
6113 | (list nil-list nil-list 'procedure class-list nil)) | |
6114 | ||
6115 | ((eq what 'procedure-method-keyword) | |
6116 | (let* ((class (idlwave-determine-class class-list 'pro)) | |
6117 | (class-selector class) | |
05a1abfc | 6118 | (super-classes (idlwave-all-class-inherits class-selector)) |
f32b3b91 CD |
6119 | (type-selector 'pro) |
6120 | (pro (or module | |
6121 | (idlwave-completing-read | |
6122 | (format "Procedure in %s class: " class-selector) | |
6123 | (idlwave-routines) 'idlwave-selector)))) | |
6124 | (setq pro (idlwave-sintern-method pro)) | |
6125 | (list nil-list nil-list 'procedure-keyword | |
6126 | (list pro nil class nil) nil))) | |
6127 | ||
6128 | ((eq what 'function-method) | |
6129 | (list nil-list nil-list 'function class-list nil)) | |
6130 | ||
6131 | ((eq what 'function-method-keyword) | |
6132 | (let* ((class (idlwave-determine-class class-list 'fun)) | |
6133 | (class-selector class) | |
05a1abfc | 6134 | (super-classes (idlwave-all-class-inherits class-selector)) |
f32b3b91 CD |
6135 | (type-selector 'fun) |
6136 | (func (or module | |
6137 | (idlwave-completing-read | |
6138 | (format "Function in %s class: " class-selector) | |
6139 | (idlwave-routines) 'idlwave-selector)))) | |
6140 | (setq func (idlwave-sintern-method func)) | |
6141 | (list nil-list nil-list 'function-keyword | |
6142 | (list func nil class nil) nil))) | |
6143 | ||
6144 | ((eq what 'class) | |
6145 | (list nil-list nil-list 'class nil-list nil)) | |
4b1aaa8b | 6146 | |
eac9c0ef | 6147 | (t (error "Invalid value for WHAT"))))) |
f32b3b91 CD |
6148 | |
6149 | (defun idlwave-completing-read (&rest args) | |
6150 | ;; Completing read, case insensitive | |
6151 | (let ((old-value (default-value 'completion-ignore-case))) | |
6152 | (unwind-protect | |
6153 | (progn | |
6154 | (setq-default completion-ignore-case t) | |
6155 | (apply 'completing-read args)) | |
6156 | (setq-default completion-ignore-case old-value)))) | |
6157 | ||
05a1abfc CD |
6158 | (defvar idlwave-shell-default-directory) |
6159 | (defun idlwave-complete-filename () | |
6160 | "Use the comint stuff to complete a file name." | |
6161 | (require 'comint) | |
6162 | (let* ((comint-file-name-chars "~/A-Za-z0-9+@:_.$#%={}\\-") | |
6163 | (comint-completion-addsuffix nil) | |
6164 | (default-directory | |
6165 | (if (and (boundp 'idlwave-shell-default-directory) | |
6166 | (stringp idlwave-shell-default-directory) | |
6167 | (file-directory-p idlwave-shell-default-directory)) | |
6168 | idlwave-shell-default-directory | |
4b1aaa8b | 6169 | default-directory))) |
05a1abfc CD |
6170 | (comint-dynamic-complete-filename))) |
6171 | ||
f32b3b91 CD |
6172 | (defun idlwave-make-full-name (class name) |
6173 | ;; Make a fully qualified module name including the class name | |
6174 | (concat (if class (format "%s::" class) "") name)) | |
6175 | ||
15e42531 CD |
6176 | (defun idlwave-rinfo-assoc (name type class list) |
6177 | "Like `idlwave-rinfo-assq', but sintern strings first." | |
4b1aaa8b | 6178 | (idlwave-rinfo-assq |
15e42531 CD |
6179 | (idlwave-sintern-routine-or-method name class) |
6180 | type (idlwave-sintern-class class) list)) | |
6181 | ||
f32b3b91 CD |
6182 | (defun idlwave-rinfo-assq (name type class list) |
6183 | ;; Works like assq, but also checks type and class | |
6184 | (catch 'exit | |
6185 | (let (match) | |
6186 | (while (setq match (assq name list)) | |
6187 | (and (or (eq type t) | |
6188 | (eq (nth 1 match) type)) | |
6189 | (eq (nth 2 match) class) | |
6190 | (throw 'exit match)) | |
6191 | (setq list (cdr (memq match list))))))) | |
6192 | ||
05a1abfc | 6193 | (defun idlwave-rinfo-assq-any-class (name type class list) |
52a244eb | 6194 | ;; Return the first matching method on the inheritance list |
05a1abfc CD |
6195 | (let* ((classes (cons class (idlwave-all-class-inherits class))) |
6196 | class rtn) | |
6197 | (while classes | |
6198 | (if (setq rtn (idlwave-rinfo-assq name type (pop classes) list)) | |
6199 | (setq classes nil))) | |
6200 | rtn)) | |
6201 | ||
4b1aaa8b | 6202 | (defun idlwave-best-rinfo-assq (name type class list &optional with-file |
52a244eb S |
6203 | keep-system) |
6204 | "Like `idlwave-rinfo-assq', but get all twins and sort, then return first. | |
6205 | If WITH-FILE is passed, find the best rinfo entry with a file | |
6206 | included. If KEEP-SYSTEM is set, don't prune system for compiled | |
6207 | syslib files." | |
15e42531 | 6208 | (let ((twins (idlwave-routine-twins |
05a1abfc | 6209 | (idlwave-rinfo-assq-any-class name type class list) |
15e42531 CD |
6210 | list)) |
6211 | syslibp) | |
6212 | (when (> (length twins) 1) | |
6213 | (setq twins (sort twins 'idlwave-routine-entry-compare-twins)) | |
52a244eb S |
6214 | (if (and (null keep-system) |
6215 | (eq 'system (car (nth 3 (car twins)))) | |
15e42531 CD |
6216 | (setq syslibp (idlwave-any-syslib (cdr twins))) |
6217 | (not (equal 1 syslibp))) | |
52a244eb S |
6218 | ;; Its a compiled syslib, so we need to remove the system entry |
6219 | (setq twins (cdr twins))) | |
6220 | (if with-file | |
6221 | (setq twins (delq nil | |
6222 | (mapcar (lambda (x) | |
6223 | (if (nth 1 (nth 3 x)) x)) | |
6224 | twins))))) | |
15e42531 CD |
6225 | (car twins))) |
6226 | ||
4b1aaa8b | 6227 | (defun idlwave-best-rinfo-assoc (name type class list &optional with-file |
52a244eb | 6228 | keep-system) |
15e42531 CD |
6229 | "Like `idlwave-best-rinfo-assq', but sintern strings first." |
6230 | (idlwave-best-rinfo-assq | |
6231 | (idlwave-sintern-routine-or-method name class) | |
52a244eb | 6232 | type (idlwave-sintern-class class) list with-file keep-system)) |
15e42531 CD |
6233 | |
6234 | (defun idlwave-any-syslib (entries) | |
6235 | "Does the entry list ENTRIES contain a syslib entry? | |
6236 | If yes, return the index (>=1)." | |
6237 | (let (file (cnt 0)) | |
6238 | (catch 'exit | |
6239 | (while entries | |
6240 | (incf cnt) | |
52a244eb S |
6241 | (setq file (idlwave-routine-source-file (nth 3 (car entries)))) |
6242 | (if (and file (idlwave-syslib-p file)) | |
15e42531 CD |
6243 | (throw 'exit cnt) |
6244 | (setq entries (cdr entries)))) | |
6245 | nil))) | |
6246 | ||
f32b3b91 CD |
6247 | (defun idlwave-all-assq (key list) |
6248 | "Return a list of all associations of Key in LIST." | |
6249 | (let (rtn elt) | |
6250 | (while (setq elt (assq key list)) | |
6251 | (push elt rtn) | |
6252 | (setq list (cdr (memq elt list)))) | |
6253 | (nreverse rtn))) | |
6254 | ||
6255 | (defun idlwave-all-method-classes (method &optional type) | |
5a0c3f56 JB |
6256 | "Return all classes which have a method METHOD. |
6257 | TYPE is 'fun or 'pro. | |
f32b3b91 CD |
6258 | When TYPE is not specified, both procedures and functions will be considered." |
6259 | (if (null method) | |
15e42531 | 6260 | (mapcar 'car (idlwave-class-alist)) |
f32b3b91 | 6261 | (let (rtn) |
8ffcfb27 GM |
6262 | (mapc (lambda (x) |
6263 | (and (nth 2 x) | |
6264 | (or (not type) | |
6265 | (eq type (nth 1 x))) | |
6266 | (push (nth 2 x) rtn))) | |
6267 | (idlwave-all-assq method (idlwave-routines))) | |
f32b3b91 CD |
6268 | (idlwave-uniquify rtn)))) |
6269 | ||
6270 | (defun idlwave-all-method-keyword-classes (method keyword &optional type) | |
6271 | "Return all classes which have a method METHOD with keyword KEYWORD. | |
6272 | TYPE is 'fun or 'pro. | |
6273 | When TYPE is not specified, both procedures and functions will be considered." | |
6274 | (if (or (null method) | |
6275 | (null keyword)) | |
6276 | nil | |
6277 | (let (rtn) | |
8ffcfb27 GM |
6278 | (mapc (lambda (x) |
6279 | (and (nth 2 x) ; non-nil class | |
6280 | (or (not type) ; correct or unspecified type | |
6281 | (eq type (nth 1 x))) | |
6282 | (assoc keyword (idlwave-entry-keywords x)) | |
6283 | (push (nth 2 x) rtn))) | |
6284 | (idlwave-all-assq method (idlwave-routines))) | |
f32b3b91 CD |
6285 | (idlwave-uniquify rtn)))) |
6286 | ||
05a1abfc CD |
6287 | (defun idlwave-members-only (list club) |
6288 | "Return list of all elements in LIST which are also in CLUB." | |
6289 | (let (rtn) | |
6290 | (while list | |
6291 | (if (member (car list) club) | |
6292 | (setq rtn (cons (car list) rtn))) | |
6293 | (setq list (cdr list))) | |
6294 | (nreverse rtn))) | |
6295 | ||
6296 | (defun idlwave-nonmembers-only (list club) | |
6297 | "Return list of all elements in LIST which are not in CLUB." | |
6298 | (let (rtn) | |
6299 | (while list | |
6300 | (if (member (car list) club) | |
6301 | nil | |
6302 | (setq rtn (cons (car list) rtn))) | |
6303 | (setq list (cdr list))) | |
6304 | (nreverse rtn))) | |
6305 | ||
5e72c6b2 S |
6306 | (defun idlwave-explicit-class-listed (info) |
6307 | "Return whether or not the class is listed explicitly, ala a->b::c. | |
5a0c3f56 | 6308 | INFO is as returned by `idlwave-what-function' or `-procedure'." |
5e72c6b2 S |
6309 | (let ((apos (nth 3 info))) |
6310 | (if apos | |
6311 | (save-excursion (goto-char apos) | |
6312 | (looking-at "->[a-zA-Z][a-zA-Z0-9$_]*::"))))) | |
6313 | ||
76959b77 S |
6314 | (defvar idlwave-determine-class-special nil |
6315 | "List of special functions for determining class. | |
5a0c3f56 | 6316 | Must accept two arguments: `apos' and `info'.") |
76959b77 | 6317 | |
f32b3b91 | 6318 | (defun idlwave-determine-class (info type) |
4b1aaa8b | 6319 | ;; Determine the class of a routine call. |
76959b77 S |
6320 | ;; INFO is the `cw-list' structure as returned by idlwave-where. |
6321 | ;; The second element in this structure is the class. When nil, we | |
6322 | ;; return nil. When t, try to get the class from text properties at | |
6323 | ;; the arrow. When the object is "self", we use the class of the | |
6324 | ;; current routine. otherwise prompt the user for a class name. | |
6325 | ;; Also stores the selected class as a text property at the arrow. | |
f32b3b91 CD |
6326 | ;; TYPE is 'fun or 'pro. |
6327 | (let* ((class (nth 2 info)) | |
6328 | (apos (nth 3 info)) | |
6329 | (nassoc (assoc (if (stringp (car info)) | |
6330 | (upcase (car info)) | |
6331 | (car info)) | |
6332 | idlwave-query-class)) | |
6333 | (dassoc (assq (if (car info) 'keyword-default 'method-default) | |
6334 | idlwave-query-class)) | |
6335 | (query (cond (nassoc (cdr nassoc)) | |
6336 | (dassoc (cdr dassoc)) | |
6337 | (t t))) | |
6338 | (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) | |
4b1aaa8b | 6339 | (is-self |
15e42531 CD |
6340 | (and arrow |
6341 | (save-excursion (goto-char apos) | |
6342 | (forward-word -1) | |
6343 | (let ((case-fold-search t)) | |
6344 | (looking-at "self\\>"))))) | |
f32b3b91 | 6345 | (force-query idlwave-force-class-query) |
76959b77 | 6346 | store special-class class-alist) |
f32b3b91 CD |
6347 | (cond |
6348 | ((null class) nil) | |
6349 | ((eq t class) | |
6350 | ;; There is an object which would like to know its class | |
6351 | (if (and arrow (get-text-property apos 'idlwave-class) | |
6352 | idlwave-store-inquired-class | |
6353 | (not force-query)) | |
6354 | (setq class (get-text-property apos 'idlwave-class) | |
6355 | class (idlwave-sintern-class class))) | |
76959b77 S |
6356 | (if (and (eq t class) is-self) |
6357 | (setq class (or (nth 2 (idlwave-current-routine)) class))) | |
6358 | ||
6359 | ;; Before prompting, try any special class determination routines | |
4b1aaa8b | 6360 | (when (and (eq t class) |
76959b77 S |
6361 | idlwave-determine-class-special |
6362 | (not force-query)) | |
4b1aaa8b | 6363 | (setq special-class |
76959b77 | 6364 | (idlwave-call-special idlwave-determine-class-special apos)) |
4b1aaa8b | 6365 | (if special-class |
76959b77 S |
6366 | (setq class (idlwave-sintern-class special-class) |
6367 | store idlwave-store-inquired-class))) | |
4b1aaa8b | 6368 | |
76959b77 | 6369 | ;; Prompt for a class, if we need to |
f32b3b91 CD |
6370 | (when (and (eq class t) |
6371 | (or force-query query)) | |
4b1aaa8b | 6372 | (setq class-alist |
f32b3b91 CD |
6373 | (mapcar 'list (idlwave-all-method-classes (car info) type))) |
6374 | (setq class | |
6375 | (idlwave-sintern-class | |
6376 | (cond | |
6377 | ((and (= (length class-alist) 0) (not force-query)) | |
6378 | (error "No classes available with method %s" (car info))) | |
6379 | ((and (= (length class-alist) 1) (not force-query)) | |
6380 | (car (car class-alist))) | |
4b1aaa8b | 6381 | (t |
f32b3b91 | 6382 | (setq store idlwave-store-inquired-class) |
4b1aaa8b | 6383 | (idlwave-completing-read |
f32b3b91 CD |
6384 | (format "Class%s: " (if (stringp (car info)) |
6385 | (format " for %s method %s" | |
6386 | type (car info)) | |
6387 | "")) | |
6388 | class-alist nil nil nil 'idlwave-class-history)))))) | |
76959b77 S |
6389 | |
6390 | ;; Store it, if requested | |
f32b3b91 CD |
6391 | (when (and class (not (eq t class))) |
6392 | ;; We have a real class here | |
6393 | (when (and store arrow) | |
76959b77 | 6394 | (condition-case () |
4b1aaa8b PE |
6395 | (add-text-properties |
6396 | apos (+ apos 2) | |
6397 | `(idlwave-class ,class face ,idlwave-class-arrow-face | |
76959b77 S |
6398 | rear-nonsticky t)) |
6399 | (error nil))) | |
f32b3b91 CD |
6400 | (setf (nth 2 info) class)) |
6401 | ;; Return the class | |
6402 | class) | |
6403 | ;; Default as fallback | |
6404 | (t class)))) | |
6405 | ||
f32b3b91 CD |
6406 | (defun idlwave-selector (a) |
6407 | (and (eq (nth 1 a) type-selector) | |
6408 | (or (and (nth 2 a) (eq class-selector t)) | |
05a1abfc | 6409 | (eq (nth 2 a) class-selector) |
52a244eb S |
6410 | (memq (nth 2 a) super-classes)))) |
6411 | ||
6412 | (defun idlwave-add-file-link-selector (a) | |
6413 | ;; Record a file link, if any, for the tested names during selection. | |
6414 | (let ((sel (idlwave-selector a)) file) | |
6415 | (if (and sel (setq file (idlwave-entry-has-help a))) | |
6416 | (push (cons (car a) file) idlwave-completion-help-links)) | |
6417 | sel)) | |
6418 | ||
f32b3b91 CD |
6419 | |
6420 | (defun idlwave-where () | |
4b1aaa8b | 6421 | "Find out where we are. |
f32b3b91 | 6422 | The return value is a list with the following stuff: |
5e72c6b2 | 6423 | \(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) |
f32b3b91 CD |
6424 | |
6425 | PRO-LIST (PRO POINT CLASS ARROW) | |
6426 | FUNC-LIST (FUNC POINT CLASS ARROW) | |
6427 | COMPLETE-WHAT a symbol indicating what kind of completion makes sense here | |
4b1aaa8b | 6428 | CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can |
5e72c6b2 | 6429 | be completed here. |
f32b3b91 CD |
6430 | LAST-CHAR last relevant character before point (non-white non-comment, |
6431 | not part of current identifier or leading slash). | |
6432 | ||
6433 | In the lists, we have these meanings: | |
6434 | PRO: Procedure name | |
6435 | FUNC: Function name | |
6436 | POINT: Where is this | |
6437 | CLASS: What class has the routine (nil=no, t=is method, but class unknown) | |
5e72c6b2 | 6438 | ARROW: Location of the arrow" |
f32b3b91 | 6439 | (idlwave-routines) |
4b1aaa8b | 6440 | (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) |
15e42531 | 6441 | (bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) |
f32b3b91 CD |
6442 | (func-entry (idlwave-what-function bos)) |
6443 | (func (car func-entry)) | |
6444 | (func-class (nth 1 func-entry)) | |
6445 | (func-arrow (nth 2 func-entry)) | |
6446 | (func-point (or (nth 3 func-entry) 0)) | |
6447 | (func-level (or (nth 4 func-entry) 0)) | |
6448 | (pro-entry (idlwave-what-procedure bos)) | |
6449 | (pro (car pro-entry)) | |
6450 | (pro-class (nth 1 pro-entry)) | |
6451 | (pro-arrow (nth 2 pro-entry)) | |
6452 | (pro-point (or (nth 3 pro-entry) 0)) | |
6453 | (last-char (idlwave-last-valid-char)) | |
6454 | (case-fold-search t) | |
52a244eb | 6455 | (match-string (buffer-substring bos (point))) |
f32b3b91 CD |
6456 | cw cw-mod cw-arrow cw-class cw-point) |
6457 | (if (< func-point pro-point) (setq func nil)) | |
6458 | (cond | |
15e42531 | 6459 | ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" |
52a244eb | 6460 | match-string) |
15e42531 | 6461 | (setq cw 'class)) |
4b1aaa8b PE |
6462 | ((string-match |
6463 | "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" | |
52a244eb S |
6464 | (if (> pro-point 0) |
6465 | (buffer-substring pro-point (point)) | |
6466 | match-string)) | |
f32b3b91 CD |
6467 | (setq cw 'procedure cw-class pro-class cw-point pro-point |
6468 | cw-arrow pro-arrow)) | |
6469 | ((string-match "\\`[ \t]*\\(pro\\|function\\)\\>" | |
52a244eb | 6470 | match-string) |
f32b3b91 | 6471 | nil) |
05a1abfc | 6472 | ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'" |
52a244eb | 6473 | match-string) |
4b1aaa8b | 6474 | (setq cw 'class)) |
05a1abfc | 6475 | ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'" |
52a244eb | 6476 | match-string) |
4b1aaa8b PE |
6477 | (setq cw 'class)) |
6478 | ((and func | |
f32b3b91 CD |
6479 | (> func-point pro-point) |
6480 | (= func-level 1) | |
6481 | (memq last-char '(?\( ?,))) | |
6482 | (setq cw 'function-keyword cw-mod func cw-point func-point | |
6483 | cw-class func-class cw-arrow func-arrow)) | |
6484 | ((and pro (eq last-char ?,)) | |
6485 | (setq cw 'procedure-keyword cw-mod pro cw-point pro-point | |
6486 | cw-class pro-class cw-arrow pro-arrow)) | |
6487 | ; ((member last-char '(?\' ?\) ?\] ?!)) | |
6488 | ; ;; after these chars, a function makes no sense | |
6489 | ; ;; FIXME: I am sure there can be more in this list | |
6490 | ; ;; FIXME: Do we want to do this at all? | |
6491 | ; nil) | |
6492 | ;; Everywhere else we try a function. | |
6493 | (t | |
6494 | (setq cw 'function) | |
6495 | (save-excursion | |
52a244eb | 6496 | (if (re-search-backward "->[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\s-*\\)?\\(\\([$a-zA-Z0-9_]+\\)::\\)?[$a-zA-Z0-9_]*\\=" bos t) |
76959b77 | 6497 | (setq cw-arrow (copy-marker (match-beginning 0)) |
52a244eb S |
6498 | cw-class (if (match-end 4) |
6499 | (idlwave-sintern-class (match-string 4)) | |
5e72c6b2 | 6500 | t)))))) |
f32b3b91 CD |
6501 | (list (list pro pro-point pro-class pro-arrow) |
6502 | (list func func-point func-class func-arrow) | |
6503 | cw | |
6504 | (list cw-mod cw-point cw-class cw-arrow) | |
6505 | last-char))) | |
6506 | ||
6507 | (defun idlwave-this-word (&optional class) | |
6508 | ;; Grab the word around point. CLASS is for the `skip-chars=...' functions | |
52a244eb | 6509 | (setq class (or class "a-zA-Z0-9$_.")) |
f32b3b91 | 6510 | (save-excursion |
52a244eb | 6511 | (buffer-substring |
f32b3b91 CD |
6512 | (progn (skip-chars-backward class) (point)) |
6513 | (progn (skip-chars-forward class) (point))))) | |
6514 | ||
f32b3b91 CD |
6515 | (defun idlwave-what-function (&optional bound) |
6516 | ;; Find out if point is within the argument list of a function. | |
76959b77 S |
6517 | ;; The return value is ("function-name" class arrow-start (point) level). |
6518 | ;; Level is 1 on the top level parentheses, higher further down. | |
f32b3b91 CD |
6519 | |
6520 | ;; If the optional BOUND is an integer, bound backwards directed | |
6521 | ;; searches to this point. | |
6522 | ||
6523 | (catch 'exit | |
4b1aaa8b | 6524 | (let (pos |
f32b3b91 | 6525 | func-point |
f32b3b91 CD |
6526 | (cnt 0) |
6527 | func arrow-start class) | |
15e42531 CD |
6528 | (idlwave-with-special-syntax |
6529 | (save-restriction | |
6530 | (save-excursion | |
6531 | (narrow-to-region (max 1 (or bound 0)) (point-max)) | |
6532 | ;; move back out of the current parenthesis | |
6533 | (while (condition-case nil | |
6534 | (progn (up-list -1) t) | |
6535 | (error nil)) | |
6536 | (setq pos (point)) | |
6537 | (incf cnt) | |
6538 | (when (and (= (following-char) ?\() | |
4b1aaa8b | 6539 | (re-search-backward |
15e42531 CD |
6540 | "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" |
6541 | bound t)) | |
6542 | (setq func (match-string 2) | |
6543 | func-point (goto-char (match-beginning 2)) | |
6544 | pos func-point) | |
4b1aaa8b | 6545 | (if (re-search-backward |
15e42531 | 6546 | "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) |
76959b77 | 6547 | (setq arrow-start (copy-marker (match-beginning 0)) |
15e42531 | 6548 | class (or (match-string 2) t))) |
4b1aaa8b PE |
6549 | (throw |
6550 | 'exit | |
15e42531 CD |
6551 | (list |
6552 | (idlwave-sintern-routine-or-method func class) | |
6553 | (idlwave-sintern-class class) | |
6554 | arrow-start func-point cnt))) | |
6555 | (goto-char pos)) | |
6556 | (throw 'exit nil))))))) | |
f32b3b91 CD |
6557 | |
6558 | (defun idlwave-what-procedure (&optional bound) | |
6559 | ;; Find out if point is within the argument list of a procedure. | |
6560 | ;; The return value is ("procedure-name" class arrow-pos (point)). | |
6561 | ||
6562 | ;; If the optional BOUND is an integer, bound backwards directed | |
6563 | ;; searches to this point. | |
6564 | (let ((pos (point)) pro-point | |
6565 | pro class arrow-start string) | |
4b1aaa8b | 6566 | (save-excursion |
05a1abfc | 6567 | ;;(idlwave-beginning-of-statement) |
15e42531 | 6568 | (idlwave-start-of-substatement 'pre) |
f32b3b91 | 6569 | (setq string (buffer-substring (point) pos)) |
4b1aaa8b | 6570 | (if (string-match |
76959b77 S |
6571 | "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) |
6572 | (setq pro (match-string 1 string) | |
6573 | pro-point (+ (point) (match-beginning 1))) | |
f32b3b91 CD |
6574 | (if (and (idlwave-skip-object) |
6575 | (setq string (buffer-substring (point) pos)) | |
4b1aaa8b PE |
6576 | (string-match |
6577 | "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" | |
52a244eb | 6578 | string)) |
f32b3b91 CD |
6579 | (setq pro (if (match-beginning 4) |
6580 | (match-string 4 string)) | |
6581 | pro-point (if (match-beginning 4) | |
6582 | (+ (point) (match-beginning 4)) | |
6583 | pos) | |
76959b77 | 6584 | arrow-start (copy-marker (+ (point) (match-beginning 1))) |
f32b3b91 CD |
6585 | class (or (match-string 3 string) t))))) |
6586 | (list (idlwave-sintern-routine-or-method pro class) | |
6587 | (idlwave-sintern-class class) | |
6588 | arrow-start | |
6589 | pro-point))) | |
6590 | ||
6591 | (defun idlwave-skip-object () | |
6592 | ;; If there is an object at point, move over it and return t. | |
6593 | (let ((pos (point))) | |
6594 | (if (catch 'exit | |
6595 | (save-excursion | |
6596 | (skip-chars-forward " ") ; white space | |
6597 | (skip-chars-forward "*") ; de-reference | |
6598 | (cond | |
6599 | ((looking-at idlwave-identifier) | |
6600 | (goto-char (match-end 0))) | |
6601 | ((eq (following-char) ?\() | |
6602 | nil) | |
6603 | (t (throw 'exit nil))) | |
6604 | (catch 'endwhile | |
6605 | (while t | |
6606 | (cond ((eq (following-char) ?.) | |
6607 | (forward-char 1) | |
6608 | (if (not (looking-at idlwave-identifier)) | |
6609 | (throw 'exit nil)) | |
6610 | (goto-char (match-end 0))) | |
6611 | ((memq (following-char) '(?\( ?\[)) | |
6612 | (condition-case nil | |
6613 | (forward-list 1) | |
6614 | (error (throw 'exit nil)))) | |
6615 | (t (throw 'endwhile t))))) | |
6616 | (if (looking-at "[ \t]*->") | |
6617 | (throw 'exit (setq pos (match-beginning 0))) | |
6618 | (throw 'exit nil)))) | |
6619 | (goto-char pos) | |
6620 | nil))) | |
4b1aaa8b | 6621 | |
f32b3b91 CD |
6622 | (defun idlwave-last-valid-char () |
6623 | "Return the last character before point which is not white or a comment | |
6624 | and also not part of the current identifier. Since we do this in | |
6625 | order to identify places where keywords are, we consider the initial | |
6626 | `/' of a keyword as part of the identifier. | |
6627 | This function is not general, can only be used for completion stuff." | |
6628 | (catch 'exit | |
6629 | (save-excursion | |
6630 | ;; skip the current identifier | |
6631 | (skip-chars-backward "a-zA-Z0-9_$") | |
6632 | ;; also skip a leading slash which might be belong to the keyword | |
6633 | (if (eq (preceding-char) ?/) | |
6634 | (backward-char 1)) | |
6635 | ;; FIXME: does not check if this is a valid identifier | |
6636 | (while t | |
6637 | (skip-chars-backward " \t") | |
6638 | (cond | |
6639 | ((memq (preceding-char) '(?\; ?\$)) (throw 'exit nil)) | |
6640 | ((eq (preceding-char) ?\n) | |
6641 | (beginning-of-line 0) | |
3938cb82 | 6642 | (if (looking-at "\\([^\n]*\\)\\$[ \t]*\\(;[^\n]*\\)?\n") |
f32b3b91 CD |
6643 | ;; continuation line |
6644 | (goto-char (match-end 1)) | |
6645 | (throw 'exit nil))) | |
6646 | (t (throw 'exit (preceding-char)))))))) | |
6647 | ||
6648 | (defvar idlwave-complete-after-success-form nil | |
6649 | "A form to evaluate after successful completion.") | |
6650 | (defvar idlwave-complete-after-success-form-force nil | |
6651 | "A form to evaluate after completion selection in *Completions* buffer.") | |
6652 | (defconst idlwave-completion-mark (make-marker) | |
6653 | "A mark pointing to the beginning of the completion string.") | |
8d222148 | 6654 | (defvar completion-highlight-first-word-only) ;XEmacs. |
f32b3b91 CD |
6655 | |
6656 | (defun idlwave-complete-in-buffer (type stype list selector prompt isa | |
52a244eb S |
6657 | &optional prepare-display-function |
6658 | special-selector) | |
f32b3b91 | 6659 | "Perform TYPE completion of word before point against LIST. |
76959b77 | 6660 | SELECTOR is the PREDICATE argument for the completion function. Show |
52a244eb | 6661 | PROMPT in echo area. TYPE is one of the intern types, e.g. 'function, |
5a0c3f56 | 6662 | 'procedure, 'class-tag, 'keyword, 'sysvar, etc. SPECIAL-SELECTOR is |
52a244eb S |
6663 | used only once, for `all-completions', and can be used to, e.g., |
6664 | accumulate information on matching completions." | |
f32b3b91 CD |
6665 | (let* ((completion-ignore-case t) |
6666 | beg (end (point)) slash part spart completion all-completions | |
6667 | dpart dcompletion) | |
6668 | ||
6669 | (unless list | |
6670 | (error (concat prompt ": No completions available"))) | |
6671 | ||
6672 | ;; What is already in the buffer? | |
6673 | (save-excursion | |
6674 | (skip-chars-backward "a-zA-Z0-9_$") | |
6675 | (setq slash (eq (preceding-char) ?/) | |
6676 | beg (point) | |
6677 | idlwave-complete-after-success-form | |
6678 | (list 'idlwave-after-successful-completion | |
6679 | (list 'quote type) slash beg) | |
6680 | idlwave-complete-after-success-form-force | |
6681 | (list 'idlwave-after-successful-completion | |
6682 | (list 'quote type) slash (list 'quote 'force)))) | |
6683 | ||
6684 | ;; Try a completion | |
6685 | (setq part (buffer-substring beg end) | |
6686 | dpart (downcase part) | |
6687 | spart (idlwave-sintern stype part) | |
6688 | completion (try-completion part list selector) | |
52a244eb S |
6689 | dcompletion (if (stringp completion) (downcase completion)) |
6690 | idlwave-completion-help-links nil) | |
f32b3b91 CD |
6691 | (cond |
6692 | ((null completion) | |
6693 | ;; nothing available. | |
76959b77 | 6694 | (error (concat prompt ": no completion for \"%s\"") part)) |
f32b3b91 CD |
6695 | ((and (not (equal dpart dcompletion)) |
6696 | (not (eq t completion))) | |
6697 | ;; We can add something | |
6698 | (delete-region beg end) | |
8d222148 SM |
6699 | (insert (if (and (string= part dpart) |
6700 | (or (not (string= part "")) | |
6701 | idlwave-complete-empty-string-as-lower-case) | |
6702 | (not idlwave-completion-force-default-case)) | |
6703 | dcompletion | |
6704 | completion)) | |
f32b3b91 CD |
6705 | (if (eq t (try-completion completion list selector)) |
6706 | ;; Now this is a unique match | |
6707 | (idlwave-after-successful-completion type slash beg)) | |
6708 | t) | |
6709 | ((or (eq completion t) | |
52a244eb | 6710 | (and (= 1 (length (setq all-completions |
f32b3b91 | 6711 | (idlwave-uniquify |
4b1aaa8b PE |
6712 | (all-completions part list |
6713 | (or special-selector | |
52a244eb S |
6714 | selector)))))) |
6715 | (equal dpart dcompletion))) | |
f32b3b91 CD |
6716 | ;; This is already complete |
6717 | (idlwave-after-successful-completion type slash beg) | |
6718 | (message "%s is already the complete %s" part isa) | |
6719 | nil) | |
4b1aaa8b | 6720 | (t |
f32b3b91 CD |
6721 | ;; We cannot add something - offer a list. |
6722 | (message "Making completion list...") | |
4b1aaa8b | 6723 | |
52a244eb | 6724 | (unless idlwave-completion-help-links ; already set somewhere? |
9001c33f GM |
6725 | (mapc (lambda (x) ; Pass link prop through to highlight-linked |
6726 | (let ((link (get-text-property 0 'link (car x)))) | |
6727 | (if link | |
6728 | (push (cons (car x) link) | |
6729 | idlwave-completion-help-links)))) | |
6730 | list)) | |
f32b3b91 | 6731 | (let* ((list all-completions) |
05a1abfc | 6732 | ;; "complete" means, this is already a valid completion |
f32b3b91 | 6733 | (complete (memq spart all-completions)) |
52a244eb | 6734 | (completion-highlight-first-word-only t)) ; XEmacs |
8d222148 SM |
6735 | ;; (completion-fixup-function ; Emacs |
6736 | ;; (lambda () (and (eq (preceding-char) ?>) | |
6737 | ;; (re-search-backward " <" beg t))))) | |
4b1aaa8b | 6738 | |
f32b3b91 CD |
6739 | (setq list (sort list (lambda (a b) |
6740 | (string< (downcase a) (downcase b))))) | |
6741 | (if prepare-display-function | |
6742 | (setq list (funcall prepare-display-function list))) | |
6743 | (if (and (string= part dpart) | |
6744 | (or (not (string= part "")) | |
6745 | idlwave-complete-empty-string-as-lower-case) | |
6746 | (not idlwave-completion-force-default-case)) | |
6747 | (setq list (mapcar (lambda (x) | |
4b1aaa8b | 6748 | (if (listp x) |
f32b3b91 CD |
6749 | (setcar x (downcase (car x))) |
6750 | (setq x (downcase x))) | |
6751 | x) | |
6752 | list))) | |
6753 | (idlwave-display-completion-list list prompt beg complete)) | |
6754 | t)))) | |
6755 | ||
6756 | (defun idlwave-complete-class () | |
6757 | "Complete a class at point." | |
6758 | (interactive) | |
6759 | ;; Call `idlwave-routines' to make sure the class list will be available | |
6760 | (idlwave-routines) | |
15e42531 CD |
6761 | ;; Check for the special case of completing empty string after pro/function |
6762 | (if (let ((case-fold-search t)) | |
6763 | (save-excursion | |
6764 | (and | |
6765 | (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" | |
6766 | (- (point) 15) t) | |
6767 | (goto-char (point-min)) | |
4b1aaa8b | 6768 | (re-search-forward |
15e42531 CD |
6769 | "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) |
6770 | ;; Yank the full class specification | |
6771 | (insert (match-string 2)) | |
52a244eb | 6772 | ;; Do the completion, using list gathered from `idlwave-routines' |
4b1aaa8b PE |
6773 | (idlwave-complete-in-buffer |
6774 | 'class 'class (idlwave-class-alist) nil | |
52a244eb | 6775 | "Select a class" "class" |
8d222148 SM |
6776 | (lambda (list) ;; Push it to help-links if system help available |
6777 | (mapcar (lambda (x) | |
6778 | (let* ((entry (idlwave-class-info x)) | |
6779 | (link (nth 1 (assq 'link entry)))) | |
6780 | (if link (push (cons x link) | |
6781 | idlwave-completion-help-links)) | |
6782 | x)) | |
6783 | list))))) | |
f32b3b91 | 6784 | |
76959b77 | 6785 | (defun idlwave-attach-classes (list type show-classes) |
05a1abfc | 6786 | ;; Attach the proper class list to a LIST of completion items. |
76959b77 S |
6787 | ;; TYPE, when 'kwd, shows classes for method keywords, when |
6788 | ;; 'class-tag, for class tags, and otherwise for methods. | |
f32b3b91 | 6789 | ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. |
76959b77 S |
6790 | (if (or (null show-classes) ; don't want to see classes |
6791 | (null class-selector) ; not a method call | |
4b1aaa8b | 6792 | (and |
76959b77 S |
6793 | (stringp class-selector) ; the class is already known |
6794 | (not super-classes))) ; no possibilities for inheritance | |
6795 | ;; In these cases, we do not have to do anything | |
6796 | list | |
05a1abfc CD |
6797 | (let* ((do-prop (and (>= show-classes 0) |
6798 | (>= emacs-major-version 21))) | |
f32b3b91 | 6799 | (do-buf (not (= show-classes 0))) |
76959b77 | 6800 | ;; (do-dots (featurep 'xemacs)) |
05a1abfc | 6801 | (do-dots t) |
76959b77 | 6802 | (inherit (if (and (not (eq type 'class-tag)) super-classes) |
05a1abfc | 6803 | (cons class-selector super-classes))) |
f32b3b91 CD |
6804 | (max (abs show-classes)) |
6805 | (lmax (if do-dots (apply 'max (mapcar 'length list)))) | |
6806 | classes nclasses class-info space) | |
4b1aaa8b | 6807 | (mapcar |
f32b3b91 CD |
6808 | (lambda (x) |
6809 | ;; get the classes | |
76959b77 S |
6810 | (if (eq type 'class-tag) |
6811 | ;; Just one class for tags | |
6812 | (setq classes | |
4b1aaa8b | 6813 | (list |
76959b77 | 6814 | (idlwave-class-or-superclass-with-tag class-selector x))) |
52a244eb | 6815 | ;; Multiple classes for method or method-keyword |
76959b77 S |
6816 | (setq classes |
6817 | (if (eq type 'kwd) | |
6818 | (idlwave-all-method-keyword-classes | |
6819 | method-selector x type-selector) | |
6820 | (idlwave-all-method-classes x type-selector))) | |
6821 | (if inherit | |
4b1aaa8b | 6822 | (setq classes |
76959b77 S |
6823 | (delq nil |
6824 | (mapcar (lambda (x) (if (memq x inherit) x nil)) | |
6825 | classes))))) | |
f32b3b91 CD |
6826 | (setq nclasses (length classes)) |
6827 | ;; Make the separator between item and class-info | |
6828 | (if do-dots | |
6829 | (setq space (concat " " (make-string (- lmax (length x)) ?.))) | |
6830 | (setq space " ")) | |
6831 | (if do-buf | |
6832 | ;; We do want info in the buffer | |
6833 | (if (<= nclasses max) | |
6834 | (setq class-info (concat | |
6835 | space | |
6836 | "<" (mapconcat 'identity classes ",") ">")) | |
6837 | (setq class-info (format "%s<%d classes>" space nclasses))) | |
6838 | (setq class-info nil)) | |
6839 | (when do-prop | |
6840 | ;; We do want properties | |
6841 | (setq x (copy-sequence x)) | |
6842 | (put-text-property 0 (length x) | |
52a244eb S |
6843 | 'help-echo (mapconcat 'identity classes " ") |
6844 | x)) | |
f32b3b91 CD |
6845 | (if class-info |
6846 | (list x class-info) | |
6847 | x)) | |
6848 | list)))) | |
6849 | ||
6850 | (defun idlwave-attach-method-classes (list) | |
6851 | ;; Call idlwave-attach-classes with method parameters | |
76959b77 | 6852 | (idlwave-attach-classes list 'method idlwave-completion-show-classes)) |
f32b3b91 CD |
6853 | (defun idlwave-attach-keyword-classes (list) |
6854 | ;; Call idlwave-attach-classes with keyword parameters | |
76959b77 S |
6855 | (idlwave-attach-classes list 'kwd idlwave-completion-show-classes)) |
6856 | (defun idlwave-attach-class-tag-classes (list) | |
6857 | ;; Call idlwave-attach-classes with class structure tags | |
6858 | (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes)) | |
4b1aaa8b | 6859 | |
f32b3b91 CD |
6860 | |
6861 | ;;---------------------------------------------------------------------- | |
6862 | ;;---------------------------------------------------------------------- | |
6863 | ;;---------------------------------------------------------------------- | |
6864 | ;;---------------------------------------------------------------------- | |
6865 | ;;---------------------------------------------------------------------- | |
0b03a950 GM |
6866 | (when (featurep 'xemacs) |
6867 | (defvar rtn) | |
6868 | (defun idlwave-pset (item) | |
6869 | (set 'rtn item))) | |
5e72c6b2 S |
6870 | |
6871 | (defun idlwave-popup-select (ev list title &optional sort) | |
6872 | "Select an item in LIST with a popup menu. | |
6873 | TITLE is the title to put atop the popup. If SORT is non-nil, | |
5a0c3f56 | 6874 | sort the list before displaying." |
5e72c6b2 | 6875 | (let ((maxpopup idlwave-max-popup-menu-items) |
8d222148 | 6876 | rtn menu) |
5e72c6b2 S |
6877 | (cond ((null list)) |
6878 | ((= 1 (length list)) | |
6879 | (setq rtn (car list))) | |
6880 | ((featurep 'xemacs) | |
4b1aaa8b | 6881 | (if sort (setq list (sort list (lambda (a b) |
5e72c6b2 S |
6882 | (string< (upcase a) (upcase b)))))) |
6883 | (setq menu | |
6884 | (append (list title) | |
6885 | (mapcar (lambda (x) (vector x (list 'idlwave-pset | |
6886 | x))) | |
6887 | list))) | |
6888 | (setq menu (idlwave-split-menu-xemacs menu maxpopup)) | |
8d222148 SM |
6889 | (let ((resp (get-popup-menu-response menu))) |
6890 | (funcall (event-function resp) (event-object resp)))) | |
5e72c6b2 | 6891 | (t |
4b1aaa8b | 6892 | (if sort (setq list (sort list (lambda (a b) |
5e72c6b2 S |
6893 | (string< (upcase a) (upcase b)))))) |
6894 | (setq menu (cons title | |
6895 | (list | |
6896 | (append (list "") | |
6897 | (mapcar (lambda(x) (cons x x)) list))))) | |
6898 | (setq menu (idlwave-split-menu-emacs menu maxpopup)) | |
6899 | (setq rtn (x-popup-menu ev menu)))) | |
6900 | rtn)) | |
6901 | ||
6902 | (defun idlwave-split-menu-xemacs (menu N) | |
6903 | "Split the MENU into submenus of maximum length N." | |
6904 | (if (<= (length menu) (1+ N)) | |
6905 | ;; No splitting needed | |
6906 | menu | |
6907 | (let* ((title (car menu)) | |
6908 | (entries (cdr menu)) | |
6909 | (menu (list title)) | |
6910 | (cnt 0) | |
6911 | (nextmenu nil)) | |
6912 | (while entries | |
6913 | (while (and entries (< cnt N)) | |
6914 | (setq cnt (1+ cnt) | |
6915 | nextmenu (cons (car entries) nextmenu) | |
6916 | entries (cdr entries))) | |
6917 | (setq nextmenu (nreverse nextmenu)) | |
6918 | (setq nextmenu (cons (format "%s...%s" | |
6919 | (aref (car nextmenu) 0) | |
6920 | (aref (nth (1- cnt) nextmenu) 0)) | |
6921 | nextmenu)) | |
6922 | (setq menu (cons nextmenu menu) | |
6923 | nextmenu nil | |
6924 | cnt 0)) | |
6925 | (nreverse menu)))) | |
6926 | ||
6927 | (defun idlwave-split-menu-emacs (menu N) | |
6928 | "Split the MENU into submenus of maximum length N." | |
6929 | (if (<= (length (nth 1 menu)) (1+ N)) | |
6930 | ;; No splitting needed | |
6931 | menu | |
6932 | (let* ((title (car menu)) | |
6933 | (entries (cdr (nth 1 menu))) | |
6934 | (menu nil) | |
6935 | (cnt 0) | |
6936 | (nextmenu nil)) | |
6937 | (while entries | |
6938 | (while (and entries (< cnt N)) | |
6939 | (setq cnt (1+ cnt) | |
6940 | nextmenu (cons (car entries) nextmenu) | |
6941 | entries (cdr entries))) | |
6942 | (setq nextmenu (nreverse nextmenu)) | |
6943 | (prin1 nextmenu) | |
6944 | (setq nextmenu (cons (format "%s...%s" | |
6945 | (car (car nextmenu)) | |
6946 | (car (nth (1- cnt) nextmenu))) | |
6947 | nextmenu)) | |
6948 | (setq menu (cons nextmenu menu) | |
6949 | nextmenu nil | |
6950 | cnt 0)) | |
6951 | (setq menu (nreverse menu)) | |
6952 | (setq menu (cons title menu)) | |
6953 | menu))) | |
f32b3b91 | 6954 | |
15e42531 CD |
6955 | (defvar idlwave-completion-setup-hook nil) |
6956 | ||
f32b3b91 CD |
6957 | (defun idlwave-scroll-completions (&optional message) |
6958 | "Scroll the completion window on this frame." | |
6959 | (let ((cwin (get-buffer-window "*Completions*" 'visible)) | |
6960 | (win (selected-window))) | |
6961 | (unwind-protect | |
6962 | (progn | |
6963 | (select-window cwin) | |
6964 | (condition-case nil | |
6965 | (scroll-up) | |
6966 | (error (if (and (listp last-command) | |
6967 | (nth 2 last-command)) | |
6968 | (progn | |
6969 | (select-window win) | |
6970 | (eval idlwave-complete-after-success-form)) | |
6971 | (set-window-start cwin (point-min))))) | |
274f1353 | 6972 | (and message (message "%s" message))) |
f32b3b91 CD |
6973 | (select-window win)))) |
6974 | ||
6975 | (defun idlwave-display-completion-list (list &optional message beg complete) | |
6976 | "Display the completions in LIST in the completions buffer and echo MESSAGE." | |
6977 | (unless (and (get-buffer-window "*Completions*") | |
6978 | (idlwave-local-value 'idlwave-completion-p "*Completions*")) | |
6979 | (move-marker idlwave-completion-mark beg) | |
6980 | (setq idlwave-before-completion-wconf (current-window-configuration))) | |
6981 | ||
6982 | (if (featurep 'xemacs) | |
4b1aaa8b | 6983 | (idlwave-display-completion-list-xemacs |
15e42531 | 6984 | list) |
f32b3b91 CD |
6985 | (idlwave-display-completion-list-emacs list)) |
6986 | ||
6987 | ;; Store a special value in `this-command'. When `idlwave-complete' | |
6988 | ;; finds this in `last-command', it will scroll the *Completions* buffer. | |
6989 | (setq this-command (list 'idlwave-display-completion-list message complete)) | |
6990 | ||
6991 | ;; Mark the completions buffer as created by cib | |
6992 | (idlwave-set-local 'idlwave-completion-p t "*Completions*") | |
6993 | ||
6994 | ;; Fontify the classes | |
6995 | (if (and idlwave-completion-fontify-classes | |
6996 | (consp (car list))) | |
6997 | (idlwave-completion-fontify-classes)) | |
6998 | ||
15e42531 CD |
6999 | ;; Run the hook |
7000 | (run-hooks 'idlwave-completion-setup-hook) | |
7001 | ||
f32b3b91 | 7002 | ;; Display the message |
274f1353 | 7003 | (message "%s" (or message "Making completion list...done"))) |
f32b3b91 CD |
7004 | |
7005 | (defun idlwave-choose (function &rest args) | |
7006 | "Call FUNCTION as a completion chooser and pass ARGS to it." | |
7007 | (let ((completion-ignore-case t)) ; install correct value | |
7008 | (apply function args)) | |
175069ef | 7009 | (if (and (derived-mode-p 'idlwave-shell-mode) |
15e42531 CD |
7010 | (boundp 'font-lock-mode) |
7011 | (not font-lock-mode)) | |
52a244eb | 7012 | ;; For the shell, remove the fontification of the word before point |
15e42531 CD |
7013 | (let ((beg (save-excursion |
7014 | (skip-chars-backward "a-zA-Z0-9_") | |
7015 | (point)))) | |
7016 | (remove-text-properties beg (point) '(face nil)))) | |
f32b3b91 CD |
7017 | (eval idlwave-complete-after-success-form-force)) |
7018 | ||
76959b77 S |
7019 | (defun idlwave-keyboard-quit () |
7020 | (interactive) | |
7021 | (unwind-protect | |
7022 | (if (eq (car-safe last-command) 'idlwave-display-completion-list) | |
7023 | (idlwave-restore-wconf-after-completion)) | |
7024 | (keyboard-quit))) | |
7025 | ||
f32b3b91 CD |
7026 | (defun idlwave-restore-wconf-after-completion () |
7027 | "Restore the old (before completion) window configuration." | |
7028 | (and idlwave-completion-restore-window-configuration | |
7029 | idlwave-before-completion-wconf | |
7030 | (set-window-configuration idlwave-before-completion-wconf))) | |
7031 | ||
52a244eb S |
7032 | (defun idlwave-one-key-select (sym prompt delay) |
7033 | "Make the user select an element from the alist in the variable SYM. | |
7034 | The keys of the alist are expected to be strings. The function returns the | |
7035 | car of the selected association. | |
d9271f41 | 7036 | To do this, PROMPT is displayed and the user must hit a letter key to |
52a244eb S |
7037 | select an entry. If the user does not reply within DELAY seconds, a help |
7038 | window with the options is displayed automatically. | |
7039 | The key which is associated with each option is generated automatically. | |
7040 | First, the strings are checked for preselected keys, like in \"[P]rint\". | |
7041 | If these don't exist, a letter in the string is automatically selected." | |
7042 | (let* ((alist (symbol-value sym)) | |
7043 | (temp-buffer-show-hook (if (fboundp 'fit-window-to-buffer) | |
7044 | '(fit-window-to-buffer))) | |
7045 | keys-alist char) | |
7046 | ;; First check the cache | |
7047 | (if (and (eq (symbol-value sym) (get sym :one-key-alist-last))) | |
7048 | (setq keys-alist (get sym :one-key-alist-cache)) | |
7049 | ;; Need to make new list | |
7050 | (setq keys-alist (idlwave-make-one-key-alist alist)) | |
7051 | (put sym :one-key-alist-cache keys-alist) | |
7052 | (put sym :one-key-alist-last alist)) | |
7053 | ;; Display prompt and wait for quick reply | |
7054 | (message "%s[%s]" prompt | |
7055 | (mapconcat (lambda(x) (char-to-string (car x))) | |
7056 | keys-alist "")) | |
7057 | (if (sit-for delay) | |
7058 | ;; No quick reply: Show help | |
7059 | (save-window-excursion | |
7060 | (with-output-to-temp-buffer "*Completions*" | |
26b51db5 JB |
7061 | (dolist (x keys-alist) |
7062 | (princ (nth 1 x)) | |
7063 | (princ "\n"))) | |
52a244eb S |
7064 | (setq char (read-char))) |
7065 | (setq char (read-char))) | |
7066 | (message nil) | |
7067 | ;; Return the selected result | |
7068 | (nth 2 (assoc char keys-alist)))) | |
7069 | ||
7070 | ;; Used for, e.g., electric debug super-examine. | |
7071 | (defun idlwave-make-one-key-alist (alist) | |
7072 | "Make an alist for single key selection." | |
7073 | (let ((l alist) keys-alist name start char help | |
7074 | (cnt 0) | |
7075 | (case-fold-search nil)) | |
7076 | (while l | |
7077 | (setq name (car (car l)) | |
7078 | l (cdr l)) | |
7079 | (catch 'exit | |
7080 | ;; First check if the configuration predetermined a key | |
7081 | (if (string-match "\\[\\(.\\)\\]" name) | |
7082 | (progn | |
7083 | (setq char (string-to-char (downcase (match-string 1 name))) | |
7084 | help (format "%c: %s" char name) | |
7085 | keys-alist (cons (list char help name) keys-alist)) | |
7086 | (throw 'exit t))) | |
7087 | ;; Then check for capital letters | |
7088 | (setq start 0) | |
7089 | (while (string-match "[A-Z]" name start) | |
7090 | (setq start (match-end 0) | |
7091 | char (string-to-char (downcase (match-string 0 name)))) | |
7092 | (if (not (assoc char keys-alist)) | |
7093 | (progn | |
7094 | (setq help (format "%c: %s" char | |
7095 | (replace-match | |
7096 | (concat "[" (match-string 0 name) "]") | |
7097 | t t name)) | |
7098 | keys-alist (cons (list char help name) keys-alist)) | |
7099 | (throw 'exit t)))) | |
7100 | ;; Now check for lowercase letters | |
7101 | (setq start 0) | |
7102 | (while (string-match "[a-z]" name start) | |
7103 | (setq start (match-end 0) | |
7104 | char (string-to-char (match-string 0 name))) | |
7105 | (if (not (assoc char keys-alist)) | |
7106 | (progn | |
7107 | (setq help (format "%c: %s" char | |
7108 | (replace-match | |
7109 | (concat "[" (match-string 0 name) "]") | |
7110 | t t name)) | |
7111 | keys-alist (cons (list char help name) keys-alist)) | |
7112 | (throw 'exit t)))) | |
7113 | ;; Bummer, nothing found! Use a stupid number | |
7114 | (setq char (string-to-char (int-to-string (setq cnt (1+ cnt)))) | |
7115 | help (format "%c: %s" char name) | |
7116 | keys-alist (cons (list char help name) keys-alist)))) | |
7117 | (nreverse keys-alist))) | |
7118 | ||
f32b3b91 CD |
7119 | (defun idlwave-set-local (var value &optional buffer) |
7120 | "Set the buffer-local value of VAR in BUFFER to VALUE." | |
9a529312 | 7121 | (with-current-buffer (or buffer (current-buffer)) |
f32b3b91 CD |
7122 | (set (make-local-variable var) value))) |
7123 | ||
7124 | (defun idlwave-local-value (var &optional buffer) | |
7125 | "Return the value of VAR in BUFFER, but only if VAR is local to BUFFER." | |
9a529312 | 7126 | (with-current-buffer (or buffer (current-buffer)) |
f32b3b91 CD |
7127 | (and (local-variable-p var (current-buffer)) |
7128 | (symbol-value var)))) | |
7129 | ||
15e42531 CD |
7130 | ;; In XEmacs, we can use :activate-callback directly to advice the |
7131 | ;; choose functions. We use the private keymap only for the online | |
7132 | ;; help feature. | |
f32b3b91 | 7133 | |
15e42531 | 7134 | (defvar idlwave-completion-map nil |
5a0c3f56 | 7135 | "Keymap for `completion-list-mode' with `idlwave-complete'.") |
15e42531 CD |
7136 | |
7137 | (defun idlwave-display-completion-list-xemacs (list &rest cl-args) | |
f32b3b91 | 7138 | (with-output-to-temp-buffer "*Completions*" |
15e42531 CD |
7139 | (apply 'display-completion-list list |
7140 | ':activate-callback 'idlwave-default-choose-completion | |
7141 | cl-args)) | |
9a529312 | 7142 | (with-current-buffer "*Completions*" |
15e42531 CD |
7143 | (use-local-map |
7144 | (or idlwave-completion-map | |
7145 | (setq idlwave-completion-map | |
7146 | (idlwave-make-modified-completion-map-xemacs | |
7147 | (current-local-map))))))) | |
f32b3b91 CD |
7148 | |
7149 | (defun idlwave-default-choose-completion (&rest args) | |
7150 | "Execute `default-choose-completion' and then restore the win-conf." | |
7151 | (apply 'idlwave-choose 'default-choose-completion args)) | |
7152 | ||
15e42531 CD |
7153 | (defun idlwave-make-modified-completion-map-xemacs (old-map) |
7154 | "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." | |
7155 | (let ((new-map (copy-keymap old-map))) | |
7156 | (define-key new-map [button3up] 'idlwave-mouse-completion-help) | |
7157 | (define-key new-map [button3] (lambda () | |
7158 | (interactive) | |
7159 | (setq this-command last-command))) | |
7160 | new-map)) | |
f32b3b91 | 7161 | |
76959b77 | 7162 | ;; In Emacs we also replace keybindings in the completion |
15e42531 | 7163 | ;; map in order to install our wrappers. |
f32b3b91 CD |
7164 | |
7165 | (defun idlwave-display-completion-list-emacs (list) | |
7166 | "Display completion list and install the choose wrappers." | |
7167 | (with-output-to-temp-buffer "*Completions*" | |
7168 | (display-completion-list list)) | |
9a529312 | 7169 | (with-current-buffer "*Completions*" |
f32b3b91 CD |
7170 | (use-local-map |
7171 | (or idlwave-completion-map | |
7172 | (setq idlwave-completion-map | |
15e42531 CD |
7173 | (idlwave-make-modified-completion-map-emacs |
7174 | (current-local-map))))))) | |
7175 | ||
7176 | (defun idlwave-make-modified-completion-map-emacs (old-map) | |
f32b3b91 CD |
7177 | "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." |
7178 | (let ((new-map (copy-keymap old-map))) | |
4b1aaa8b | 7179 | (substitute-key-definition |
f32b3b91 CD |
7180 | 'choose-completion 'idlwave-choose-completion new-map) |
7181 | (substitute-key-definition | |
7182 | 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) | |
15e42531 | 7183 | (define-key new-map [mouse-3] 'idlwave-mouse-completion-help) |
f32b3b91 CD |
7184 | new-map)) |
7185 | ||
7186 | (defun idlwave-choose-completion (&rest args) | |
7187 | "Choose the completion that point is in or next to." | |
7188 | (interactive) | |
7189 | (apply 'idlwave-choose 'choose-completion args)) | |
7190 | ||
7191 | (defun idlwave-mouse-choose-completion (&rest args) | |
7192 | "Click on an alternative in the `*Completions*' buffer to choose it." | |
7193 | (interactive "e") | |
7194 | (apply 'idlwave-choose 'mouse-choose-completion args)) | |
7195 | ||
7196 | ;;---------------------------------------------------------------------- | |
7197 | ;;---------------------------------------------------------------------- | |
7198 | ||
05a1abfc | 7199 | ;;; ------------------------------------------------------------------------ |
8350f087 | 7200 | ;;; Structure parsing code, and code to manage class info |
05a1abfc CD |
7201 | |
7202 | ;; | |
7203 | ;; - Go again over the documentation how to write a completion | |
7204 | ;; plugin. It is in self.el, but currently still very bad. | |
4b1aaa8b PE |
7205 | ;; This could be in a separate file in the distribution, or |
7206 | ;; in an appendix for the manual. | |
52a244eb S |
7207 | |
7208 | (defvar idlwave-struct-skip | |
7209 | "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*" | |
5a0c3f56 | 7210 | "Regexp for skipping continued blank or comment-only lines in structures.") |
52a244eb S |
7211 | |
7212 | (defvar idlwave-struct-tag-regexp | |
7213 | (concat "[{,]" ;leading comma/brace | |
7214 | idlwave-struct-skip ; 4 groups | |
7215 | "\\([a-zA-Z][a-zA-Z0-9_]*\\)" ;the tag itself, group 5 | |
7216 | "[ \t]*:") ; the final colon | |
7217 | "Regexp for structure tags.") | |
05a1abfc CD |
7218 | |
7219 | (defun idlwave-struct-tags () | |
7220 | "Return a list of all tags in the structure defined at point. | |
7221 | Point is expected just before the opening `{' of the struct definition." | |
7222 | (save-excursion | |
7223 | (let* ((borders (idlwave-struct-borders)) | |
7224 | (beg (car borders)) | |
7225 | (end (cdr borders)) | |
7226 | tags) | |
7227 | (goto-char beg) | |
52a244eb S |
7228 | (save-restriction |
7229 | (narrow-to-region beg end) | |
7230 | (while (re-search-forward idlwave-struct-tag-regexp end t) | |
7231 | ;; Check if we are still on the top level of the structure. | |
7232 | (if (and (condition-case nil (progn (up-list -1) t) (error nil)) | |
7233 | (= (point) beg)) | |
7234 | (push (match-string-no-properties 5) tags)) | |
7235 | (goto-char (match-end 0)))) | |
7236 | (nreverse tags)))) | |
05a1abfc | 7237 | |
76959b77 S |
7238 | (defun idlwave-find-struct-tag (tag) |
7239 | "Find a given TAG in the structure defined at point." | |
7240 | (let* ((borders (idlwave-struct-borders)) | |
76959b77 S |
7241 | (end (cdr borders)) |
7242 | (case-fold-search t)) | |
4b1aaa8b | 7243 | (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") |
76959b77 S |
7244 | end t))) |
7245 | ||
05a1abfc CD |
7246 | (defun idlwave-struct-inherits () |
7247 | "Return a list of all `inherits' names in the struct at point. | |
7248 | Point is expected just before the opening `{' of the struct definition." | |
7249 | (save-excursion | |
7250 | (let* ((borders (idlwave-struct-borders)) | |
7251 | (beg (car borders)) | |
7252 | (end (cdr borders)) | |
7253 | (case-fold-search t) | |
7254 | names) | |
7255 | (goto-char beg) | |
52a244eb S |
7256 | (save-restriction |
7257 | (narrow-to-region beg end) | |
4b1aaa8b | 7258 | (while (re-search-forward |
52a244eb S |
7259 | (concat "[{,]" ;leading comma/brace |
7260 | idlwave-struct-skip ; 4 groups | |
7261 | "inherits" ; The INHERITS tag | |
7262 | idlwave-struct-skip ; 4 more | |
7263 | "\\([a-zA-Z][a-zA-Z0-9_]*\\)") ; The super-group, #9 | |
7264 | end t) | |
7265 | ;; Check if we are still on the top level of the structure. | |
7266 | (if (and (condition-case nil (progn (up-list -1) t) (error nil)) | |
7267 | (= (point) beg)) | |
7268 | (push (match-string-no-properties 9) names)) | |
7269 | (goto-char (match-end 0)))) | |
05a1abfc CD |
7270 | (nreverse names)))) |
7271 | ||
5e72c6b2 | 7272 | (defun idlwave-in-structure () |
52a244eb | 7273 | "Return t if point is inside an IDL structure definition." |
5e72c6b2 S |
7274 | (let ((beg (point))) |
7275 | (save-excursion | |
7276 | (if (not (or (idlwave-in-comment) (idlwave-in-quote))) | |
7277 | (if (idlwave-find-structure-definition nil nil 'back) | |
7278 | (let ((borders (idlwave-struct-borders))) | |
7279 | (or (= (car borders) (cdr borders)) ;; struct not yet closed... | |
7280 | (and (> beg (car borders)) (< beg (cdr borders)))))))))) | |
05a1abfc CD |
7281 | |
7282 | (defun idlwave-struct-borders () | |
7283 | "Return the borders of the {...} after point as a cons cell." | |
7284 | (let (beg) | |
7285 | (save-excursion | |
7286 | (skip-chars-forward "^{") | |
7287 | (setq beg (point)) | |
7288 | (condition-case nil (forward-list 1) | |
7289 | (error (goto-char beg))) | |
7290 | (cons beg (point))))) | |
7291 | ||
7292 | (defun idlwave-find-structure-definition (&optional var name bound) | |
5a0c3f56 JB |
7293 | "Search forward for a structure definition. |
7294 | If VAR is non-nil, search for a structure assigned to variable VAR. | |
7295 | If NAME is non-nil, search for a named structure NAME, if a string, | |
7296 | or a generic named structure otherwise. If BOUND is an integer, limit | |
7297 | the search. If BOUND is the symbol `all', we search first back and | |
7298 | then forward through the entire file. If BOUND is the symbol `back' | |
7299 | we search only backward." | |
76959b77 | 7300 | (let* ((ws "[ \t]*\\(\\$.*\n[ \t]*\\)*") |
05a1abfc CD |
7301 | (case-fold-search t) |
7302 | (lim (if (integerp bound) bound nil)) | |
7303 | (re (concat | |
7304 | (if var | |
7305 | (concat "\\<" (regexp-quote (downcase var)) "\\>" ws) | |
7306 | "\\(\\)") | |
7307 | "=" ws "\\({\\)" | |
4b1aaa8b | 7308 | (if name |
52a244eb | 7309 | (if (stringp name) |
4b1aaa8b | 7310 | (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") |
52a244eb S |
7311 | ;; Just a generic name |
7312 | (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ",")) | |
7313 | "")))) | |
5e72c6b2 | 7314 | (if (or (and (or (eq bound 'all) (eq bound 'back)) |
05a1abfc | 7315 | (re-search-backward re nil t)) |
5e72c6b2 | 7316 | (and (not (eq bound 'back)) (re-search-forward re lim t))) |
52a244eb S |
7317 | (progn |
7318 | (goto-char (match-beginning 3)) | |
7319 | (match-string-no-properties 5))))) | |
7320 | ||
4b1aaa8b | 7321 | (defvar idlwave-class-info nil) |
52a244eb | 7322 | (defvar idlwave-class-reset nil) ; to reset buffer-local classes |
05a1abfc | 7323 | |
05a1abfc | 7324 | (add-hook 'idlwave-update-rinfo-hook |
52a244eb | 7325 | (lambda () (setq idlwave-class-reset t))) |
05a1abfc CD |
7326 | (add-hook 'idlwave-after-load-rinfo-hook |
7327 | (lambda () (setq idlwave-class-info nil))) | |
7328 | ||
7329 | (defun idlwave-class-info (class) | |
7330 | (let (list entry) | |
52a244eb S |
7331 | (if idlwave-class-info |
7332 | (if idlwave-class-reset | |
4b1aaa8b | 7333 | (setq |
52a244eb S |
7334 | idlwave-class-reset nil |
7335 | idlwave-class-info ; Remove any visited in a buffer | |
4b1aaa8b PE |
7336 | (delq nil (mapcar |
7337 | (lambda (x) | |
7338 | (let ((filebuf | |
7339 | (idlwave-class-file-or-buffer | |
52a244eb S |
7340 | (or (cdr (assq 'found-in x)) (car x))))) |
7341 | (if (cdr filebuf) | |
7342 | nil | |
7343 | x))) | |
7344 | idlwave-class-info)))) | |
7345 | ;; Info is nil, put in the system stuff to start. | |
05a1abfc CD |
7346 | (setq idlwave-class-info idlwave-system-class-info) |
7347 | (setq list idlwave-class-info) | |
7348 | (while (setq entry (pop list)) | |
7349 | (idlwave-sintern-class-info entry))) | |
7350 | (setq class (idlwave-sintern-class class)) | |
52a244eb S |
7351 | (or (assq class idlwave-class-info) |
7352 | (progn (idlwave-scan-class-info class) | |
7353 | (assq class idlwave-class-info))))) | |
05a1abfc CD |
7354 | |
7355 | (defun idlwave-sintern-class-info (entry) | |
7356 | "Sintern the class names in a class-info entry." | |
8d222148 | 7357 | (let ((inherits (assq 'inherits entry))) |
05a1abfc CD |
7358 | (setcar entry (idlwave-sintern-class (car entry) 'set)) |
7359 | (if inherits | |
7360 | (setcdr inherits (mapcar (lambda (x) (idlwave-sintern-class x 'set)) | |
7361 | (cdr inherits)))))) | |
7362 | ||
52a244eb | 7363 | (defun idlwave-find-class-definition (class &optional all-hook alt-class) |
5a0c3f56 | 7364 | "Find class structure definition(s). |
52a244eb S |
7365 | If ALL-HOOK is set, find all named structure definitions in a given |
7366 | class__define routine, on which ALL-HOOK will be run. If ALT-CLASS is | |
7367 | set, look for the name__define pro, and inside of it, for the ALT-CLASS | |
5a0c3f56 | 7368 | class/struct definition." |
8d222148 | 7369 | (let ((case-fold-search t) end-lim name) |
52a244eb S |
7370 | (when (re-search-forward |
7371 | (concat "^[ \t]*pro[ \t]+" (downcase class) "__define" "\\>") nil t) | |
7372 | (if all-hook | |
7373 | (progn | |
7374 | ;; For everything there | |
7375 | (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point))) | |
4b1aaa8b | 7376 | (while (setq name |
52a244eb S |
7377 | (idlwave-find-structure-definition nil t end-lim)) |
7378 | (funcall all-hook name))) | |
7379 | (idlwave-find-structure-definition nil (or alt-class class)))))) | |
76959b77 | 7380 | |
52a244eb S |
7381 | |
7382 | (defun idlwave-class-file-or-buffer (class) | |
5a0c3f56 | 7383 | "Find buffer visiting CLASS definition." |
05a1abfc | 7384 | (let* ((pro (concat (downcase class) "__define")) |
52a244eb S |
7385 | (file (idlwave-routine-source-file |
7386 | (nth 3 (idlwave-rinfo-assoc pro 'pro nil | |
7387 | (idlwave-routines)))))) | |
7388 | (cons file (if file (idlwave-get-buffer-visiting file))))) | |
7389 | ||
7390 | ||
7391 | (defun idlwave-scan-class-info (class) | |
5a0c3f56 | 7392 | "Scan all class and named structure info in the class__define pro." |
52a244eb S |
7393 | (let* ((idlwave-auto-routine-info-updates nil) |
7394 | (filebuf (idlwave-class-file-or-buffer class)) | |
7395 | (file (car filebuf)) | |
7396 | (buf (cdr filebuf)) | |
7397 | (class (idlwave-sintern-class class))) | |
7398 | (if (or | |
7399 | (not file) | |
7400 | (and ;; neither a regular file nor a visited buffer | |
7401 | (not buf) | |
7402 | (not (file-regular-p file)))) | |
7403 | nil ; Cannot find the file/buffer to get any info | |
05a1abfc | 7404 | (save-excursion |
52a244eb S |
7405 | (if buf (set-buffer buf) |
7406 | ;; Read the file in temporarily | |
05a1abfc CD |
7407 | (set-buffer (get-buffer-create " *IDLWAVE-tmp*")) |
7408 | (erase-buffer) | |
175069ef | 7409 | (unless (derived-mode-p 'idlwave-mode) |
05a1abfc CD |
7410 | (idlwave-mode)) |
7411 | (insert-file-contents file)) | |
7412 | (save-excursion | |
7413 | (goto-char 1) | |
4b1aaa8b | 7414 | (idlwave-find-class-definition class |
52a244eb S |
7415 | ;; Scan all of the structures found there |
7416 | (lambda (name) | |
7417 | (let* ((this-class (idlwave-sintern-class name)) | |
4b1aaa8b | 7418 | (entry |
52a244eb S |
7419 | (list this-class |
7420 | (cons 'tags (idlwave-struct-tags)) | |
7421 | (cons 'inherits (idlwave-struct-inherits))))) | |
7422 | (if (not (eq this-class class)) | |
7423 | (setq entry (nconc entry (list (cons 'found-in class))))) | |
7424 | (idlwave-sintern-class-info entry) | |
7425 | (push entry idlwave-class-info))))))))) | |
7426 | ||
7427 | (defun idlwave-class-found-in (class) | |
5a0c3f56 | 7428 | "Return the FOUND-IN property of the CLASS." |
52a244eb | 7429 | (cdr (assq 'found-in (idlwave-class-info class)))) |
05a1abfc CD |
7430 | (defun idlwave-class-tags (class) |
7431 | "Return the native tags in CLASS." | |
7432 | (cdr (assq 'tags (idlwave-class-info class)))) | |
7433 | (defun idlwave-class-inherits (class) | |
7434 | "Return the direct superclasses of CLASS." | |
7435 | (cdr (assq 'inherits (idlwave-class-info class)))) | |
7436 | ||
52a244eb | 7437 | |
05a1abfc CD |
7438 | (defun idlwave-all-class-tags (class) |
7439 | "Return a list of native and inherited tags in CLASS." | |
76959b77 S |
7440 | (condition-case err |
7441 | (apply 'append (mapcar 'idlwave-class-tags | |
7442 | (cons class (idlwave-all-class-inherits class)))) | |
4b1aaa8b | 7443 | (error |
76959b77 S |
7444 | (idlwave-class-tag-reset) |
7445 | (error "%s" (error-message-string err))))) | |
7446 | ||
05a1abfc CD |
7447 | |
7448 | (defun idlwave-all-class-inherits (class) | |
7449 | "Return a list of all superclasses of CLASS (recursively expanded). | |
5e72c6b2 | 7450 | The list is cached in `idlwave-class-info' for faster access." |
05a1abfc CD |
7451 | (cond |
7452 | ((not idlwave-support-inheritance) nil) | |
7453 | ((eq class nil) nil) | |
7454 | ((eq class t) nil) | |
7455 | (t | |
7456 | (let ((info (idlwave-class-info class)) | |
7457 | entry) | |
7458 | (if (setq entry (assq 'all-inherits info)) | |
7459 | (cdr entry) | |
76959b77 S |
7460 | ;; Save the depth of inheritance scan to check for circular references |
7461 | (let ((inherits (mapcar (lambda (x) (cons x 0)) | |
7462 | (idlwave-class-inherits class))) | |
05a1abfc CD |
7463 | rtn all-inherits cl) |
7464 | (while inherits | |
7465 | (setq cl (pop inherits) | |
76959b77 S |
7466 | rtn (cons (car cl) rtn) |
7467 | inherits (append (mapcar (lambda (x) | |
7468 | (cons x (1+ (cdr cl)))) | |
7469 | (idlwave-class-inherits (car cl))) | |
7470 | inherits)) | |
7471 | (if (> (cdr cl) 999) | |
7472 | (error | |
7473 | "Class scan: inheritance depth exceeded. Circular inheritance?") | |
7474 | )) | |
05a1abfc CD |
7475 | (setq all-inherits (nreverse rtn)) |
7476 | (nconc info (list (cons 'all-inherits all-inherits))) | |
7477 | all-inherits)))))) | |
7478 | ||
52a244eb | 7479 | (defun idlwave-entry-keywords (entry &optional record-link) |
4b1aaa8b | 7480 | "Return the flat entry keywords alist from routine-info entry. |
52a244eb S |
7481 | If RECORD-LINK is non-nil, the keyword text is copied and a text |
7482 | property indicating the link is added." | |
7483 | (let (kwds) | |
8ffcfb27 | 7484 | (mapc |
4b1aaa8b | 7485 | (lambda (key-list) |
52a244eb S |
7486 | (let ((file (car key-list))) |
7487 | (mapcar (lambda (key-cons) | |
7488 | (let ((key (car key-cons)) | |
7489 | (link (cdr key-cons))) | |
7490 | (when (and record-link file) | |
7491 | (setq key (copy-sequence key)) | |
4b1aaa8b | 7492 | (put-text-property |
52a244eb | 7493 | 0 (length key) |
4b1aaa8b PE |
7494 | 'link |
7495 | (concat | |
7496 | file | |
7497 | (if link | |
52a244eb S |
7498 | (concat idlwave-html-link-sep |
7499 | (number-to-string link)))) | |
7500 | key)) | |
7501 | (push (list key) kwds))) | |
7502 | (cdr key-list)))) | |
7503 | (nthcdr 5 entry)) | |
7504 | (nreverse kwds))) | |
7505 | ||
7506 | (defun idlwave-entry-find-keyword (entry keyword) | |
5a0c3f56 | 7507 | "Find keyword KEYWORD in entry ENTRY, and return (with link) if set." |
52a244eb S |
7508 | (catch 'exit |
7509 | (mapc | |
4b1aaa8b | 7510 | (lambda (key-list) |
52a244eb S |
7511 | (let ((file (car key-list)) |
7512 | (kwd (assoc keyword (cdr key-list)))) | |
7513 | (when kwd | |
4b1aaa8b | 7514 | (setq kwd (cons (car kwd) |
52a244eb | 7515 | (if (and file (cdr kwd)) |
4b1aaa8b | 7516 | (concat file |
52a244eb S |
7517 | idlwave-html-link-sep |
7518 | (number-to-string (cdr kwd))) | |
7519 | (cdr kwd)))) | |
7520 | (throw 'exit kwd)))) | |
7521 | (nthcdr 5 entry)))) | |
05a1abfc CD |
7522 | |
7523 | ;;========================================================================== | |
7524 | ;; | |
7525 | ;; Completing class structure tags. This is a completion plugin. | |
7526 | ;; The necessary taglist is constructed dynamically | |
7527 | ||
7528 | (defvar idlwave-current-tags-class nil) | |
7529 | (defvar idlwave-current-class-tags nil) | |
7530 | (defvar idlwave-current-native-class-tags nil) | |
76959b77 | 7531 | (defvar idlwave-sint-class-tags nil) |
1a717047 | 7532 | (declare-function idlwave-sintern-class-tag "idlwave" t t) |
76959b77 | 7533 | (idlwave-new-sintern-type 'class-tag) |
05a1abfc | 7534 | (add-to-list 'idlwave-complete-special 'idlwave-complete-class-structure-tag) |
76959b77 | 7535 | (add-hook 'idlwave-update-rinfo-hook 'idlwave-class-tag-reset) |
05a1abfc CD |
7536 | |
7537 | (defun idlwave-complete-class-structure-tag () | |
7538 | "Complete a structure tag on a `self' argument in an object method." | |
7539 | (interactive) | |
7540 | (let ((pos (point)) | |
7541 | (case-fold-search t)) | |
7542 | (if (save-excursion | |
7543 | ;; Check if the context is right | |
52a244eb | 7544 | (skip-chars-backward "a-zA-Z0-9._$") |
05a1abfc CD |
7545 | (and (< (point) (- pos 4)) |
7546 | (looking-at "self\\."))) | |
76959b77 S |
7547 | (let* ((class-selector (nth 2 (idlwave-current-routine))) |
7548 | (super-classes (idlwave-all-class-inherits class-selector))) | |
05a1abfc | 7549 | ;; Check if we are in a class routine |
76959b77 | 7550 | (unless class-selector |
e8af40ee | 7551 | (error "Not in a method procedure or function")) |
05a1abfc | 7552 | ;; Check if we need to update the "current" class |
76959b77 S |
7553 | (if (not (equal class-selector idlwave-current-tags-class)) |
7554 | (idlwave-prepare-class-tag-completion class-selector)) | |
4b1aaa8b | 7555 | (setq idlwave-completion-help-info |
76959b77 | 7556 | (list 'idlwave-complete-class-structure-tag-help |
4b1aaa8b | 7557 | (idlwave-sintern-routine |
76959b77 S |
7558 | (concat class-selector "__define")) |
7559 | nil)) | |
8d222148 | 7560 | ;; FIXME: idlwave-cpl-bold doesn't seem used anywhere. |
05a1abfc CD |
7561 | (let ((idlwave-cpl-bold idlwave-current-native-class-tags)) |
7562 | (idlwave-complete-in-buffer | |
4b1aaa8b | 7563 | 'class-tag 'class-tag |
05a1abfc | 7564 | idlwave-current-class-tags nil |
76959b77 S |
7565 | (format "Select a tag of class %s" class-selector) |
7566 | "class tag" | |
7567 | 'idlwave-attach-class-tag-classes)) | |
05a1abfc CD |
7568 | t) ; return t to skip other completions |
7569 | nil))) | |
7570 | ||
76959b77 | 7571 | (defun idlwave-class-tag-reset () |
05a1abfc CD |
7572 | (setq idlwave-current-tags-class nil)) |
7573 | ||
7574 | (defun idlwave-prepare-class-tag-completion (class) | |
7575 | "Find and parse the necessary class definitions for class structure tags." | |
76959b77 | 7576 | (setq idlwave-sint-class-tags nil) |
05a1abfc CD |
7577 | (setq idlwave-current-tags-class class) |
7578 | (setq idlwave-current-class-tags | |
7579 | (mapcar (lambda (x) | |
76959b77 | 7580 | (list (idlwave-sintern-class-tag x 'set))) |
05a1abfc CD |
7581 | (idlwave-all-class-tags class))) |
7582 | (setq idlwave-current-native-class-tags | |
7583 | (mapcar 'downcase (idlwave-class-tags class)))) | |
7584 | ||
7585 | ;=========================================================================== | |
7586 | ;; | |
7587 | ;; Completing system variables and their structure fields | |
52a244eb | 7588 | ;; This is also a plugin. |
05a1abfc CD |
7589 | |
7590 | (defvar idlwave-sint-sysvars nil) | |
7591 | (defvar idlwave-sint-sysvartags nil) | |
1a717047 GM |
7592 | (declare-function idlwave-sintern-sysvar "idlwave" t t) |
7593 | (declare-function idlwave-sintern-sysvartag "idlwave" t t) | |
05a1abfc CD |
7594 | (idlwave-new-sintern-type 'sysvar) |
7595 | (idlwave-new-sintern-type 'sysvartag) | |
7596 | (add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag) | |
7597 | (add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset) | |
05a1abfc CD |
7598 | (add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist) |
7599 | ||
05a1abfc CD |
7600 | |
7601 | (defun idlwave-complete-sysvar-or-tag () | |
7602 | "Complete a system variable." | |
7603 | (interactive) | |
7604 | (let ((pos (point)) | |
7605 | (case-fold-search t)) | |
7606 | (cond ((save-excursion | |
7607 | ;; Check if the context is right for system variable | |
7608 | (skip-chars-backward "[a-zA-Z0-9_$]") | |
7609 | (equal (char-before) ?!)) | |
7610 | (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help)) | |
4b1aaa8b | 7611 | (idlwave-complete-in-buffer 'sysvar 'sysvar |
05a1abfc CD |
7612 | idlwave-system-variables-alist nil |
7613 | "Select a system variable" | |
7614 | "system variable") | |
7615 | t) ; return t to skip other completions | |
7616 | ((save-excursion | |
7617 | ;; Check if the context is right for sysvar tag | |
52a244eb | 7618 | (skip-chars-backward "a-zA-Z0-9_$.") |
05a1abfc CD |
7619 | (and (equal (char-before) ?!) |
7620 | (looking-at "\\([a-zA-Z][a-zA-Z0-9_$]*\\)\\.") | |
7621 | (<= (match-end 0) pos))) | |
7622 | ;; Complete a system variable tag | |
7623 | (let* ((var (idlwave-sintern-sysvar (match-string 1))) | |
7624 | (entry (assq var idlwave-system-variables-alist)) | |
52a244eb S |
7625 | (tags (cdr (assq 'tags entry)))) |
7626 | (or entry (error "!%s is not a known system variable" var)) | |
05a1abfc CD |
7627 | (or tags (error "System variable !%s is not a structure" var)) |
7628 | (setq idlwave-completion-help-info | |
52a244eb | 7629 | (list 'idlwave-complete-sysvar-tag-help var)) |
4b1aaa8b | 7630 | (idlwave-complete-in-buffer 'sysvartag 'sysvartag |
05a1abfc CD |
7631 | tags nil |
7632 | "Select a system variable tag" | |
7633 | "system variable tag") | |
7634 | t)) ; return t to skip other completions | |
7635 | (t nil)))) | |
7636 | ||
e7c4fb1e | 7637 | (defvar idlw-help-link) ;dynamic variables set by help callback |
05a1abfc | 7638 | (defun idlwave-complete-sysvar-help (mode word) |
52a244eb S |
7639 | (let ((word (or (nth 1 idlwave-completion-help-info) word)) |
7640 | (entry (assoc word idlwave-system-variables-alist))) | |
7641 | (cond | |
7642 | ((eq mode 'test) | |
7643 | (and (stringp word) entry (nth 1 (assq 'link entry)))) | |
7644 | ((eq mode 'set) | |
e7c4fb1e GM |
7645 | ;; Setting dynamic!!! |
7646 | (if entry (setq idlw-help-link (nth 1 (assq 'link entry))))) | |
52a244eb S |
7647 | (t (error "This should not happen"))))) |
7648 | ||
7649 | (defun idlwave-complete-sysvar-tag-help (mode word) | |
7650 | (let* ((var (nth 1 idlwave-completion-help-info)) | |
7651 | (entry (assoc var idlwave-system-variables-alist)) | |
7652 | (tags (cdr (assq 'tags entry))) | |
7653 | (main (nth 1 (assq 'link entry))) | |
8d222148 | 7654 | target) |
52a244eb S |
7655 | (cond |
7656 | ((eq mode 'test) ; we can at least link the main | |
7657 | (and (stringp word) entry main)) | |
7658 | ((eq mode 'set) | |
4b1aaa8b | 7659 | (if entry |
e7c4fb1e | 7660 | (setq idlw-help-link |
e08734e2 | 7661 | (if (setq target (cdr (assoc-string word tags t))) |
e7c4fb1e GM |
7662 | (idlwave-substitute-link-target main target) |
7663 | main)))) ;; setting dynamic!!! | |
52a244eb S |
7664 | (t (error "This should not happen"))))) |
7665 | ||
f66f03de | 7666 | (defun idlwave-split-link-target (link) |
5a0c3f56 | 7667 | "Split a given LINK into link file and anchor." |
f66f03de S |
7668 | (if (string-match idlwave-html-link-sep link) |
7669 | (cons (substring link 0 (match-beginning 0)) | |
7670 | (string-to-number (substring link (match-end 0)))))) | |
7671 | ||
52a244eb | 7672 | (defun idlwave-substitute-link-target (link target) |
5a0c3f56 | 7673 | "Substitute the TARGET anchor for the given LINK." |
52a244eb S |
7674 | (let (main-base) |
7675 | (setq main-base (if (string-match "#" link) | |
7676 | (substring link 0 (match-beginning 0)) | |
7677 | link)) | |
7678 | (if target | |
7679 | (concat main-base idlwave-html-link-sep (number-to-string target)) | |
7680 | link))) | |
76959b77 S |
7681 | |
7682 | ;; Fake help in the source buffer for class structure tags. | |
e7c4fb1e GM |
7683 | ;; IDLW-HELP-LINK AND IDLW-HELP-NAME ARE GLOBAL-VARIABLES HERE. |
7684 | ;; (from idlwave-do-mouse-completion-help) | |
7685 | (defvar idlw-help-name) | |
7686 | (defvar idlw-help-link) | |
76959b77 S |
7687 | (defvar idlwave-help-do-class-struct-tag nil) |
7688 | (defun idlwave-complete-class-structure-tag-help (mode word) | |
7689 | (cond | |
7690 | ((eq mode 'test) ; nothing gets fontified for class tags | |
7691 | nil) | |
7692 | ((eq mode 'set) | |
52a244eb | 7693 | (let (class-with found-in) |
4b1aaa8b PE |
7694 | (when (setq class-with |
7695 | (idlwave-class-or-superclass-with-tag | |
76959b77 S |
7696 | idlwave-current-tags-class |
7697 | word)) | |
4b1aaa8b | 7698 | (if (assq (idlwave-sintern-class class-with) |
76959b77 | 7699 | idlwave-system-class-info) |
ff689efd | 7700 | (error "No help available for system class tags")) |
52a244eb | 7701 | (if (setq found-in (idlwave-class-found-in class-with)) |
e7c4fb1e GM |
7702 | (setq idlw-help-name (cons (concat found-in "__define") class-with)) |
7703 | (setq idlw-help-name (concat class-with "__define"))))) | |
7704 | (setq idlw-help-link word | |
76959b77 S |
7705 | idlwave-help-do-class-struct-tag t)) |
7706 | (t (error "This should not happen")))) | |
7707 | ||
7708 | (defun idlwave-class-or-superclass-with-tag (class tag) | |
7709 | "Find and return the CLASS or one of its superclass with the | |
7710 | associated TAG, if any." | |
e08734e2 | 7711 | (let ((sclasses (cons class (idlwave-all-class-inherits class))) |
76959b77 S |
7712 | cl) |
7713 | (catch 'exit | |
7714 | (while sclasses | |
7715 | (setq cl (pop sclasses)) | |
7716 | (let ((tags (idlwave-class-tags cl))) | |
7717 | (while tags | |
7718 | (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t)) | |
4b1aaa8b | 7719 | (throw 'exit cl)) |
76959b77 S |
7720 | (setq tags (cdr tags)))))))) |
7721 | ||
05a1abfc CD |
7722 | |
7723 | (defun idlwave-sysvars-reset () | |
7724 | (if (and (fboundp 'idlwave-shell-is-running) | |
52a244eb S |
7725 | (idlwave-shell-is-running) |
7726 | idlwave-idlwave_routine_info-compiled) | |
05a1abfc CD |
7727 | (idlwave-shell-send-command "idlwave_get_sysvars" |
7728 | 'idlwave-process-sysvars 'hide))) | |
7729 | ||
7730 | (defun idlwave-process-sysvars () | |
7731 | (idlwave-shell-filter-sysvars) | |
7732 | (setq idlwave-sint-sysvars nil | |
7733 | idlwave-sint-sysvartags nil) | |
7734 | (idlwave-sintern-sysvar-alist)) | |
7735 | ||
05a1abfc | 7736 | (defun idlwave-sintern-sysvar-alist () |
52a244eb | 7737 | (let ((list idlwave-system-variables-alist) entry tags) |
05a1abfc CD |
7738 | (while (setq entry (pop list)) |
7739 | (setcar entry (idlwave-sintern-sysvar (car entry) 'set)) | |
52a244eb S |
7740 | (setq tags (assq 'tags entry)) |
7741 | (if tags | |
4b1aaa8b PE |
7742 | (setcdr tags |
7743 | (mapcar (lambda (x) | |
52a244eb S |
7744 | (cons (idlwave-sintern-sysvartag (car x) 'set) |
7745 | (cdr x))) | |
7746 | (cdr tags))))))) | |
05a1abfc CD |
7747 | |
7748 | (defvar idlwave-shell-command-output) | |
7749 | (defun idlwave-shell-filter-sysvars () | |
52a244eb | 7750 | "Get any new system variables and tags." |
05a1abfc CD |
7751 | (let ((text idlwave-shell-command-output) |
7752 | (start 0) | |
7753 | (old idlwave-system-variables-alist) | |
52a244eb | 7754 | var tags type name class link old-entry) |
05a1abfc CD |
7755 | (setq idlwave-system-variables-alist nil) |
7756 | (while (string-match "^IDLWAVE-SYSVAR: !\\([a-zA-Z0-9_$]+\\)\\( \\(.*\\)\\)?" | |
7757 | text start) | |
7758 | (setq start (match-end 0) | |
7759 | var (match-string 1 text) | |
4b1aaa8b | 7760 | tags (if (match-end 3) |
52a244eb S |
7761 | (idlwave-split-string (match-string 3 text)))) |
7762 | ;; Maintain old links, if present | |
7763 | (setq old-entry (assq (idlwave-sintern-sysvar var) old)) | |
7764 | (setq link (assq 'link old-entry)) | |
05a1abfc | 7765 | (setq idlwave-system-variables-alist |
4b1aaa8b PE |
7766 | (cons (list var |
7767 | (cons | |
7768 | 'tags | |
7769 | (mapcar (lambda (x) | |
7770 | (cons x | |
7771 | (cdr (assq | |
7772 | (idlwave-sintern-sysvartag x) | |
52a244eb S |
7773 | (cdr (assq 'tags old-entry)))))) |
7774 | tags)) link) | |
05a1abfc CD |
7775 | idlwave-system-variables-alist))) |
7776 | ;; Keep the old value if query was not successful | |
7777 | (setq idlwave-system-variables-alist | |
7778 | (or idlwave-system-variables-alist old)))) | |
7779 | ||
f32b3b91 CD |
7780 | (defun idlwave-completion-fontify-classes () |
7781 | "Goto the *Completions* buffer and fontify the class info." | |
7782 | (when (featurep 'font-lock) | |
9a529312 | 7783 | (with-current-buffer "*Completions*" |
f32b3b91 CD |
7784 | (save-excursion |
7785 | (goto-char (point-min)) | |
76959b77 S |
7786 | (let ((buffer-read-only nil)) |
7787 | (while (re-search-forward "\\.*<[^>]+>" nil t) | |
7788 | (put-text-property (match-beginning 0) (match-end 0) | |
7789 | 'face 'font-lock-string-face))))))) | |
f32b3b91 CD |
7790 | |
7791 | (defun idlwave-uniquify (list) | |
52a244eb | 7792 | (let ((ht (make-hash-table :size (length list) :test 'equal))) |
4b1aaa8b | 7793 | (delq nil |
52a244eb | 7794 | (mapcar (lambda (x) |
4b1aaa8b | 7795 | (unless (gethash x ht) |
52a244eb S |
7796 | (puthash x t ht) |
7797 | x)) | |
7798 | list)))) | |
f32b3b91 CD |
7799 | |
7800 | (defun idlwave-after-successful-completion (type slash &optional verify) | |
7801 | "Add `=' or `(' after successful completion of keyword and function. | |
7802 | Restore the pre-completion window configuration if possible." | |
7803 | (cond | |
7804 | ((eq type 'procedure) | |
7805 | nil) | |
7806 | ((eq type 'function) | |
7807 | (cond | |
7808 | ((equal idlwave-function-completion-adds-paren nil) nil) | |
7809 | ((or (equal idlwave-function-completion-adds-paren t) | |
7810 | (equal idlwave-function-completion-adds-paren 1)) | |
7811 | (insert "(")) | |
7812 | ((equal idlwave-function-completion-adds-paren 2) | |
7813 | (insert "()") | |
7814 | (backward-char 1)) | |
7815 | (t nil))) | |
7816 | ((eq type 'keyword) | |
7817 | (if (and idlwave-keyword-completion-adds-equal | |
7818 | (not slash)) | |
7819 | (progn (insert "=") t) | |
7820 | nil))) | |
7821 | ||
7822 | ;; Restore the pre-completion window configuration if this is safe. | |
4b1aaa8b PE |
7823 | |
7824 | (if (or (eq verify 'force) ; force | |
7825 | (and | |
f32b3b91 | 7826 | (get-buffer-window "*Completions*") ; visible |
4b1aaa8b | 7827 | (idlwave-local-value 'idlwave-completion-p |
f32b3b91 CD |
7828 | "*Completions*") ; cib-buffer |
7829 | (eq (marker-buffer idlwave-completion-mark) | |
7830 | (current-buffer)) ; buffer OK | |
7831 | (equal (marker-position idlwave-completion-mark) | |
7832 | verify))) ; pos OK | |
7833 | (idlwave-restore-wconf-after-completion)) | |
7834 | (move-marker idlwave-completion-mark nil) | |
7835 | (setq idlwave-before-completion-wconf nil)) | |
7836 | ||
15e42531 CD |
7837 | (defun idlwave-mouse-context-help (ev &optional arg) |
7838 | "Call `idlwave-context-help' on the clicked location." | |
7839 | (interactive "eP") | |
7840 | (mouse-set-point ev) | |
7841 | (idlwave-context-help arg)) | |
7842 | ||
7843 | (defvar idlwave-last-context-help-pos nil) | |
7844 | (defun idlwave-context-help (&optional arg) | |
7845 | "Display IDL Online Help on context. | |
76959b77 S |
7846 | If point is on a keyword, help for that keyword will be shown. If |
7847 | point is on a routine name or in the argument list of a routine, help | |
7848 | for that routine will be displayed. Works for system routines and | |
9858f6c3 | 7849 | keywords, it pulls up text help. For other routines and keywords, |
76959b77 S |
7850 | visits the source file, finding help in the header (if |
7851 | `idlwave-help-source-try-header' is non-nil) or the routine definition | |
7852 | itself." | |
f32b3b91 | 7853 | (interactive "P") |
15e42531 CD |
7854 | (idlwave-do-context-help arg)) |
7855 | ||
7856 | (defun idlwave-mouse-completion-help (ev) | |
7857 | "Display online help about the completion at point." | |
7858 | (interactive "eP") | |
52a244eb | 7859 | ;; Restore last-command for next command, to make |
c80e3b4a | 7860 | ;; scrolling/canceling of completions work. |
15e42531 CD |
7861 | (setq this-command last-command) |
7862 | (idlwave-do-mouse-completion-help ev)) | |
15e42531 | 7863 | |
f32b3b91 | 7864 | (defun idlwave-routine-info (&optional arg external) |
5a0c3f56 JB |
7865 | "Display a routines calling sequence and list of keywords. |
7866 | When point is on the name a function or procedure, or in the argument | |
7867 | list of a function or procedure, this command displays a help buffer with | |
52a244eb | 7868 | the information. When called with prefix arg, enforce class query. |
f32b3b91 CD |
7869 | |
7870 | When point is on an object operator `->', display the class stored in | |
5a0c3f56 JB |
7871 | this arrow, if any (see `idlwave-store-inquired-class'). With a prefix |
7872 | arg, the class property is cleared out." | |
f32b3b91 CD |
7873 | |
7874 | (interactive "P") | |
7875 | (idlwave-routines) | |
7876 | (if (string-match "->" (buffer-substring | |
7877 | (max (point-min) (1- (point))) | |
7878 | (min (+ 2 (point)) (point-max)))) | |
7879 | ;; Cursor is on an arrow | |
7880 | (if (get-text-property (point) 'idlwave-class) | |
7881 | ;; arrow has class property | |
7882 | (if arg | |
7883 | ;; Remove property | |
7884 | (save-excursion | |
7885 | (backward-char 1) | |
7886 | (when (looking-at ".?\\(->\\)") | |
7887 | (remove-text-properties (match-beginning 1) (match-end 1) | |
7888 | '(idlwave-class nil face nil)) | |
7889 | (message "Class property removed from arrow"))) | |
7890 | ;; Echo class property | |
7891 | (message "Arrow has text property identifying object to be class %s" | |
7892 | (get-text-property (point) 'idlwave-class))) | |
7893 | ;; No property found | |
7894 | (message "Arrow has no class text property")) | |
7895 | ||
7896 | ;; Not on an arrow... | |
7897 | (let* ((idlwave-query-class nil) | |
7898 | (idlwave-force-class-query (equal arg '(4))) | |
7899 | (module (idlwave-what-module))) | |
15e42531 | 7900 | (if (car module) |
05a1abfc CD |
7901 | (apply 'idlwave-display-calling-sequence |
7902 | (idlwave-fix-module-if-obj_new module)) | |
e8af40ee | 7903 | (error "Don't know which calling sequence to show"))))) |
f32b3b91 CD |
7904 | |
7905 | (defun idlwave-resolve (&optional arg) | |
52a244eb | 7906 | "Call RESOLVE_ROUTINE on the module name at point. |
f32b3b91 CD |
7907 | Like `idlwave-routine-info', this looks for a routine call at point. |
7908 | After confirmation in the minibuffer, it will use the shell to issue | |
7909 | a RESOLVE call for this routine, to attempt to make it defined and its | |
7910 | routine info available for IDLWAVE. If the routine is a method call, | |
7911 | both `class__method' and `class__define' will be tried. | |
7912 | With ARG, enforce query for the class of object methods." | |
7913 | (interactive "P") | |
7914 | (let* ((idlwave-query-class nil) | |
7915 | (idlwave-force-class-query (equal arg '(4))) | |
7916 | (module (idlwave-what-module)) | |
7917 | (name (idlwave-make-full-name (nth 2 module) (car module))) | |
7918 | (type (if (eq (nth 1 module) 'pro) "pro" "function")) | |
7919 | (resolve (read-string "Resolve: " (format "%s %s" type name))) | |
7920 | (kwd "") | |
7921 | class) | |
7922 | (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" | |
7923 | resolve) | |
7924 | (setq type (match-string 1 resolve) | |
4b1aaa8b | 7925 | class (if (match-beginning 2) |
f32b3b91 CD |
7926 | (match-string 3 resolve) |
7927 | nil) | |
7928 | name (match-string 4 resolve))) | |
7929 | (if (string= (downcase type) "function") | |
7930 | (setq kwd ",/is_function")) | |
7931 | ||
7932 | (cond | |
7933 | ((null class) | |
4b1aaa8b | 7934 | (idlwave-shell-send-command |
f32b3b91 CD |
7935 | (format "resolve_routine,'%s'%s" (downcase name) kwd) |
7936 | 'idlwave-update-routine-info | |
7937 | nil t)) | |
7938 | (t | |
4b1aaa8b | 7939 | (idlwave-shell-send-command |
f32b3b91 | 7940 | (format "resolve_routine,'%s__define'%s" (downcase class) kwd) |
4b1aaa8b PE |
7941 | (list 'idlwave-shell-send-command |
7942 | (format "resolve_routine,'%s__%s'%s" | |
f32b3b91 CD |
7943 | (downcase class) (downcase name) kwd) |
7944 | '(idlwave-update-routine-info) | |
7945 | nil t)))))) | |
7946 | ||
3938cb82 S |
7947 | (defun idlwave-find-module-this-file () |
7948 | (interactive) | |
7949 | (idlwave-find-module '(4))) | |
7950 | ||
f32b3b91 CD |
7951 | (defun idlwave-find-module (&optional arg) |
7952 | "Find the source code of an IDL module. | |
5a0c3f56 JB |
7953 | Works for modules for which IDLWAVE has routine info available. |
7954 | The function offers as default the module name `idlwave-routine-info' | |
52a244eb S |
7955 | would use. With ARG limit to this buffer. With two prefix ARG's |
7956 | force class query for object methods." | |
f32b3b91 CD |
7957 | (interactive "P") |
7958 | (let* ((idlwave-query-class nil) | |
52a244eb S |
7959 | (idlwave-force-class-query (equal arg '(16))) |
7960 | (this-buffer (equal arg '(4))) | |
05a1abfc | 7961 | (module (idlwave-fix-module-if-obj_new (idlwave-what-module))) |
52a244eb | 7962 | (default (if module |
4b1aaa8b | 7963 | (concat (idlwave-make-full-name |
52a244eb S |
7964 | (nth 2 module) (car module)) |
7965 | (if (eq (nth 1 module) 'pro) "<p>" "<f>")) | |
7966 | "none")) | |
4b1aaa8b | 7967 | (list |
52a244eb S |
7968 | (idlwave-uniquify |
7969 | (delq nil | |
4b1aaa8b | 7970 | (mapcar (lambda (x) |
52a244eb S |
7971 | (if (eq 'system (car-safe (nth 3 x))) |
7972 | ;; Take out system routines with no source. | |
7973 | nil | |
7974 | (list | |
4b1aaa8b | 7975 | (concat (idlwave-make-full-name |
52a244eb S |
7976 | (nth 2 x) (car x)) |
7977 | (if (eq (nth 1 x) 'pro) "<p>" "<f>"))))) | |
7978 | (if this-buffer | |
7979 | (idlwave-save-buffer-update) | |
7980 | (idlwave-routines)))))) | |
f32b3b91 | 7981 | (name (idlwave-completing-read |
52a244eb S |
7982 | (if (or (not this-buffer) |
7983 | (assoc default list)) | |
7984 | (format "Module (Default %s): " default) | |
7985 | (format "Module in this file: ")) | |
f32b3b91 CD |
7986 | list)) |
7987 | type class) | |
7988 | (if (string-match "\\`\\s-*\\'" name) | |
7989 | ;; Nothing, use the default. | |
7990 | (setq name default)) | |
7991 | (if (string-match "<[fp]>" name) | |
7992 | (setq type (substring name -2 -1) | |
7993 | name (substring name 0 -3))) | |
7994 | (if (string-match "\\(.*\\)::\\(.*\\)" name) | |
7995 | (setq class (match-string 1 name) | |
7996 | name (match-string 2 name))) | |
7997 | (setq name (idlwave-sintern-routine-or-method name class) | |
7998 | class (idlwave-sintern-class class) | |
7999 | type (cond ((equal type "f") 'fun) | |
8000 | ((equal type "p") 'pro) | |
8001 | (t t))) | |
52a244eb | 8002 | (idlwave-do-find-module name type class nil this-buffer))) |
f32b3b91 | 8003 | |
4b1aaa8b | 8004 | (defun idlwave-do-find-module (name type class |
52a244eb | 8005 | &optional force-source this-buffer) |
f32b3b91 | 8006 | (let ((name1 (idlwave-make-full-name class name)) |
4b1aaa8b | 8007 | source buf1 entry |
f32b3b91 | 8008 | (buf (current-buffer)) |
05a1abfc | 8009 | (pos (point)) |
52a244eb S |
8010 | file name2) |
8011 | (setq entry (idlwave-best-rinfo-assq name type class (idlwave-routines) | |
8012 | 'WITH-FILE) | |
05a1abfc CD |
8013 | source (or force-source (nth 3 entry)) |
8014 | name2 (if (nth 2 entry) | |
8015 | (idlwave-make-full-name (nth 2 entry) name) | |
775591f7 | 8016 | name1)) |
4b1aaa8b | 8017 | (if source |
52a244eb S |
8018 | (setq file (idlwave-routine-source-file source))) |
8019 | (unless file ; Try to find it on the path. | |
4b1aaa8b PE |
8020 | (setq file |
8021 | (idlwave-expand-lib-file-name | |
52a244eb S |
8022 | (if class |
8023 | (format "%s__define.pro" (downcase class)) | |
8024 | (format "%s.pro" (downcase name)))))) | |
f32b3b91 CD |
8025 | (cond |
8026 | ((or (null name) (equal name "")) | |
8027 | (error "Abort")) | |
f32b3b91 | 8028 | ((eq (car source) 'system) |
4b1aaa8b | 8029 | (error "Source code for system routine %s is not available" |
05a1abfc | 8030 | name2)) |
52a244eb | 8031 | ((or (not file) (not (file-regular-p file))) |
e8af40ee | 8032 | (error "Source code for routine %s is not available" |
05a1abfc | 8033 | name2)) |
52a244eb S |
8034 | (t |
8035 | (when (not this-buffer) | |
4b1aaa8b | 8036 | (setq buf1 |
52a244eb S |
8037 | (idlwave-find-file-noselect file 'find)) |
8038 | (pop-to-buffer buf1 t)) | |
15e42531 | 8039 | (goto-char (point-max)) |
f32b3b91 | 8040 | (let ((case-fold-search t)) |
15e42531 | 8041 | (if (re-search-backward |
f32b3b91 | 8042 | (concat "^[ \t]*\\<" |
52a244eb S |
8043 | (cond ((eq type 'fun) "function") |
8044 | ((eq type 'pro) "pro") | |
f32b3b91 | 8045 | (t "\\(pro\\|function\\)")) |
4b1aaa8b | 8046 | "\\>[ \t]+" |
05a1abfc | 8047 | (regexp-quote (downcase name2)) |
f32b3b91 CD |
8048 | "[^a-zA-Z0-9_$]") |
8049 | nil t) | |
8050 | (goto-char (match-beginning 0)) | |
8051 | (pop-to-buffer buf) | |
8052 | (goto-char pos) | |
05a1abfc | 8053 | (error "Could not find routine %s" name2))))))) |
f32b3b91 CD |
8054 | |
8055 | (defun idlwave-what-module () | |
8056 | "Return a default module for stuff near point. | |
8057 | Used by `idlwave-routine-info' and `idlwave-find-module'." | |
8058 | (idlwave-routines) | |
15e42531 CD |
8059 | (if (let ((case-fold-search t)) |
8060 | (save-excursion | |
8061 | (idlwave-beginning-of-statement) | |
8062 | (looking-at "[ \t]*\\(pro\\|function\\)[ \t]+\\(\\([a-zA-Z0-9_$]+\\)::\\)?\\([a-zA-Z0-9$_]+\\)\\([, \t\n]\\|$\\)"))) | |
8063 | ;; This is a function or procedure definition statement | |
8064 | ;; We return the defined routine as module. | |
8065 | (list | |
52a244eb S |
8066 | (idlwave-sintern-routine-or-method (match-string-no-properties 4) |
8067 | (match-string-no-properties 2)) | |
15e42531 CD |
8068 | (if (equal (downcase (match-string 1)) "pro") 'pro 'fun) |
8069 | (idlwave-sintern-class (match-string 3))) | |
8070 | ||
52a244eb | 8071 | ;; Not a definition statement - analyze precise position. |
15e42531 CD |
8072 | (let* ((where (idlwave-where)) |
8073 | (cw (nth 2 where)) | |
8074 | (pro (car (nth 0 where))) | |
8075 | (func (car (nth 1 where))) | |
8076 | (this-word (idlwave-this-word "a-zA-Z0-9$_")) | |
8077 | (next-char (save-excursion (skip-chars-forward "a-zA-Z0-9$_") | |
8078 | (following-char))) | |
8079 | ) | |
8080 | (cond | |
8081 | ((and (eq cw 'procedure) | |
8082 | (not (equal this-word ""))) | |
4b1aaa8b | 8083 | (setq this-word (idlwave-sintern-routine-or-method |
15e42531 CD |
8084 | this-word (nth 2 (nth 3 where)))) |
8085 | (list this-word 'pro | |
4b1aaa8b | 8086 | (idlwave-determine-class |
15e42531 CD |
8087 | (cons this-word (cdr (nth 3 where))) |
8088 | 'pro))) | |
4b1aaa8b | 8089 | ((and (eq cw 'function) |
15e42531 CD |
8090 | (not (equal this-word "")) |
8091 | (or (eq next-char ?\() ; exclude arrays, vars. | |
8092 | (looking-at "[a-zA-Z0-9_]*[ \t]*("))) | |
4b1aaa8b | 8093 | (setq this-word (idlwave-sintern-routine-or-method |
15e42531 CD |
8094 | this-word (nth 2 (nth 3 where)))) |
8095 | (list this-word 'fun | |
8096 | (idlwave-determine-class | |
8097 | (cons this-word (cdr (nth 3 where))) | |
8098 | 'fun))) | |
8099 | ((and (memq cw '(function-keyword procedure-keyword)) | |
8100 | (not (equal this-word "")) | |
8101 | (eq next-char ?\()) ; A function! | |
8102 | (setq this-word (idlwave-sintern-routine this-word)) | |
8103 | (list this-word 'fun nil)) | |
8104 | (func | |
8105 | (list func 'fun (idlwave-determine-class (nth 1 where) 'fun))) | |
8106 | (pro | |
8107 | (list pro 'pro (idlwave-determine-class (nth 0 where) 'pro))) | |
8108 | (t nil))))) | |
f32b3b91 | 8109 | |
05a1abfc | 8110 | (defun idlwave-what-module-find-class () |
5a0c3f56 | 8111 | "Call `idlwave-what-module' and find the inherited class if necessary." |
05a1abfc | 8112 | (let* ((module (idlwave-what-module)) |
8d222148 | 8113 | (class (nth 2 module))) |
05a1abfc CD |
8114 | (if (and (= (length module) 3) |
8115 | (stringp class)) | |
8116 | (list (car module) | |
8117 | (nth 1 module) | |
8118 | (apply 'idlwave-find-inherited-class module)) | |
8119 | module))) | |
8120 | ||
8121 | (defun idlwave-find-inherited-class (name type class) | |
8122 | "Find the class which defines TYPE NAME and is CLASS or inherited by CLASS." | |
8123 | (let ((entry (idlwave-best-rinfo-assoc name type class (idlwave-routines)))) | |
8124 | (if entry | |
8125 | (nth 2 entry) | |
8126 | class))) | |
8127 | ||
8128 | (defun idlwave-fix-module-if-obj_new (module) | |
4b1aaa8b | 8129 | "Check if MODULE points to obj_new. |
52a244eb S |
8130 | If yes, and if the cursor is in the keyword region, change to the |
8131 | appropriate Init method." | |
05a1abfc CD |
8132 | (let* ((name (car module)) |
8133 | (pos (point)) | |
8134 | (case-fold-search t) | |
8135 | string) | |
8136 | (if (and (stringp name) | |
8137 | (equal (downcase name) "obj_new") | |
8138 | (save-excursion | |
8139 | (idlwave-beginning-of-statement) | |
8140 | (setq string (buffer-substring (point) pos)) | |
8141 | (string-match "obj_new([^'\"]*['\"]\\([a-zA-Z0-9_]+\\)" | |
8142 | string))) | |
8143 | (let ((name "Init") | |
8144 | (class (match-string 1 string))) | |
8145 | (setq module (list (idlwave-sintern-method "Init") | |
8146 | 'fun | |
8147 | (idlwave-sintern-class class))))) | |
8148 | module)) | |
8149 | ||
4b1aaa8b | 8150 | (defun idlwave-fix-keywords (name type class keywords |
3938cb82 | 8151 | &optional super-classes system) |
52a244eb S |
8152 | "Update a list of keywords. |
8153 | Translate OBJ_NEW, adding all super-class keywords, or all keywords | |
5a0c3f56 | 8154 | from all classes if CLASS equals t. If SYSTEM is non-nil, don't |
3938cb82 | 8155 | demand _EXTRA in the keyword list." |
5e72c6b2 | 8156 | (let ((case-fold-search t)) |
f32b3b91 CD |
8157 | |
8158 | ;; If this is the OBJ_NEW function, try to figure out the class and use | |
8159 | ;; the keywords from the corresponding INIT method. | |
5e72c6b2 | 8160 | (if (and (equal (upcase name) "OBJ_NEW") |
175069ef | 8161 | (derived-mode-p 'idlwave-mode 'idlwave-shell-mode)) |
f32b3b91 CD |
8162 | (let* ((bos (save-excursion (idlwave-beginning-of-statement) (point))) |
8163 | (string (buffer-substring bos (point))) | |
8164 | (case-fold-search t) | |
8165 | class) | |
8166 | (and (string-match "obj_new([^'\"]*['\"]\\([a-zA-Z0-9_]+\\)" | |
8167 | string) | |
8168 | (setq class (idlwave-sintern-class (match-string 1 string))) | |
15e42531 | 8169 | (setq idlwave-current-obj_new-class class) |
4b1aaa8b PE |
8170 | (setq keywords |
8171 | (append keywords | |
52a244eb S |
8172 | (idlwave-entry-keywords |
8173 | (idlwave-rinfo-assq | |
8174 | (idlwave-sintern-method "INIT") | |
8175 | 'fun | |
8176 | class | |
8177 | (idlwave-routines)) 'do-link)))))) | |
4b1aaa8b | 8178 | |
f32b3b91 CD |
8179 | ;; If the class is `t', combine all keywords of all methods NAME |
8180 | (when (eq class t) | |
52a244eb S |
8181 | (mapc (lambda (entry) |
8182 | (and | |
8183 | (nth 2 entry) ; non-nil class | |
8184 | (eq (nth 1 entry) type) ; correct type | |
4b1aaa8b PE |
8185 | (setq keywords |
8186 | (append keywords | |
52a244eb S |
8187 | (idlwave-entry-keywords entry 'do-link))))) |
8188 | (idlwave-all-assq name (idlwave-routines))) | |
5e72c6b2 | 8189 | (setq keywords (idlwave-uniquify keywords))) |
4b1aaa8b | 8190 | |
5e72c6b2 | 8191 | ;; If we have inheritance, add all keywords from superclasses, if |
52a244eb | 8192 | ;; the user indicated that method in `idlwave-keyword-class-inheritance' |
4b1aaa8b | 8193 | (when (and |
52a244eb | 8194 | super-classes |
5e72c6b2 S |
8195 | idlwave-keyword-class-inheritance |
8196 | (stringp class) | |
4b1aaa8b | 8197 | (or |
3938cb82 S |
8198 | system |
8199 | (assq (idlwave-sintern-keyword "_extra") keywords) | |
8200 | (assq (idlwave-sintern-keyword "_ref_extra") keywords)) | |
5e72c6b2 S |
8201 | ;; Check if one of the keyword-class regexps matches the name |
8202 | (let ((regexps idlwave-keyword-class-inheritance) re) | |
8203 | (catch 'exit | |
8204 | (while (setq re (pop regexps)) | |
8205 | (if (string-match re name) (throw 'exit t)))))) | |
52a244eb S |
8206 | |
8207 | (loop for entry in (idlwave-routines) do | |
8208 | (and (nth 2 entry) ; non-nil class | |
8209 | (memq (nth 2 entry) super-classes) ; an inherited class | |
8210 | (eq (nth 1 entry) type) ; correct type | |
8211 | (eq (car entry) name) ; correct name | |
8ffcfb27 GM |
8212 | (mapc (lambda (k) (add-to-list 'keywords k)) |
8213 | (idlwave-entry-keywords entry 'do-link)))) | |
f32b3b91 | 8214 | (setq keywords (idlwave-uniquify keywords))) |
4b1aaa8b | 8215 | |
f32b3b91 CD |
8216 | ;; Return the final list |
8217 | keywords)) | |
8218 | ||
15e42531 | 8219 | (defun idlwave-expand-keyword (keyword module) |
2e8b9c7d | 8220 | "Expand KEYWORD to one of the valid keyword parameters of MODULE. |
15e42531 CD |
8221 | KEYWORD may be an exact match or an abbreviation of a keyword. |
8222 | If the match is exact, KEYWORD itself is returned, even if there may be other | |
8223 | keywords of which KEYWORD is an abbreviation. This is necessary because some | |
8224 | system routines have keywords which are prefixes of other keywords. | |
8225 | If KEYWORD is an abbreviation of several keywords, a list of all possible | |
8226 | completions is returned. | |
8227 | If the abbreviation was unique, the correct keyword is returned. | |
8228 | If it cannot be a keyword, the function return nil. | |
8229 | If we do not know about MODULE, just return KEYWORD literally." | |
8230 | (let* ((name (car module)) | |
8231 | (type (nth 1 module)) | |
8232 | (class (nth 2 module)) | |
8233 | (kwd (idlwave-sintern-keyword keyword)) | |
8234 | (entry (idlwave-best-rinfo-assoc name type class (idlwave-routines))) | |
52a244eb | 8235 | (kwd-alist (idlwave-entry-keywords entry)) |
15e42531 CD |
8236 | (extra (or (assq (idlwave-sintern-keyword "_EXTRA") kwd-alist) |
8237 | (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) | |
8238 | (completion-ignore-case t) | |
8239 | candidates) | |
4b1aaa8b | 8240 | (cond ((assq kwd kwd-alist) |
15e42531 CD |
8241 | kwd) |
8242 | ((setq candidates (all-completions kwd kwd-alist)) | |
8243 | (if (= (length candidates) 1) | |
8244 | (car candidates) | |
8245 | candidates)) | |
8246 | ((and entry extra) | |
4b1aaa8b | 8247 | ;; Inheritance may cause this keyword to be correct |
15e42531 CD |
8248 | keyword) |
8249 | (entry | |
8250 | ;; We do know the function, which does not have the keyword. | |
8251 | nil) | |
8252 | (t | |
8253 | ;; We do not know the function, so this just might be a correct | |
8254 | ;; keyword - return it as it is. | |
8255 | keyword)))) | |
8256 | ||
b016851c SM |
8257 | (defvar idlwave-rinfo-mouse-map |
8258 | (let ((map (make-sparse-keymap))) | |
8259 | (define-key map | |
8260 | (if (featurep 'xemacs) [button2] [mouse-2]) | |
8261 | 'idlwave-mouse-active-rinfo) | |
8262 | (define-key map | |
8263 | (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) | |
8264 | 'idlwave-mouse-active-rinfo-shift) | |
8265 | (define-key map | |
8266 | (if (featurep 'xemacs) [button3] [mouse-3]) | |
8267 | 'idlwave-mouse-active-rinfo-right) | |
8268 | (define-key map " " 'idlwave-active-rinfo-space) | |
8269 | (define-key map "q" 'idlwave-quit-help) | |
8270 | map)) | |
8271 | ||
8272 | (defvar idlwave-rinfo-map | |
8273 | (let ((map (make-sparse-keymap))) | |
8274 | (define-key map "q" 'idlwave-quit-help) | |
8275 | map)) | |
8276 | ||
15e42531 CD |
8277 | (defvar idlwave-popup-source nil) |
8278 | (defvar idlwave-rinfo-marker (make-marker)) | |
8279 | ||
8280 | (defun idlwave-quit-help () | |
8281 | (interactive) | |
8282 | (let ((ri-window (get-buffer-window "*Help*")) | |
8283 | (olh-window (get-buffer-window "*IDLWAVE Help*"))) | |
8284 | (when (and olh-window | |
8285 | (fboundp 'idlwave-help-quit)) | |
8286 | (select-window olh-window) | |
8287 | (idlwave-help-quit)) | |
8288 | (when (window-live-p ri-window) | |
8289 | (delete-window ri-window)))) | |
f32b3b91 | 8290 | |
05a1abfc CD |
8291 | (defun idlwave-display-calling-sequence (name type class |
8292 | &optional initial-class) | |
f32b3b91 | 8293 | ;; Display the calling sequence of module NAME, type TYPE in class CLASS. |
05a1abfc CD |
8294 | (let* ((initial-class (or initial-class class)) |
8295 | (entry (or (idlwave-best-rinfo-assq name type class | |
15e42531 | 8296 | (idlwave-routines)) |
4b1aaa8b | 8297 | (idlwave-rinfo-assq name type class |
15e42531 | 8298 | idlwave-unresolved-routines))) |
f32b3b91 CD |
8299 | (name (or (car entry) name)) |
8300 | (class (or (nth 2 entry) class)) | |
05a1abfc | 8301 | (superclasses (idlwave-all-class-inherits initial-class)) |
15e42531 CD |
8302 | (twins (idlwave-routine-twins entry)) |
8303 | (dtwins (idlwave-study-twins twins)) | |
8304 | (all dtwins) | |
52a244eb | 8305 | (system (eq (car (nth 3 entry)) 'system)) |
f32b3b91 | 8306 | (calling-seq (nth 4 entry)) |
52a244eb S |
8307 | (keywords (idlwave-entry-keywords entry 'do-link)) |
8308 | (html-file (car (nth 5 entry))) | |
15e42531 | 8309 | (help-echo-kwd |
52a244eb | 8310 | "Button2: Insert KEYWORD (SHIFT=`/KEYWORD') | Button3: Online Help ") |
15e42531 | 8311 | (help-echo-use |
52a244eb | 8312 | "Button2/3: Online Help") |
15e42531 | 8313 | (help-echo-src |
52a244eb | 8314 | "Button2: Jump to source and back | Button3: Source in Help window.") |
05a1abfc CD |
8315 | (help-echo-class |
8316 | "Button2: Display info about same method in superclass") | |
f32b3b91 | 8317 | (col 0) |
52a244eb | 8318 | (data (list name type class (current-buffer) nil initial-class)) |
f32b3b91 | 8319 | (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) |
f66f03de | 8320 | (face 'idlwave-help-link) |
15e42531 | 8321 | beg props win cnt total) |
4b1aaa8b | 8322 | ;; Fix keywords, but don't add chained super-classes, since these |
52a244eb | 8323 | ;; are shown separately for that super-class |
f32b3b91 CD |
8324 | (setq keywords (idlwave-fix-keywords name type class keywords)) |
8325 | (cond | |
8326 | ((null entry) | |
05a1abfc CD |
8327 | (error "No %s %s known %s" type name |
8328 | (if initial-class (concat "in class " initial-class) ""))) | |
f32b3b91 | 8329 | ((or (null name) (equal name "")) |
e8af40ee | 8330 | (error "No function or procedure call at point")) |
f32b3b91 | 8331 | ((null calling-seq) |
52a244eb | 8332 | (error "Calling sequence of %s %s not available" type name)) |
f32b3b91 | 8333 | (t |
9a529312 SM |
8334 | (move-marker idlwave-rinfo-marker (point)) |
8335 | (with-current-buffer (get-buffer-create "*Help*") | |
15e42531 | 8336 | (use-local-map idlwave-rinfo-map) |
f32b3b91 CD |
8337 | (setq buffer-read-only nil) |
8338 | (erase-buffer) | |
8339 | (set (make-local-variable 'idlwave-popup-source) nil) | |
15e42531 CD |
8340 | (set (make-local-variable 'idlwave-current-obj_new-class) |
8341 | idlwave-current-obj_new-class) | |
05a1abfc CD |
8342 | (when superclasses |
8343 | (setq props (list 'mouse-face 'highlight | |
8344 | km-prop idlwave-rinfo-mouse-map | |
8345 | 'help-echo help-echo-class | |
8346 | 'data (cons 'class data))) | |
8347 | (let ((classes (cons initial-class superclasses)) c) | |
8348 | (insert "Classes: ") | |
8349 | (while (setq c (pop classes)) | |
8350 | (insert " ") | |
8351 | (setq beg (point)) | |
8352 | (insert c) | |
8353 | (if (equal (downcase c) (downcase class)) | |
8354 | (add-text-properties beg (point) (list 'face 'bold)) | |
52a244eb | 8355 | ;; If Method exists in a different class link it |
05a1abfc CD |
8356 | (if (idlwave-rinfo-assq name type c (idlwave-routines)) |
8357 | (add-text-properties beg (point) props)))) | |
8358 | (insert "\n"))) | |
52a244eb S |
8359 | (setq props (list 'mouse-face 'highlight |
8360 | km-prop idlwave-rinfo-mouse-map | |
8361 | 'help-echo help-echo-use | |
8362 | 'data (cons 'usage data))) | |
4b1aaa8b | 8363 | (if html-file (setq props (append (list 'face face 'link html-file) |
52a244eb | 8364 | props))) |
f32b3b91 CD |
8365 | (insert "Usage: ") |
8366 | (setq beg (point)) | |
8367 | (insert (if class | |
52a244eb S |
8368 | (format calling-seq class name class name class name) |
8369 | (format calling-seq name name name name)) | |
f32b3b91 CD |
8370 | "\n") |
8371 | (add-text-properties beg (point) props) | |
4b1aaa8b | 8372 | |
f32b3b91 CD |
8373 | (insert "Keywords:") |
8374 | (if (null keywords) | |
8375 | (insert " No keywords accepted.") | |
8376 | (setq col 9) | |
8ffcfb27 | 8377 | (mapc |
f32b3b91 | 8378 | (lambda (x) |
4b1aaa8b | 8379 | (if (>= (+ col 1 (length (car x))) |
f32b3b91 CD |
8380 | (window-width)) |
8381 | (progn | |
8382 | (insert "\n ") | |
8383 | (setq col 9))) | |
8384 | (insert " ") | |
8385 | (setq beg (point) | |
52a244eb | 8386 | ;; Relevant keywords already have link property attached |
f32b3b91 | 8387 | props (list 'mouse-face 'highlight |
15e42531 | 8388 | km-prop idlwave-rinfo-mouse-map |
f32b3b91 | 8389 | 'data (cons 'keyword data) |
15e42531 | 8390 | 'help-echo help-echo-kwd |
f32b3b91 | 8391 | 'keyword (car x))) |
52a244eb | 8392 | (if system (setq props (append (list 'face face) props))) |
f32b3b91 CD |
8393 | (insert (car x)) |
8394 | (add-text-properties beg (point) props) | |
8395 | (setq col (+ col 1 (length (car x))))) | |
8396 | keywords)) | |
4b1aaa8b | 8397 | |
15e42531 | 8398 | (setq cnt 1 total (length all)) |
52a244eb | 8399 | ;; Here entry is (key file (list of type-conses)) |
15e42531 CD |
8400 | (while (setq entry (pop all)) |
8401 | (setq props (list 'mouse-face 'highlight | |
8402 | km-prop idlwave-rinfo-mouse-map | |
8403 | 'help-echo help-echo-src | |
52a244eb S |
8404 | 'source (list (car (car (nth 2 entry))) ;type |
8405 | (nth 1 entry) | |
8406 | nil | |
8407 | (cdr (car (nth 2 entry)))) | |
15e42531 CD |
8408 | 'data (cons 'source data))) |
8409 | (idlwave-insert-source-location | |
4b1aaa8b | 8410 | (format "\n%-8s %s" |
15e42531 CD |
8411 | (if (equal cnt 1) |
8412 | (if (> total 1) "Sources:" "Source:") | |
8413 | "") | |
8414 | (if (> total 1) "- " "")) | |
8415 | entry props) | |
8416 | (incf cnt) | |
8417 | (when (and all (> cnt idlwave-rinfo-max-source-lines)) | |
8418 | ;; No more source lines, please | |
4b1aaa8b | 8419 | (insert (format |
15e42531 CD |
8420 | "\n Source information truncated to %d entries." |
8421 | idlwave-rinfo-max-source-lines)) | |
8422 | (setq all nil))) | |
10c8e594 | 8423 | (goto-char (point-min)) |
f32b3b91 CD |
8424 | (setq buffer-read-only t)) |
8425 | (display-buffer "*Help*") | |
8426 | (if (and (setq win (get-buffer-window "*Help*")) | |
8427 | idlwave-resize-routine-help-window) | |
8428 | (progn | |
8429 | (let ((ww (selected-window))) | |
8430 | (unwind-protect | |
8431 | (progn | |
8432 | (select-window win) | |
4b1aaa8b | 8433 | (enlarge-window (- (/ (frame-height) 2) |
f32b3b91 CD |
8434 | (window-height))) |
8435 | (shrink-window-if-larger-than-buffer)) | |
8436 | (select-window ww))))))))) | |
8437 | ||
15e42531 CD |
8438 | (defun idlwave-insert-source-location (prefix entry &optional file-props) |
8439 | "Insert a source location into the routine info buffer. | |
5a0c3f56 JB |
8440 | Start line with PREFIX. If a file name is inserted, add FILE-PROPS |
8441 | to it." | |
15e42531 CD |
8442 | (let* ((key (car entry)) |
8443 | (file (nth 1 entry)) | |
8444 | (types (nth 2 entry)) | |
52a244eb S |
8445 | (shell-flag (assq 'compiled types)) |
8446 | (buffer-flag (assq 'buffer types)) | |
8447 | (user-flag (assq 'user types)) | |
8448 | (lib-flag (assq 'lib types)) | |
8449 | (ndupl (or (and buffer-flag (idlwave-count-memq 'buffer types)) | |
8450 | (and user-flag (idlwave-count-memq 'user types)) | |
8451 | (and lib-flag (idlwave-count-memq 'lib types)) | |
15e42531 CD |
8452 | 1)) |
8453 | (doflags t) | |
8454 | beg special) | |
8455 | ||
8456 | (insert prefix) | |
8457 | ||
8458 | (cond | |
8459 | ((eq key 'system) | |
8460 | (setq doflags nil) | |
52a244eb S |
8461 | (insert "System ")) |
8462 | ||
15e42531 CD |
8463 | ((eq key 'builtin) |
8464 | (setq doflags nil) | |
52a244eb S |
8465 | (insert "Builtin ")) |
8466 | ||
15e42531 | 8467 | ((and (not file) shell-flag) |
52a244eb S |
8468 | (insert "Unresolved")) |
8469 | ||
4b1aaa8b | 8470 | ((null file) |
52a244eb | 8471 | (insert "ERROR")) |
4b1aaa8b | 8472 | |
15e42531 CD |
8473 | ((idlwave-syslib-p file) |
8474 | (if (string-match "obsolete" (file-name-directory file)) | |
52a244eb S |
8475 | (insert "Obsolete ") |
8476 | (insert "SystemLib "))) | |
8477 | ||
8478 | ;; New special syntax: taken directly from routine-info for | |
8479 | ;; library catalog routines | |
8480 | ((setq special (or (cdr lib-flag) (cdr user-flag))) | |
8481 | (insert (format "%-10s" special))) | |
8482 | ||
8483 | ;; Old special syntax: a matching regexp | |
8484 | ((setq special (idlwave-special-lib-test file)) | |
8485 | (insert (format "%-10s" special))) | |
4b1aaa8b | 8486 | |
52a244eb | 8487 | ;; Catch-all with file |
15e42531 | 8488 | ((idlwave-lib-p file) (insert "Library ")) |
52a244eb S |
8489 | |
8490 | ;; Sanity catch all | |
15e42531 CD |
8491 | (t (insert "Other "))) |
8492 | ||
8493 | (when doflags | |
8494 | (insert (concat | |
8495 | " [" | |
52a244eb S |
8496 | (if lib-flag "L" "-") |
8497 | (if user-flag "C" "-") | |
15e42531 CD |
8498 | (if shell-flag "S" "-") |
8499 | (if buffer-flag "B" "-") | |
8500 | "] "))) | |
4b1aaa8b | 8501 | (when (> ndupl 1) |
15e42531 CD |
8502 | (setq beg (point)) |
8503 | (insert (format "(%dx) " ndupl)) | |
8504 | (add-text-properties beg (point) (list 'face 'bold))) | |
8505 | (when (and file (not (equal file ""))) | |
8506 | (setq beg (point)) | |
8507 | (insert (apply 'abbreviate-file-name | |
8508 | (if (featurep 'xemacs) (list file t) (list file)))) | |
8509 | (if file-props | |
8510 | (add-text-properties beg (point) file-props))))) | |
8511 | ||
8512 | (defun idlwave-special-lib-test (file) | |
8513 | "Check the path of FILE against the regexps which define special libs. | |
8514 | Return the name of the special lib if there is a match." | |
8515 | (let ((alist idlwave-special-lib-alist) | |
8516 | entry rtn) | |
8517 | (cond | |
8518 | ((stringp file) | |
8519 | (while (setq entry (pop alist)) | |
8520 | (if (string-match (car entry) file) | |
8521 | (setq rtn (cdr entry) | |
8522 | alist nil))) | |
8523 | rtn) | |
8524 | (t nil)))) | |
4b1aaa8b | 8525 | |
f32b3b91 CD |
8526 | (defun idlwave-mouse-active-rinfo-right (ev) |
8527 | (interactive "e") | |
8528 | (idlwave-mouse-active-rinfo ev 'right)) | |
8529 | ||
15e42531 | 8530 | (defun idlwave-mouse-active-rinfo-shift (ev) |
f32b3b91 | 8531 | (interactive "e") |
15e42531 CD |
8532 | (idlwave-mouse-active-rinfo ev nil 'shift)) |
8533 | ||
8534 | (defun idlwave-active-rinfo-space () | |
8535 | (interactive) | |
8536 | (idlwave-mouse-active-rinfo nil 'right)) | |
8537 | ||
8538 | (defun idlwave-mouse-active-rinfo (ev &optional right shift) | |
5a0c3f56 | 8539 | "Do the mouse actions in the routine info buffer. |
15e42531 CD |
8540 | Optional args RIGHT and SHIFT indicate, if mouse-3 was used, and if SHIFT |
8541 | was pressed." | |
8542 | (interactive "e") | |
8543 | (if ev (mouse-set-point ev)) | |
4b1aaa8b | 8544 | (let (data id name type class buf bufwin source link keyword |
3938cb82 | 8545 | word initial-class) |
f32b3b91 | 8546 | (setq data (get-text-property (point) 'data) |
15e42531 | 8547 | source (get-text-property (point) 'source) |
f32b3b91 | 8548 | keyword (get-text-property (point) 'keyword) |
52a244eb | 8549 | link (get-text-property (point) 'link) |
f32b3b91 | 8550 | id (car data) |
15e42531 | 8551 | name (nth 1 data) type (nth 2 data) class (nth 3 data) |
f32b3b91 | 8552 | buf (nth 4 data) |
05a1abfc CD |
8553 | initial-class (nth 6 data) |
8554 | word (idlwave-this-word) | |
f32b3b91 | 8555 | bufwin (get-buffer-window buf t)) |
52a244eb S |
8556 | |
8557 | (cond ((eq id 'class) ; Switch class being displayed | |
05a1abfc | 8558 | (if (window-live-p bufwin) (select-window bufwin)) |
4b1aaa8b | 8559 | (idlwave-display-calling-sequence |
05a1abfc | 8560 | (idlwave-sintern-method name) |
4b1aaa8b | 8561 | type (idlwave-sintern-class word) |
05a1abfc | 8562 | initial-class)) |
52a244eb S |
8563 | ((eq id 'usage) ; Online help on this routine |
8564 | (idlwave-online-help link name type class)) | |
8565 | ((eq id 'source) ; Source in help or buffer | |
8566 | (if right ; In help | |
15e42531 CD |
8567 | (let ((idlwave-extra-help-function 'idlwave-help-with-source) |
8568 | (idlwave-help-source-try-header nil) | |
52a244eb | 8569 | ;; Fake idlwave-routines so help will find the right entry |
15e42531 | 8570 | (idlwave-routines |
52a244eb | 8571 | (list (list name type class source "")))) |
15e42531 | 8572 | (idlwave-help-get-special-help name type class nil)) |
52a244eb | 8573 | ;; Otherwise just pop to the source |
f32b3b91 CD |
8574 | (setq idlwave-popup-source (not idlwave-popup-source)) |
8575 | (if idlwave-popup-source | |
8576 | (condition-case err | |
15e42531 | 8577 | (idlwave-do-find-module name type class source) |
f32b3b91 CD |
8578 | (error |
8579 | (setq idlwave-popup-source nil) | |
8580 | (if (window-live-p bufwin) (select-window bufwin)) | |
8581 | (error (nth 1 err)))) | |
8582 | (if bufwin | |
8583 | (select-window bufwin) | |
15e42531 CD |
8584 | (pop-to-buffer buf)) |
8585 | (goto-char (marker-position idlwave-rinfo-marker))))) | |
f32b3b91 CD |
8586 | ((eq id 'keyword) |
8587 | (if right | |
52a244eb | 8588 | (idlwave-online-help link name type class keyword) |
15e42531 CD |
8589 | (idlwave-rinfo-insert-keyword keyword buf shift)))))) |
8590 | ||
8591 | (defun idlwave-rinfo-insert-keyword (keyword buffer &optional shift) | |
8592 | "Insert KEYWORD in BUFFER. Make sure buffer is displayed in a window." | |
8593 | (let ((bwin (get-buffer-window buffer))) | |
8594 | (if idlwave-complete-empty-string-as-lower-case | |
8595 | (setq keyword (downcase keyword))) | |
8596 | (if bwin | |
8597 | (select-window bwin) | |
8598 | (pop-to-buffer buffer) | |
8599 | (setq bwin (get-buffer-window buffer))) | |
8600 | (if (eq (preceding-char) ?/) | |
8601 | (insert keyword) | |
4b1aaa8b | 8602 | (unless (save-excursion |
15e42531 | 8603 | (re-search-backward |
4b1aaa8b | 8604 | "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" |
15e42531 CD |
8605 | (min (- (point) 100) (point-min)) t)) |
8606 | (insert ", ")) | |
8607 | (if shift (insert "/")) | |
8608 | (insert keyword) | |
8609 | (if (and (not shift) | |
8610 | idlwave-keyword-completion-adds-equal) | |
8611 | (insert "="))))) | |
8612 | ||
8613 | (defun idlwave-list-buffer-load-path-shadows (&optional arg) | |
8614 | "List the load path shadows of all routines defined in current buffer." | |
8615 | (interactive "P") | |
8616 | (idlwave-routines) | |
175069ef | 8617 | (if (derived-mode-p 'idlwave-mode) |
15e42531 CD |
8618 | (idlwave-list-load-path-shadows |
8619 | nil (idlwave-update-current-buffer-info 'save-buffer) | |
8620 | "in current buffer") | |
8621 | (error "Current buffer is not in idlwave-mode"))) | |
8622 | ||
8623 | (defun idlwave-list-shell-load-path-shadows (&optional arg) | |
8624 | "List the load path shadows of all routines compiled under the shell. | |
8625 | This is very useful for checking an IDL application. Just compile the | |
8626 | application, do RESOLVE_ALL, and `C-c C-i' to compile all referenced | |
8627 | routines and update IDLWAVE internal info. Then check for shadowing | |
8628 | with this command." | |
8629 | (interactive "P") | |
8630 | (cond | |
8631 | ((or (not (fboundp 'idlwave-shell-is-running)) | |
8632 | (not (idlwave-shell-is-running))) | |
8633 | (error "Shell is not running")) | |
8634 | ((null idlwave-compiled-routines) | |
e8af40ee | 8635 | (error "No compiled routines. Maybe you need to update with `C-c C-i'")) |
15e42531 CD |
8636 | (t |
8637 | (idlwave-list-load-path-shadows nil idlwave-compiled-routines | |
8638 | "in the shell")))) | |
8639 | ||
8640 | (defun idlwave-list-all-load-path-shadows (&optional arg) | |
8641 | "List the load path shadows of all routines known to IDLWAVE." | |
8642 | (interactive "P") | |
8643 | (idlwave-list-load-path-shadows nil nil "globally")) | |
8644 | ||
8d222148 SM |
8645 | (defvar idlwave-sort-prefer-buffer-info t |
8646 | "Internal variable used to influence `idlwave-routine-twin-compare'.") | |
8647 | ||
15e42531 CD |
8648 | (defun idlwave-list-load-path-shadows (arg &optional special-routines loc) |
8649 | "List the routines which are defined multiple times. | |
8650 | Search the information IDLWAVE has about IDL routines for multiple | |
8651 | definitions. | |
8652 | When SPECIAL-ROUTINES in non-nil, only look for shadows of these routines. | |
8653 | ||
8654 | When IDL hits a routine call which is not defined, it will search on | |
5a0c3f56 JB |
8655 | the load path in order to find a definition. The output of this command |
8656 | can be used to detect possible name clashes during this process." | |
15e42531 | 8657 | (idlwave-routines) ; Make sure everything is loaded. |
52a244eb | 8658 | (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines) |
4b1aaa8b | 8659 | (or (y-or-n-p |
52a244eb | 8660 | "You don't have any user or library catalogs. Continue anyway? ") |
15e42531 CD |
8661 | (error "Abort"))) |
8662 | (let* ((routines (append idlwave-system-routines | |
8663 | idlwave-compiled-routines | |
52a244eb S |
8664 | idlwave-library-catalog-routines |
8665 | idlwave-user-catalog-routines | |
15e42531 CD |
8666 | idlwave-buffer-routines |
8667 | nil)) | |
8668 | (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) | |
8669 | (keymap (make-sparse-keymap)) | |
8670 | (props (list 'mouse-face 'highlight | |
8671 | km-prop keymap | |
4b1aaa8b | 8672 | 'help-echo "Mouse2: Find source")) |
15e42531 | 8673 | (nroutines (length (or special-routines routines))) |
f66f03de | 8674 | (step (/ nroutines 100)) |
15e42531 | 8675 | (n 0) |
15e42531 CD |
8676 | (cnt 0) |
8677 | (idlwave-sort-prefer-buffer-info nil) | |
8678 | routine twins dtwins twin done props1 lroutines) | |
8679 | ||
8680 | (if special-routines | |
8681 | ;; Just looking for shadows of a few special routines | |
8682 | (setq lroutines routines | |
8683 | routines special-routines)) | |
8684 | ||
8685 | (message "Sorting routines...") | |
8686 | (setq routines (sort routines | |
8687 | (lambda (a b) | |
8688 | (string< (downcase (idlwave-make-full-name | |
8689 | (nth 2 a) (car a))) | |
8690 | (downcase (idlwave-make-full-name | |
8691 | (nth 2 b) (car b))))))) | |
8692 | (message "Sorting routines...done") | |
8693 | ||
8694 | (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) | |
4b1aaa8b | 8695 | (lambda (ev) |
15e42531 CD |
8696 | (interactive "e") |
8697 | (mouse-set-point ev) | |
8698 | (apply 'idlwave-do-find-module | |
8699 | (get-text-property (point) 'find-args)))) | |
8700 | (define-key keymap [(return)] | |
4b1aaa8b | 8701 | (lambda () |
15e42531 CD |
8702 | (interactive) |
8703 | (apply 'idlwave-do-find-module | |
8704 | (get-text-property (point) 'find-args)))) | |
8705 | (message "Compiling list...( 0%%)") | |
9a529312 | 8706 | (with-current-buffer (get-buffer-create "*Shadows*") |
15e42531 CD |
8707 | (setq buffer-read-only nil) |
8708 | (erase-buffer) | |
8709 | (while (setq routine (pop routines)) | |
f66f03de S |
8710 | (if (= (mod (setq n (1+ n)) step) 0) |
8711 | (message "Compiling list...(%2d%%)" (/ (* n 100) nroutines))) | |
8712 | ||
15e42531 CD |
8713 | ;; Get a list of all twins |
8714 | (setq twins (idlwave-routine-twins routine (or lroutines routines))) | |
8715 | (if (memq routine done) | |
8716 | (setq dtwins nil) | |
8717 | (setq dtwins (idlwave-study-twins twins))) | |
5e72c6b2 | 8718 | ;; Mark all twins as dealt with |
15e42531 CD |
8719 | (setq done (append twins done)) |
8720 | (when (or (> (length dtwins) 1) | |
52a244eb S |
8721 | (> (idlwave-count-memq 'lib (nth 2 (car dtwins))) 1) |
8722 | (> (idlwave-count-memq 'user (nth 2 (car dtwins))) 1) | |
8723 | (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1)) | |
15e42531 CD |
8724 | (incf cnt) |
8725 | (insert (format "\n%s%s" | |
4b1aaa8b | 8726 | (idlwave-make-full-name (nth 2 routine) |
52a244eb | 8727 | (car routine)) |
15e42531 CD |
8728 | (if (eq (nth 1 routine) 'fun) "()" ""))) |
8729 | (while (setq twin (pop dtwins)) | |
8730 | (setq props1 (append (list 'find-args | |
4b1aaa8b PE |
8731 | (list (nth 0 routine) |
8732 | (nth 1 routine) | |
52a244eb | 8733 | (nth 2 routine))) |
15e42531 CD |
8734 | props)) |
8735 | (idlwave-insert-source-location "\n - " twin props1)))) | |
8736 | (goto-char (point-min)) | |
8737 | (setq buffer-read-only t)) | |
8738 | (setq loc (or loc "")) | |
8739 | (if (> cnt 0) | |
8740 | (progn | |
8741 | (display-buffer (get-buffer "*Shadows*")) | |
8742 | (message "%d case%s of shadowing found %s" | |
8743 | cnt (if (= cnt 1) "" "s") loc)) | |
8744 | (message "No shadowing conflicts found %s" loc)))) | |
8745 | ||
8746 | (defun idlwave-print-source (routine) | |
8747 | (let* ((source (nth 3 routine)) | |
8748 | (stype (car source)) | |
52a244eb S |
8749 | (sfile (idlwave-routine-source-file source))) |
8750 | (if (idlwave-syslib-p sfile) (setq stype 'syslib)) | |
15e42531 CD |
8751 | (if (and (eq stype 'compiled) |
8752 | (or (not (stringp sfile)) | |
8753 | (not (string-match "\\S-" sfile)))) | |
8754 | (setq stype 'unresolved)) | |
4b1aaa8b | 8755 | (princ (format " %-10s %s\n" |
15e42531 CD |
8756 | stype |
8757 | (if sfile sfile "No source code available"))))) | |
8758 | ||
8759 | (defun idlwave-routine-twins (entry &optional list) | |
8760 | "Return all twin entries of ENTRY in LIST. | |
8761 | LIST defaults to `idlwave-routines'. | |
8762 | Twin entries are those which have the same name, type, and class. | |
8763 | ENTRY will also be returned, as the first item of this list." | |
8764 | (let* ((name (car entry)) | |
8765 | (type (nth 1 entry)) | |
8766 | (class (nth 2 entry)) | |
8767 | (candidates (idlwave-all-assq name (or list (idlwave-routines)))) | |
8768 | twins candidate) | |
8769 | (while (setq candidate (pop candidates)) | |
8770 | (if (and (not (eq candidate entry)) | |
8771 | (eq type (nth 1 candidate)) | |
8772 | (eq class (nth 2 candidate))) | |
8773 | (push candidate twins))) | |
4b1aaa8b | 8774 | (if (setq candidate (idlwave-rinfo-assq name type class |
15e42531 CD |
8775 | idlwave-unresolved-routines)) |
8776 | (push candidate twins)) | |
8777 | (cons entry (nreverse twins)))) | |
8778 | ||
8779 | (defun idlwave-study-twins (entries) | |
4b1aaa8b | 8780 | "Return dangerous twins of first entry in ENTRIES. |
52a244eb S |
8781 | Dangerous twins are routines with same name, but in different files on |
8782 | the load path. If a file is in the system library and has an entry in | |
8783 | the `idlwave-system-routines' list, we omit the latter as | |
8784 | non-dangerous because many IDL routines are implemented as library | |
8785 | routines, and may have been scanned." | |
15e42531 | 8786 | (let* ((entry (car entries)) |
e7c4fb1e | 8787 | (idlwave-twin-name (car entry)) ; |
15e42531 | 8788 | (type (nth 1 entry)) ; Must be bound for |
e2a9c0bc | 8789 | (idlwave-twin-class (nth 2 entry)) ; idlwave-routine-twin-compare |
15e42531 | 8790 | (cnt 0) |
52a244eb | 8791 | source type type-cons file alist syslibp key) |
15e42531 CD |
8792 | (while (setq entry (pop entries)) |
8793 | (incf cnt) | |
8794 | (setq source (nth 3 entry) | |
8795 | type (car source) | |
52a244eb S |
8796 | type-cons (cons type (nth 3 source)) |
8797 | file (idlwave-routine-source-file source)) | |
8798 | ||
15e42531 CD |
8799 | ;; Make KEY to index entry properly |
8800 | (setq key (cond ((eq type 'system) type) | |
8801 | (file (file-truename file)) | |
8802 | (t 'unresolved))) | |
52a244eb S |
8803 | |
8804 | ;; Check for an entry in the system library | |
4b1aaa8b | 8805 | (if (and file |
15e42531 CD |
8806 | (not syslibp) |
8807 | (idlwave-syslib-p file)) | |
15e42531 | 8808 | (setq syslibp t)) |
4b1aaa8b | 8809 | |
52a244eb S |
8810 | ;; If there's more than one matching entry for the same file, just |
8811 | ;; append the type-cons to the type list. | |
15e42531 | 8812 | (if (setq entry (assoc key alist)) |
52a244eb S |
8813 | (push type-cons (nth 2 entry)) |
8814 | (push (list key file (list type-cons)) alist))) | |
4b1aaa8b | 8815 | |
15e42531 | 8816 | (setq alist (nreverse alist)) |
4b1aaa8b | 8817 | |
15e42531 | 8818 | (when syslibp |
52a244eb S |
8819 | ;; File is in system *library* - remove any 'system entry |
8820 | (setq alist (delq (assq 'system alist) alist))) | |
4b1aaa8b | 8821 | |
52a244eb S |
8822 | ;; If 'system remains and we've scanned the syslib, it's a builtin |
8823 | ;; (rather than a !DIR/lib/.pro file bundled as source). | |
15e42531 CD |
8824 | (when (and (idlwave-syslib-scanned-p) |
8825 | (setq entry (assoc 'system alist))) | |
8826 | (setcar entry 'builtin)) | |
8827 | (sort alist 'idlwave-routine-twin-compare))) | |
8828 | ||
8d222148 SM |
8829 | ;; FIXME: Dynamically scoped vars need to use the `idlwave-' prefix. |
8830 | ;; (defvar type) | |
15e42531 CD |
8831 | (defmacro idlwave-xor (a b) |
8832 | `(and (or ,a ,b) | |
8833 | (not (and ,a ,b)))) | |
8834 | ||
8835 | (defun idlwave-routine-entry-compare (a b) | |
5a0c3f56 JB |
8836 | "Compare two routine info entries for sorting. |
8837 | This is the general case. It first compares class, names, and type. | |
8838 | If it turns out that A and B are twins (same name, class, and type), | |
8839 | calls another routine which compares twins on the basis of their file | |
8840 | names and path locations." | |
15e42531 CD |
8841 | (let ((name (car a)) (type (nth 1 a)) (class (nth 2 a))) |
8842 | (cond | |
8843 | ((not (equal (idlwave-downcase-safe class) | |
8844 | (idlwave-downcase-safe (nth 2 b)))) | |
8845 | ;; Class decides | |
8846 | (cond ((null (nth 2 b)) nil) | |
8847 | ((null class) t) | |
8848 | (t (string< (downcase class) (downcase (nth 2 b)))))) | |
8849 | ((not (equal (downcase name) (downcase (car b)))) | |
8850 | ;; Name decides | |
8851 | (string< (downcase name) (downcase (car b)))) | |
8852 | ((not (eq type (nth 1 b))) | |
8853 | ;; Type decides | |
8854 | (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) | |
4b1aaa8b | 8855 | (t |
15e42531 CD |
8856 | ;; A and B are twins - so the decision is more complicated. |
8857 | ;; Call twin-compare with the proper arguments. | |
8858 | (idlwave-routine-entry-compare-twins a b))))) | |
8859 | ||
8860 | (defun idlwave-routine-entry-compare-twins (a b) | |
5a0c3f56 JB |
8861 | "Compare two routine entries, under the assumption that they are twins. |
8862 | This basically calls `idlwave-routine-twin-compare' with the correct args." | |
e7c4fb1e | 8863 | (let* ((idlwave-twin-name (car a)) |
e2a9c0bc GM |
8864 | (type (nth 1 a)) |
8865 | (idlwave-twin-class (nth 2 a)) ; used in idlwave-routine-twin-compare | |
52a244eb S |
8866 | (asrc (nth 3 a)) |
8867 | (atype (car asrc)) | |
8868 | (bsrc (nth 3 b)) | |
8869 | (btype (car bsrc)) | |
8870 | (afile (idlwave-routine-source-file asrc)) | |
8871 | (bfile (idlwave-routine-source-file bsrc))) | |
15e42531 CD |
8872 | (idlwave-routine-twin-compare |
8873 | (if (stringp afile) | |
8874 | (list (file-truename afile) afile (list atype)) | |
8875 | (list atype afile (list atype))) | |
8876 | (if (stringp bfile) | |
8877 | (list (file-truename bfile) bfile (list btype)) | |
e2a9c0bc | 8878 | (list btype bfile (list btype)))))) |
15e42531 | 8879 | |
627e0a14 | 8880 | ;; Bound in idlwave-study-twins,idlwave-routine-entry-compare-twins. |
e2a9c0bc | 8881 | (defvar idlwave-twin-class) |
e7c4fb1e | 8882 | (defvar idlwave-twin-name) |
627e0a14 | 8883 | |
15e42531 CD |
8884 | (defun idlwave-routine-twin-compare (a b) |
8885 | "Compare two routine twin entries for sorting. | |
8886 | In here, A and B are not normal routine info entries, but special | |
8887 | lists (KEY FILENAME (TYPES...)). | |
e2a9c0bc | 8888 | This expects NAME TYPE IDLWAVE-TWIN-CLASS to be bound to the right values." |
15e42531 CD |
8889 | (let* (;; Dis-assemble entries |
8890 | (akey (car a)) (bkey (car b)) | |
8891 | (afile (nth 1 a)) (bfile (nth 1 b)) | |
8892 | (atypes (nth 2 a)) (btypes (nth 2 b)) | |
8893 | ;; System routines? | |
8894 | (asysp (memq akey '(builtin system))) | |
8895 | (bsysp (memq bkey '(builtin system))) | |
8896 | ;; Compiled routines? | |
8897 | (acompp (memq 'compiled atypes)) | |
8898 | (bcompp (memq 'compiled btypes)) | |
8899 | ;; Unresolved? | |
8900 | (aunresp (or (eq akey 'unresolved) | |
8901 | (and acompp (not afile)))) | |
8902 | (bunresp (or (eq bkey 'unresolved) | |
8903 | (and bcompp (not bfile)))) | |
8904 | ;; Buffer info available? | |
8905 | (abufp (memq 'buffer atypes)) | |
8906 | (bbufp (memq 'buffer btypes)) | |
8907 | ;; On search path? | |
8908 | (tpath-alist (idlwave-true-path-alist)) | |
52a244eb S |
8909 | (apathp (and (stringp akey) |
8910 | (assoc (file-name-directory akey) tpath-alist))) | |
4b1aaa8b | 8911 | (bpathp (and (stringp bkey) |
52a244eb | 8912 | (assoc (file-name-directory bkey) tpath-alist))) |
15e42531 CD |
8913 | ;; How early on search path? High number means early since we |
8914 | ;; measure the tail of the path list | |
8915 | (anpath (length (memq apathp tpath-alist))) | |
8916 | (bnpath (length (memq bpathp tpath-alist))) | |
8917 | ;; Look at file names | |
8918 | (aname (if (stringp afile) (downcase (file-name-nondirectory afile)) "")) | |
8919 | (bname (if (stringp bfile) (downcase (file-name-nondirectory bfile)) "")) | |
e2a9c0bc GM |
8920 | (fname-re (if idlwave-twin-class |
8921 | (format "\\`%s__\\(%s\\|define\\)\\.pro\\'" | |
8922 | (regexp-quote (downcase idlwave-twin-class)) | |
e7c4fb1e GM |
8923 | (regexp-quote (downcase idlwave-twin-name))) |
8924 | (format "\\`%s\\.pro" (regexp-quote (downcase idlwave-twin-name))))) | |
15e42531 CD |
8925 | ;; Is file name derived from the routine name? |
8926 | ;; Method file or class definition file? | |
8927 | (anamep (string-match fname-re aname)) | |
e2a9c0bc GM |
8928 | (adefp (and idlwave-twin-class anamep |
8929 | (string= "define" (match-string 1 aname)))) | |
15e42531 | 8930 | (bnamep (string-match fname-re bname)) |
e2a9c0bc GM |
8931 | (bdefp (and idlwave-twin-class bnamep |
8932 | (string= "define" (match-string 1 bname))))) | |
15e42531 CD |
8933 | |
8934 | ;; Now: follow JD's ideas about sorting. Looks really simple now, | |
8935 | ;; doesn't it? The difficult stuff is hidden above... | |
8936 | (cond | |
8937 | ((idlwave-xor asysp bsysp) asysp) ; System entries first | |
8938 | ((idlwave-xor aunresp bunresp) bunresp) ; Unresolved last | |
8939 | ((and idlwave-sort-prefer-buffer-info | |
8940 | (idlwave-xor abufp bbufp)) abufp) ; Buffers before non-buffers | |
8941 | ((idlwave-xor acompp bcompp) acompp) ; Compiled entries | |
8942 | ((idlwave-xor apathp bpathp) apathp) ; Library before non-library | |
8943 | ((idlwave-xor anamep bnamep) anamep) ; Correct file names first | |
e2a9c0bc | 8944 | ((and idlwave-twin-class anamep bnamep ; both file names match -> |
15e42531 CD |
8945 | (idlwave-xor adefp bdefp)) bdefp) ; __define after __method |
8946 | ((> anpath bnpath) t) ; Who is first on path? | |
8947 | (t nil)))) ; Default | |
8948 | ||
52a244eb | 8949 | (defun idlwave-routine-source-file (source) |
4b1aaa8b | 8950 | (if (nth 2 source) |
52a244eb S |
8951 | (expand-file-name (nth 1 source) (nth 2 source)) |
8952 | (nth 1 source))) | |
8953 | ||
15e42531 | 8954 | (defun idlwave-downcase-safe (string) |
dbdb7031 | 8955 | "Downcase if string, else return unchanged." |
15e42531 CD |
8956 | (if (stringp string) |
8957 | (downcase string) | |
8958 | string)) | |
8959 | ||
8960 | (defun idlwave-count-eq (elt list) | |
8961 | "How often is ELT in LIST?" | |
8962 | (length (delq nil (mapcar (lambda (x) (eq x elt)) list)))) | |
8963 | ||
52a244eb S |
8964 | (defun idlwave-count-memq (elt alist) |
8965 | "How often is ELT a key in ALIST?" | |
8966 | (length (delq nil (mapcar (lambda (x) (eq (car x) elt)) alist)))) | |
8967 | ||
15e42531 | 8968 | (defun idlwave-syslib-p (file) |
52a244eb | 8969 | "Non-nil if FILE is in the system library." |
15e42531 CD |
8970 | (let* ((true-syslib (file-name-as-directory |
8971 | (file-truename | |
8972 | (expand-file-name "lib" (idlwave-sys-dir))))) | |
8973 | (true-file (file-truename file))) | |
8974 | (string-match (concat "^" (regexp-quote true-syslib)) true-file))) | |
8975 | ||
8976 | (defun idlwave-lib-p (file) | |
5a0c3f56 | 8977 | "Non-nil if FILE is in the library." |
15e42531 CD |
8978 | (let ((true-dir (file-name-directory (file-truename file)))) |
8979 | (assoc true-dir (idlwave-true-path-alist)))) | |
8980 | ||
52a244eb S |
8981 | (defun idlwave-path-alist-add-flag (list-entry flag) |
8982 | "Add a flag to the path list entry, if not set." | |
8983 | (let ((flags (cdr list-entry))) | |
8984 | (add-to-list 'flags flag) | |
8985 | (setcdr list-entry flags))) | |
8986 | ||
8987 | (defun idlwave-path-alist-remove-flag (list-entry flag) | |
8988 | "Remove a flag to the path list entry, if set." | |
8989 | (let ((flags (delq flag (cdr list-entry)))) | |
8990 | (setcdr list-entry flags))) | |
8991 | ||
15e42531 CD |
8992 | (defun idlwave-true-path-alist () |
8993 | "Return `idlwave-path-alist' alist with true-names. | |
52a244eb | 8994 | Info is cached, but relies on the functions setting `idlwave-path-alist' |
15e42531 CD |
8995 | to reset the variable `idlwave-true-path-alist' to nil." |
8996 | (or idlwave-true-path-alist | |
8997 | (setq idlwave-true-path-alist | |
8998 | (mapcar (lambda(x) (cons | |
8999 | (file-name-as-directory | |
9000 | (file-truename | |
9001 | (directory-file-name | |
9002 | (car x)))) | |
9003 | (cdr x))) | |
9004 | idlwave-path-alist)))) | |
9005 | ||
9006 | (defun idlwave-syslib-scanned-p () | |
9007 | "Non-nil if the system lib file !DIR/lib has been scanned." | |
9008 | (let* ((true-syslib (file-name-as-directory | |
9009 | (file-truename | |
9010 | (expand-file-name "lib" (idlwave-sys-dir)))))) | |
9011 | (cdr (assoc true-syslib (idlwave-true-path-alist))))) | |
9012 | ||
9013 | ;; ---------------------------------------------------------------------------- | |
9014 | ;; | |
9015 | ;; Online Help display | |
9016 | ||
f32b3b91 CD |
9017 | |
9018 | ;; ---------------------------------------------------------------------------- | |
9019 | ;; | |
9020 | ;; Additions for use with imenu.el and func-menu.el | |
9021 | ;; (pop-up a list of IDL units in the current file). | |
9022 | ;; | |
9023 | ||
9024 | (defun idlwave-prev-index-position () | |
9025 | "Search for the previous procedure or function. | |
9026 | Return nil if not found. For use with imenu.el." | |
9027 | (save-match-data | |
9028 | (cond | |
9029 | ((idlwave-find-key "\\<\\(pro\\|function\\)\\>" -1 'nomark)) | |
9030 | ;; ((idlwave-find-key idlwave-begin-unit-reg 1 'nomark) | |
9031 | (t nil)))) | |
9032 | ||
9033 | (defun idlwave-unit-name () | |
9034 | "Return the unit name. | |
9035 | Assumes that point is at the beginning of the unit as found by | |
9036 | `idlwave-prev-index-position'." | |
9037 | (forward-sexp 2) | |
9038 | (forward-sexp -1) | |
9039 | (let ((begin (point))) | |
4b1aaa8b | 9040 | (re-search-forward |
52a244eb | 9041 | "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") |
f32b3b91 CD |
9042 | (if (fboundp 'buffer-substring-no-properties) |
9043 | (buffer-substring-no-properties begin (point)) | |
9044 | (buffer-substring begin (point))))) | |
9045 | ||
facebc7b S |
9046 | (defalias 'idlwave-function-menu |
9047 | (condition-case nil | |
f32b3b91 CD |
9048 | (progn |
9049 | (require 'func-menu) | |
facebc7b S |
9050 | 'function-menu) |
9051 | (error (condition-case nil | |
9052 | (progn | |
9053 | (require 'imenu) | |
9054 | 'imenu) | |
9055 | (error nil))))) | |
f32b3b91 | 9056 | |
52a244eb | 9057 | ;; Here we hack func-menu.el in order to support this new mode. |
f32b3b91 CD |
9058 | ;; The latest versions of func-menu.el already have this stuff in, so |
9059 | ;; we hack only if it is not already there. | |
9060 | (when (fboundp 'eval-after-load) | |
9061 | (eval-after-load "func-menu" | |
9062 | '(progn | |
9063 | (or (assq 'idlwave-mode fume-function-name-regexp-alist) | |
9064 | (not (boundp 'fume-function-name-regexp-idl)) ; avoid problems | |
9065 | (setq fume-function-name-regexp-alist | |
9066 | (cons '(idlwave-mode . fume-function-name-regexp-idl) | |
9067 | fume-function-name-regexp-alist))) | |
9068 | (or (assq 'idlwave-mode fume-find-function-name-method-alist) | |
9069 | (not (fboundp 'fume-find-next-idl-function-name)) ; avoid problems | |
9070 | (setq fume-find-function-name-method-alist | |
9071 | (cons '(idlwave-mode . fume-find-next-idl-function-name) | |
9072 | fume-find-function-name-method-alist)))))) | |
9073 | ||
9074 | (defun idlwave-edit-in-idlde () | |
9075 | "Edit the current file in IDL Development environment." | |
9076 | (interactive) | |
9077 | (start-process "idldeclient" nil | |
9078 | idlwave-shell-explicit-file-name "-c" "-e" | |
f66f03de | 9079 | (buffer-file-name))) |
4b1aaa8b | 9080 | |
f66f03de | 9081 | (defvar idlwave-help-use-assistant) |
f32b3b91 CD |
9082 | (defun idlwave-launch-idlhelp () |
9083 | "Start the IDLhelp application." | |
9084 | (interactive) | |
f66f03de S |
9085 | (if idlwave-help-use-assistant |
9086 | (idlwave-help-assistant-raise) | |
9087 | (start-process "idlhelp" nil idlwave-help-application))) | |
4b1aaa8b | 9088 | |
f32b3b91 CD |
9089 | ;; Menus - using easymenu.el |
9090 | (defvar idlwave-mode-menu-def | |
9091 | `("IDLWAVE" | |
9092 | ["PRO/FUNC menu" idlwave-function-menu t] | |
9093 | ("Motion" | |
9094 | ["Subprogram Start" idlwave-beginning-of-subprogram t] | |
9095 | ["Subprogram End" idlwave-end-of-subprogram t] | |
9096 | ["Block Start" idlwave-beginning-of-block t] | |
9097 | ["Block End" idlwave-end-of-block t] | |
9098 | ["Up Block" idlwave-backward-up-block t] | |
9099 | ["Down Block" idlwave-down-block t] | |
9100 | ["Skip Block Backward" idlwave-backward-block t] | |
9101 | ["Skip Block Forward" idlwave-forward-block t]) | |
9102 | ("Mark" | |
9103 | ["Subprogram" idlwave-mark-subprogram t] | |
9104 | ["Block" idlwave-mark-block t] | |
9105 | ["Header" idlwave-mark-doclib t]) | |
9106 | ("Format" | |
4b1aaa8b | 9107 | ["Indent Entire Statement" idlwave-indent-statement |
f66f03de | 9108 | :active t :keys "C-u \\[indent-for-tab-command]" ] |
f32b3b91 | 9109 | ["Indent Subprogram" idlwave-indent-subprogram t] |
f66f03de | 9110 | ["(Un)Comment Region" idlwave-toggle-comment-region t] |
f32b3b91 CD |
9111 | ["Continue/Split line" idlwave-split-line t] |
9112 | "--" | |
9113 | ["Toggle Auto Fill" idlwave-auto-fill-mode :style toggle | |
9114 | :selected (symbol-value idlwave-fill-function)]) | |
9115 | ("Templates" | |
9116 | ["Procedure" idlwave-procedure t] | |
9117 | ["Function" idlwave-function t] | |
9118 | ["Doc Header" idlwave-doc-header t] | |
9119 | ["Log" idlwave-doc-modification t] | |
9120 | "--" | |
9121 | ["Case" idlwave-case t] | |
9122 | ["For" idlwave-for t] | |
9123 | ["Repeat" idlwave-repeat t] | |
9124 | ["While" idlwave-while t] | |
9125 | "--" | |
9126 | ["Close Block" idlwave-close-block t]) | |
15e42531 | 9127 | ("Completion" |
f32b3b91 | 9128 | ["Complete" idlwave-complete t] |
f66f03de | 9129 | ("Complete Specific" |
f32b3b91 CD |
9130 | ["1 Procedure Name" (idlwave-complete 'procedure) t] |
9131 | ["2 Procedure Keyword" (idlwave-complete 'procedure-keyword) t] | |
9132 | "--" | |
9133 | ["3 Function Name" (idlwave-complete 'function) t] | |
9134 | ["4 Function Keyword" (idlwave-complete 'function-keyword) t] | |
9135 | "--" | |
9136 | ["5 Procedure Method Name" (idlwave-complete 'procedure-method) t] | |
9137 | ["6 Procedure Method Keyword" (idlwave-complete 'procedure-method-keyword) t] | |
9138 | "--" | |
9139 | ["7 Function Method Name" (idlwave-complete 'function-method) t] | |
9140 | ["8 Function Method Keyword" (idlwave-complete 'function-method-keyword) t] | |
9141 | "--" | |
15e42531 CD |
9142 | ["9 Class Name" idlwave-complete-class t])) |
9143 | ("Routine Info" | |
f32b3b91 | 9144 | ["Show Routine Info" idlwave-routine-info t] |
52a244eb | 9145 | ["Online Context Help" idlwave-context-help t] |
f32b3b91 CD |
9146 | "--" |
9147 | ["Find Routine Source" idlwave-find-module t] | |
15e42531 | 9148 | ["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)] |
f32b3b91 CD |
9149 | "--" |
9150 | ["Update Routine Info" idlwave-update-routine-info t] | |
f66f03de | 9151 | ["Rescan XML Help Catalog" idlwave-convert-xml-system-routine-info t] |
f32b3b91 | 9152 | "--" |
52a244eb S |
9153 | "IDL User Catalog" |
9154 | ["Select Catalog Directories" (idlwave-create-user-catalog-file nil) t] | |
15e42531 | 9155 | ["Scan Directories" (idlwave-update-routine-info '(16)) |
5e72c6b2 S |
9156 | (and idlwave-path-alist (not idlwave-catalog-process))] |
9157 | ["Scan Directories &" (idlwave-update-routine-info '(64)) | |
9158 | (and idlwave-path-alist (not idlwave-catalog-process))] | |
15e42531 CD |
9159 | "--" |
9160 | "Routine Shadows" | |
9161 | ["Check Current Buffer" idlwave-list-buffer-load-path-shadows t] | |
9162 | ["Check Compiled Routines" idlwave-list-shell-load-path-shadows t] | |
9163 | ["Check Everything" idlwave-list-all-load-path-shadows t]) | |
9164 | ("Misc" | |
9165 | ["Kill auto-created buffers" idlwave-kill-autoloaded-buffers t] | |
9166 | "--" | |
9167 | ["Insert TAB character" idlwave-hard-tab t]) | |
f32b3b91 CD |
9168 | "--" |
9169 | ("External" | |
f32b3b91 CD |
9170 | ["Start IDL shell" idlwave-shell t] |
9171 | ["Edit file in IDLDE" idlwave-edit-in-idlde t] | |
9172 | ["Launch IDL Help" idlwave-launch-idlhelp t]) | |
9173 | "--" | |
9174 | ("Customize" | |
9175 | ["Browse IDLWAVE Group" idlwave-customize t] | |
9176 | "--" | |
4b1aaa8b | 9177 | ["Build Full Customize Menu" idlwave-create-customize-menu |
f32b3b91 CD |
9178 | (fboundp 'customize-menu-create)]) |
9179 | ("Documentation" | |
9180 | ["Describe Mode" describe-mode t] | |
9181 | ["Abbreviation List" idlwave-list-abbrevs t] | |
9182 | "--" | |
9183 | ["Commentary in idlwave.el" idlwave-show-commentary t] | |
595ab50b | 9184 | ["Commentary in idlw-shell.el" idlwave-shell-show-commentary t] |
f32b3b91 CD |
9185 | "--" |
9186 | ["Info" idlwave-info t] | |
9187 | "--" | |
8c43762b | 9188 | ["Help with Topic" idlwave-help-assistant-help-with-topic |
e08734e2 | 9189 | idlwave-help-use-assistant] |
f32b3b91 CD |
9190 | ["Launch IDL Help" idlwave-launch-idlhelp t]))) |
9191 | ||
9192 | (defvar idlwave-mode-debug-menu-def | |
9193 | '("Debug" | |
9194 | ["Start IDL shell" idlwave-shell t] | |
9195 | ["Save and .RUN buffer" idlwave-shell-save-and-run | |
4b1aaa8b | 9196 | (and (boundp 'idlwave-shell-automatic-start) |
f32b3b91 CD |
9197 | idlwave-shell-automatic-start)])) |
9198 | ||
9199 | (if (or (featurep 'easymenu) (load "easymenu" t)) | |
9200 | (progn | |
4b1aaa8b PE |
9201 | (easy-menu-define idlwave-mode-menu idlwave-mode-map |
9202 | "IDL and WAVE CL editing menu" | |
f32b3b91 | 9203 | idlwave-mode-menu-def) |
4b1aaa8b PE |
9204 | (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map |
9205 | "IDL and WAVE CL editing menu" | |
f32b3b91 CD |
9206 | idlwave-mode-debug-menu-def))) |
9207 | ||
9208 | (defun idlwave-customize () | |
5a0c3f56 | 9209 | "Call the customize function with `idlwave' as argument." |
f32b3b91 | 9210 | (interactive) |
4b1aaa8b | 9211 | ;; Try to load the code for the shell, so that we can customize it |
f32b3b91 | 9212 | ;; as well. |
22d5821d CD |
9213 | (or (featurep 'idlw-shell) |
9214 | (load "idlw-shell" t)) | |
f32b3b91 CD |
9215 | (customize-browse 'idlwave)) |
9216 | ||
9217 | (defun idlwave-create-customize-menu () | |
9218 | "Create a full customization menu for IDLWAVE, insert it into the menu." | |
9219 | (interactive) | |
9220 | (if (fboundp 'customize-menu-create) | |
9221 | (progn | |
4b1aaa8b | 9222 | ;; Try to load the code for the shell, so that we can customize it |
f32b3b91 | 9223 | ;; as well. |
22d5821d CD |
9224 | (or (featurep 'idlw-shell) |
9225 | (load "idlw-shell" t)) | |
4b1aaa8b | 9226 | (easy-menu-change |
f32b3b91 CD |
9227 | '("IDLWAVE") "Customize" |
9228 | `(["Browse IDLWAVE group" idlwave-customize t] | |
9229 | "--" | |
9230 | ,(customize-menu-create 'idlwave) | |
9231 | ["Set" Custom-set t] | |
9232 | ["Save" Custom-save t] | |
9233 | ["Reset to Current" Custom-reset-current t] | |
9234 | ["Reset to Saved" Custom-reset-saved t] | |
9235 | ["Reset to Standard Settings" Custom-reset-standard t])) | |
9236 | (message "\"IDLWAVE\"-menu now contains full customization menu")) | |
9237 | (error "Cannot expand menu (outdated version of cus-edit.el)"))) | |
9238 | ||
9239 | (defun idlwave-show-commentary () | |
9240 | "Use the finder to view the file documentation from `idlwave.el'." | |
9241 | (interactive) | |
f32b3b91 CD |
9242 | (finder-commentary "idlwave.el")) |
9243 | ||
9244 | (defun idlwave-shell-show-commentary () | |
595ab50b | 9245 | "Use the finder to view the file documentation from `idlw-shell.el'." |
f32b3b91 | 9246 | (interactive) |
595ab50b | 9247 | (finder-commentary "idlw-shell.el")) |
f32b3b91 CD |
9248 | |
9249 | (defun idlwave-info () | |
9250 | "Read documentation for IDLWAVE in the info system." | |
9251 | (interactive) | |
d6a277d0 | 9252 | (info "idlwave")) |
f32b3b91 CD |
9253 | |
9254 | (defun idlwave-list-abbrevs (arg) | |
9255 | "Show the code abbreviations define in IDLWAVE mode. | |
9256 | This lists all abbrevs where the replacement text differs from the input text. | |
9257 | These are the ones the users want to learn to speed up their writing. | |
9258 | ||
9259 | The function does *not* list abbrevs which replace a word with itself | |
9260 | to call a hook. These hooks are used to change the case of words or | |
9261 | to blink the matching `begin', and the user does not need to know them. | |
9262 | ||
9263 | With arg, list all abbrevs with the corresponding hook. | |
9264 | ||
9265 | This function was written since `list-abbrevs' looks terrible for IDLWAVE mode." | |
9266 | ||
9267 | (interactive "P") | |
9268 | (let ((table (symbol-value 'idlwave-mode-abbrev-table)) | |
9269 | abbrevs | |
9270 | str rpl func fmt (len-str 0) (len-rpl 0)) | |
4b1aaa8b | 9271 | (mapatoms |
f32b3b91 CD |
9272 | (lambda (sym) |
9273 | (if (symbol-value sym) | |
9274 | (progn | |
9275 | (setq str (symbol-name sym) | |
9276 | rpl (symbol-value sym) | |
9277 | func (symbol-function sym)) | |
9278 | (if arg | |
9279 | (setq func (prin1-to-string func)) | |
9280 | (if (and (listp func) (stringp (nth 2 func))) | |
9281 | (setq rpl (concat "EVAL: " (nth 2 func)) | |
9282 | func "") | |
9283 | (setq func ""))) | |
9284 | (if (or arg (not (string= rpl str))) | |
9285 | (progn | |
9286 | (setq len-str (max len-str (length str))) | |
9287 | (setq len-rpl (max len-rpl (length rpl))) | |
9288 | (setq abbrevs (cons (list str rpl func) abbrevs))))))) | |
9289 | table) | |
9290 | ;; sort the list | |
9291 | (setq abbrevs (sort abbrevs (lambda (a b) (string< (car a) (car b))))) | |
9292 | ;; Make the format | |
9293 | (setq fmt (format "%%-%ds %%-%ds %%s\n" len-str len-rpl)) | |
9294 | (with-output-to-temp-buffer "*Help*" | |
9295 | (if arg | |
9296 | (progn | |
4b1aaa8b | 9297 | (princ "Abbreviations and Actions in IDLWAVE-Mode\n") |
f32b3b91 CD |
9298 | (princ "=========================================\n\n") |
9299 | (princ (format fmt "KEY" "REPLACE" "HOOK")) | |
9300 | (princ (format fmt "---" "-------" "----"))) | |
9301 | (princ "Code Abbreviations and Templates in IDLWAVE-Mode\n") | |
9302 | (princ "================================================\n\n") | |
9303 | (princ (format fmt "KEY" "ACTION" "")) | |
9304 | (princ (format fmt "---" "------" ""))) | |
26b51db5 JB |
9305 | (dolist (list abbrevs) |
9306 | (setq str (car list) | |
9307 | rpl (nth 1 list) | |
9308 | func (nth 2 list)) | |
9309 | (princ (format fmt str rpl func))))) | |
f32b3b91 | 9310 | ;; Make sure each abbreviation uses only one display line |
9a529312 | 9311 | (with-current-buffer "*Help*" |
f32b3b91 CD |
9312 | (setq truncate-lines t))) |
9313 | ||
5e72c6b2 S |
9314 | ;; Add .pro files to speedbar for support, if it's loaded |
9315 | (eval-after-load "speedbar" '(speedbar-add-supported-extension ".pro")) | |
9316 | ||
5e72c6b2 S |
9317 | ;; Set an idle timer to load the routine info. |
9318 | ;; Will only work on systems which support this. | |
9319 | (or idlwave-routines (idlwave-start-load-rinfo-timer)) | |
9320 | ||
15e42531 | 9321 | ;; Run the hook |
f32b3b91 CD |
9322 | (run-hooks 'idlwave-load-hook) |
9323 | ||
9324 | (provide 'idlwave) | |
9325 | ||
9326 | ;;; idlwave.el ends here |