]> code.delx.au - gnu-emacs/blob - lisp/progmodes/idlw-shell.el
(sh-mode-syntax-table): Function restored.
[gnu-emacs] / lisp / progmodes / idlw-shell.el
1 ;;; idlw-shell.el --- run IDL or WAVE as an inferior process of Emacs
2 ;; Copyright (c) 1999, 2000 Free Software Foundation
3
4 ;; Author: Chris Chase <chase@att.com>
5 ;; Maintainer: Carsten Dominik <dominik@strw.leidenuniv.nl>
6 ;; Version: 4.7
7 ;; Date: $Date: 2000/12/19 11:13:34 $
8 ;; Keywords: processes
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
26
27 ;;; Commentary:
28
29 ;; This mode is for IDL version 4 or later. It should work on Emacs
30 ;; or XEmacs version 19 or later.
31
32 ;; Runs IDL as an inferior process of Emacs, much like the emacs
33 ;; `shell' or `telnet' commands. Provides command history and
34 ;; searching. Provides debugging commands available in buffers
35 ;; visiting IDL procedure files, e.g., breakpoint setting, stepping,
36 ;; execution until a certain line, printing expressions under point,
37 ;; visual line pointer for current execution line, etc.
38 ;;
39 ;; Documentation should be available online with `M-x idlwave-info'.
40
41 ;; INSTALLATION:
42 ;; =============
43 ;;
44 ;; Follow the instructions in the INSTALL file of the distribution.
45 ;; In short, put this file on your load path and add the following
46 ;; lines to your .emacs file:
47 ;;
48 ;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t)
49 ;;
50 ;;
51 ;; SOURCE
52 ;; ======
53 ;;
54 ;; The newest version of this file can be found on the maintainers
55 ;; web site.
56 ;;
57 ;; http://www.strw.leidenuniv.el/~dominik/Tools/idlwave
58 ;;
59 ;; DOCUMENTATION
60 ;; =============
61 ;;
62 ;; IDLWAVE is documented online in info format.
63 ;; A printable version of the documentation is available from the
64 ;; maintainers webpage (see under SOURCE)
65 ;;
66 ;;
67 ;; KNOWN PROBLEMS
68 ;; ==============
69 ;;
70 ;; I don't plan on implementing directory tracking by watching the IDL
71 ;; commands entered at the prompt, since too often an IDL procedure
72 ;; will change the current directory. If you want the the idl process
73 ;; buffer to match the IDL current working just execute `M-x
74 ;; idlwave-shell-resync-dirs' (bound to "\C-c\C-d\C-w" by default.)
75 ;;
76 ;; Under XEmacs the Debug menu in the shell does not display the
77 ;; keybindings in the prefix map. There bindings are available anyway - so
78 ;; it is a bug in XEmacs.
79 ;; The Debug menu in source buffers *does* display the bindings correctly.
80 ;;
81 ;;
82 ;; CUSTOMIZATION VARIABLES
83 ;; =======================
84 ;;
85 ;; IDLWAVE has customize support - so if you want to learn about
86 ;; the variables which control the behavior of the mode, use
87 ;; `M-x idlwave-customize'.
88 ;;
89 ;;--------------------------------------------------------------------------
90 ;;
91 ;;
92 \f
93 ;;; Code:
94
95 (require 'comint)
96 (require 'idlwave)
97
98 (eval-when-compile (require 'cl))
99
100 (defvar idlwave-shell-have-new-custom nil)
101 (eval-and-compile
102 ;; Kludge to allow `defcustom' for Emacs 19.
103 (condition-case () (require 'custom) (error nil))
104 (if (and (featurep 'custom)
105 (fboundp 'custom-declare-variable)
106 (fboundp 'defface))
107 ;; We've got what we needed
108 (setq idlwave-shell-have-new-custom t)
109 ;; We have the old or no custom-library, hack around it!
110 (defmacro defgroup (&rest args) nil)
111 (defmacro defcustom (var value doc &rest args)
112 (` (defvar (, var) (, value) (, doc))))))
113
114 ;;; Customizations: idlwave-shell group
115
116 (defgroup idlwave-shell-general-setup nil
117 "General setup of the Shell interaction for IDLWAVE/Shell."
118 :prefix "idlwave-shell"
119 :group 'idlwave)
120
121 (defcustom idlwave-shell-prompt-pattern "^ ?IDL> "
122 "*Regexp to match IDL prompt at beginning of a line.
123 For example, \"^IDL> \" or \"^WAVE> \".
124 The \"^\" means beginning of line.
125 This variable is used to initialise `comint-prompt-regexp' in the
126 process buffer.
127
128 This is a fine thing to set in your `.emacs' file."
129 :group 'idlwave-shell-general-setup
130 :type 'regexp)
131
132 (defcustom idlwave-shell-process-name "idl"
133 "*Name to be associated with the IDL process. The buffer for the
134 process output is made by surrounding this name with `*'s."
135 :group 'idlwave-shell-general-setup
136 :type 'string)
137
138 ;; (defcustom idlwave-shell-automatic-start...) See idlwave.el
139
140 (defcustom idlwave-shell-initial-commands "!more=0"
141 "Initial commands, separated by newlines, to send to IDL.
142 This string is sent to the IDL process by `idlwave-shell-mode' which is
143 invoked by `idlwave-shell'."
144 :group 'idlwave-shell-initial-commands
145 :type 'string)
146
147 (defcustom idlwave-shell-use-dedicated-frame nil
148 "*Non-nil means, IDLWAVE should use a special frame to display shell buffer."
149 :group 'idlwave-shell-general-setup
150 :type 'boolean)
151
152 (defcustom idlwave-shell-frame-parameters
153 '((height . 30) (unsplittable . nil))
154 "The frame parameters for a dedicated idlwave-shell frame.
155 See also `idlwave-shell-use-dedicated-frame'.
156 The default makes the frame splittable, so that completion works correctly."
157 :group 'idlwave-shell-general-setup
158 :type '(repeat
159 (cons symbol sexp)))
160
161 (defcustom idlwave-shell-arrows-do-history t
162 "*Non-nil means UP and DOWN arrows move through command history.
163 This variable can have 3 values:
164 nil Arrows just move the cursor
165 t Arrows force the cursor back to the current command line and
166 walk the history
167 'cmdline When the cursor is in the current command line, arrows walk the
168 history. Everywhere else in the buffer, arrows move the cursor."
169 :group 'idlwave-shell-general-setup
170 :type '(choice
171 (const :tag "never" nil)
172 (const :tag "everywhere" t)
173 (const :tag "in command line only" cmdline)))
174
175 (defcustom idlwave-shell-use-toolbar t
176 "*Non-nil means, use the debugging toolbar in all IDL related buffers.
177 Starting the shell will then add the toolbar to all idlwave-mode buffers.
178 Exiting the shell will removed everywhere.
179 Available on XEmacs and on Emacs 21.x or later.
180 At any time you can toggle the display of the toolbar with
181 `C-c C-d C-t' (`idlwave-shell-toggle-toolbar')."
182 :group 'idlwave-shell-general-setup
183 :type 'boolean)
184
185 (defcustom idlwave-shell-temp-pro-prefix "/tmp/idltemp"
186 "*The prefix for temporary IDL files used when compiling regions.
187 It should be an absolute pathname.
188 The full temporary file name is obtained by to using `make-temp-name'
189 so that the name will be unique among multiple Emacs processes."
190 :group 'idlwave-shell-general-setup
191 :type 'string)
192
193 (defvar idlwave-shell-fix-inserted-breaks nil
194 "*OBSOLETE VARIABLE, is no longer used.
195
196 The documentation of this variable used to be:
197 If non-nil then run `idlwave-shell-remove-breaks' to clean up IDL messages.")
198
199 (defcustom idlwave-shell-prefix-key "\C-c\C-d"
200 "*The prefix key for the debugging map `idlwave-shell-mode-prefix-map'.
201 This variable must already be set when idlwave-shell.el is loaded.
202 Setting it in the mode-hook is too late."
203 :group 'idlwave-shell-general-setup
204 :type 'string)
205
206 (defcustom idlwave-shell-activate-prefix-keybindings t
207 "Non-nil means, the debug commands will be bound to the prefix key.
208 The prefix key itself is given in the option `idlwave-shell-prefix-key'.
209 So by default setting a breakpoint will be on C-c C-d C-b."
210 :group 'idlwave-shell-general-setup
211 :type 'boolean)
212
213 ;; (defcustom idlwave-shell-debug-modifiers... See idlwave.el
214
215 (defvar idlwave-shell-activate-alt-keybindings nil
216 "Obsolete variable. See `idlwave-shell-debug-modifiers'.")
217
218 (defcustom idlwave-shell-use-truename nil
219 "*Non-nil means, use use `file-truename' when looking for buffers.
220 If this variable is non-nil, Emacs will use the function `file-truename' to
221 resolve symbolic links in the file paths printed by e.g., STOP commands.
222 This means, unvisited files will be loaded under their truename.
223 However, when a file is already visited under a different name, IDLWAVE will
224 reuse that buffer.
225 This option was once introduced in order to avoid multiple buffers visiting
226 the same file. However, IDLWAVE no longer makes this mistake, so it is safe
227 to set this option to nil."
228 :group 'idlwave-shell-general-setup
229 :type 'boolean)
230
231 (defcustom idlwave-shell-file-name-chars "~/A-Za-z0-9+@:_.$#%={}\\-"
232 "The characters allowed in file names, as a string.
233 Used for file name completion. Must not contain `'', `,' and `\"'
234 because these are used as separators by IDL."
235 :group 'idlwave-shell-general-setup
236 :type 'string)
237
238 (defcustom idlwave-shell-mode-hook '()
239 "*Hook for customising `idlwave-shell-mode'."
240 :group 'idlwave-shell-general-setup
241 :type 'hook)
242
243 (defcustom idlwave-shell-print-expression-function nil
244 "When non-nil, a function to handle display of evaluated expressions.
245 This can be used to arrange for displaying the value of an expression
246 in (e.g.) a special frame. The function must accept one argument:
247 the expression which was evaluated. The output from IDL will be
248 available in the variable `idlwave-shell-command-output'."
249 :group 'idlwave-shell-highlighting-and-faces
250 :type 'symbol)
251
252 (defcustom idlwave-shell-use-input-mode-magic nil
253 "*Non-nil means, IDLWAVE should check for input mode spells in output.
254 The spells are strings printed by your IDL program and matched
255 by the regular expressions in `idlwave-shell-input-mode-spells'.
256 When these expressions match, IDLWAVE switches to character input mode and
257 back, respectively. See `idlwave-shell-input-mode-spells' for details."
258 :group 'idlwave-shell-general-setup
259 :type 'boolean)
260
261 (defcustom idlwave-shell-input-mode-spells
262 '("^<onechar>$" "^<chars>$" "^</chars>$")
263 "The three regular expressions which match the magic spells for input modes.
264
265 When the first regexp matches in the output streem of IDL, IDLWAVE
266 prompts for a single character and sends it immediately to IDL, similar
267 to the command \\[idlwave-shell-send-char].
268
269 When the second regexp matches, IDLWAVE switches to a blocking
270 single-character input mode. This is the same mode which can be entered
271 manually with \\[idlwave-shell-char-mode-loop].
272 This input mode exits when the third regexp matches in the output,
273 or when the IDL prompt is encountered.
274
275 The variable `idlwave-shell-use-input-mode-magic' must be non-nil to enable
276 scanning for these expressions. If the IDL program produces lots of
277 output, shell operation may be slowed down.
278
279 This mechanism is useful for correct interaction with the IDL function
280 GET_KBRD, because in normal operation IDLWAVE only sends \\n terminated
281 strings. Here is some example code which makes use of the default spells.
282
283 print,'<chars>' ; Make IDLWAVE switch to character mode
284 REPEAT BEGIN
285 A = GET_KBRD(1)
286 PRINT, BYTE(A)
287 ENDREP UNTIL A EQ 'q'
288 print,'</chars>' ; Make IDLWAVE switch back to line mode
289
290 print,'Quit the program, y or n?'
291 print,'<onechar>' ; Ask IDLWAVE to send one character
292 answer = GET_KBRD(1)
293
294 Since the IDLWAVE shell defines the system variable `!IDLWAVE_VERSION',
295 you could actually check if you are running under Emacs before printing
296 the magic strings. Here is a procedure which uses this.
297
298 Usage:
299 ======
300 idlwave_char_input ; Make IDLWAVE send one character
301 idlwave_char_input,/on ; Start the loop to send characters
302 idlwave_char_input,/off ; End the loop to send chracters
303
304
305 pro idlwave_char_input,on=on,off=off
306 ;; Test if we are running under Emacs
307 defsysv,'!idlwave_version',exists=running_emacs
308 if running_emacs then begin
309 if keyword_set(on) then print,'<chars>' $
310 else if keyword_set(off) then print,'</chars>' $
311 else print,'<onechar>'
312 endif
313 end"
314 :group 'idlwave-shell-general-setup
315 :type '(list
316 (regexp :tag "One-char regexp")
317 (regexp :tag "Char-mode regexp")
318 (regexp :tag "Line-mode regexp")))
319
320 (defcustom idlwave-shell-graphics-window-size '(500 400)
321 "Size of IDL graphics windows popped up by special IDLWAVE command.
322 The command is `C-c C-d C-f' and accepts as a prefix the window nr.
323 A command like `WINDOW,N,xsize=XX,ysize=YY' is sent to IDL."
324 :group 'idlwave-shell-general-setup
325 :type '(list
326 (integer :tag "x size")
327 (integer :tag "y size")))
328
329 ;;; Breakpoint Overlays etc
330
331 (defgroup idlwave-shell-highlighting-and-faces nil
332 "Highlighting and Faces used by the IDLWAVE Shell mode."
333 :prefix "idlwave-shell"
334 :group 'idlwave)
335
336 (defcustom idlwave-shell-mark-stop-line t
337 "*Non-nil means, mark the source code line where IDL is currently stopped.
338 Value decides about the method which is used to mark the line. Legal values
339 are:
340
341 nil Do not mark the line
342 'arrow Use the overlay arrow
343 'face Use `idlwave-shell-stop-line-face' to highlight the line.
344 t Use what IDLWAVE thinks is best. Will be a face where possible,
345 otherwise the overlay arrow.
346 The overlay-arrow has the disadvantage to hide the first chars of a line.
347 Since many people do not have the main block of IDL programs indented,
348 a face highlighting may be better.
349 On Emacs 21, the overlay arrow is displayed in a special area and never
350 hides any code, so setting this to 'arrow on Emacs 21 sounds like a good idea."
351 :group 'idlwave-shell-highlighting-and-faces
352 :type '(choice
353 (const :tag "No marking" nil)
354 (const :tag "Use overlay arrow" arrow)
355 (const :tag "Highlight with face" face)
356 (const :tag "Face or arrow." t)))
357
358 (defcustom idlwave-shell-overlay-arrow ">"
359 "*The overlay arrow to display at source lines where execution halts.
360 We use a single character by default, since the main block of IDL procedures
361 often has no indentation. Where possible, IDLWAVE will use overlays to
362 display the stop-lines. The arrow is only used on character-based terminals.
363 See also `idlwave-shell-use-overlay-arrow'."
364 :group 'idlwave-shell-highlighting-and-faces
365 :type 'string)
366
367 (defcustom idlwave-shell-stop-line-face 'highlight
368 "*The face for `idlwave-shell-stop-line-overlay'.
369 Allows you to choose the font, color and other properties for
370 line where IDL is stopped. See also `idlwave-shell-mark-stop-line'."
371 :group 'idlwave-shell-highlighting-and-faces
372 :type 'symbol)
373
374 (defcustom idlwave-shell-mark-breakpoints t
375 "*Non-nil means, mark breakpoints in the source files.
376 Legal values are:
377 nil Do not mark breakpoints.
378 'face Highlight line with `idlwave-shell-breakpoint-face'.
379 'glyph Red dot at the beginning of line. If the display does not
380 support glyphs, will use 'face instead.
381 t Glyph when possible, otherwise face (same effect as 'glyph)."
382 :group 'idlwave-shell-highlighting-and-faces
383 :type '(choice
384 (const :tag "No marking" nil)
385 (const :tag "Highlight with face" face)
386 (const :tag "Display glyph (red dot)" glyph)
387 (const :tag "Glyph or face." t)))
388
389 (defvar idlwave-shell-use-breakpoint-glyph t
390 "Obsolete variable. See `idlwave-shell-mark-breakpoints.")
391
392 (defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp-face
393 "*The face for breakpoint lines in the source code.
394 Allows you to choose the font, color and other properties for
395 lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
396 :group 'idlwave-shell-highlighting-and-faces
397 :type 'symbol)
398
399 (if idlwave-shell-have-new-custom
400 ;; We have the new customize - use it to define a customizable face
401 (defface idlwave-shell-bp-face
402 '((((class color)) (:foreground "Black" :background "Pink"))
403 (t (:underline t)))
404 "Face for highlighting lines-with-breakpoints."
405 :group 'idlwave-shell-highlighting-and-faces)
406 ;; Just copy the underline face to be on the safe side.
407 (copy-face 'underline 'idlwave-shell-bp-face))
408
409 (defcustom idlwave-shell-expression-face 'secondary-selection
410 "*The face for `idlwave-shell-expression-overlay'.
411 Allows you to choose the font, color and other properties for
412 the expression printed by IDL."
413 :group 'idlwave-shell-highlighting-and-faces
414 :type 'symbol)
415
416 ;;; End user customization variables
417
418 ;;; External variables
419 (defvar comint-last-input-start)
420 (defvar comint-last-input-end)
421
422 ;; Other variables
423
424 (defvar idlwave-shell-temp-file-base
425 (make-temp-name idlwave-shell-temp-pro-prefix)
426 "Base name of the temporary files.")
427
428 (defvar idlwave-shell-temp-pro-file
429 (concat idlwave-shell-temp-file-base ".pro")
430 "Absolute pathname for temporary IDL file for compiling regions")
431
432 (defvar idlwave-shell-temp-rinfo-save-file
433 (concat idlwave-shell-temp-file-base ".sav")
434 "Absolute pathname for temporary IDL file save file for routine_info.
435 This is used to speed up the reloading of the routine info procedure
436 before use by the shell.")
437
438
439 (defvar idlwave-shell-dirstack-query "printd"
440 "Command used by `idlwave-shell-resync-dirs' to query IDL for
441 the directory stack.")
442
443 (defvar idlwave-shell-path-query "__pa=expand_path(!path,/array)&for i=0,n_elements(__pa)-1 do print,'PATH:<'+__pa[i]+'>'&print,'SYSDIR:<'+!dir+'>'"
444 "The command which gets !PATH and !DIR infor from the shell.")
445
446 (defvar idlwave-shell-mode-line-info nil
447 "Additional info displayed in the mode line")
448
449 (defvar idlwave-shell-default-directory nil
450 "The default directory in the idlwave-shell buffer, of outside use.")
451
452 (defvar idlwave-shell-last-save-and-action-file nil
453 "The last file which was compiled with `idlwave-shell-save-and-...'.")
454
455 ;; Highlighting uses overlays. When necessary, require the emulation.
456 (if (not (fboundp 'make-overlay))
457 (condition-case nil
458 (require 'overlay)
459 (error nil)))
460
461 (defvar idlwave-shell-stop-line-overlay nil
462 "The overlay for where IDL is currently stopped.")
463 (defvar idlwave-shell-is-stopped nil)
464 (defvar idlwave-shell-expression-overlay nil
465 "The overlay for where IDL is currently stopped.")
466 ;; If these were already overlays, delete them. This probably means that we
467 ;; are reloading this file.
468 (if (overlayp idlwave-shell-stop-line-overlay)
469 (delete-overlay idlwave-shell-stop-line-overlay))
470 (if (overlayp idlwave-shell-expression-overlay)
471 (delete-overlay idlwave-shell-expression-overlay))
472 ;; Set to nil initially
473 (setq idlwave-shell-stop-line-overlay nil
474 idlwave-shell-expression-overlay nil)
475
476 ;; Define the shell stop overlay. When left nil, the arrow will be used.
477 (cond
478 ((or (null idlwave-shell-mark-stop-line)
479 (eq idlwave-shell-mark-stop-line 'arrow))
480 ;; Leave the overlay nil
481 nil)
482
483 ((eq idlwave-shell-mark-stop-line 'face)
484 ;; Try to use a face. If not possible, arrow will be used anyway
485 ;; So who can display faces?
486 (when (or (featurep 'xemacs) ; XEmacs can do also ttys
487 (fboundp 'tty-defined-colors) ; Emacs 21 as well
488 window-system) ; Window systems always
489 (progn
490 (setq idlwave-shell-stop-line-overlay (make-overlay 1 1))
491 (overlay-put idlwave-shell-stop-line-overlay
492 'face idlwave-shell-stop-line-face))))
493
494 (t
495 ;; IDLWAVE may decide. Will use a face on window systems, arrow elsewhere
496 (if window-system
497 (progn
498 (setq idlwave-shell-stop-line-overlay (make-overlay 1 1))
499 (overlay-put idlwave-shell-stop-line-overlay
500 'face idlwave-shell-stop-line-face)))))
501
502 ;; Now the expression overlay
503 (setq idlwave-shell-expression-overlay (make-overlay 1 1))
504 (overlay-put idlwave-shell-expression-overlay
505 'face idlwave-shell-expression-face)
506 (defvar idlwave-shell-bp-query "help,/breakpoints"
507 "Command to obtain list of breakpoints")
508
509 (defvar idlwave-shell-command-output nil
510 "String for accumulating current command output.")
511
512 (defvar idlwave-shell-post-command-hook nil
513 "Lisp list expression or function to run when an IDL command is finished.
514 The current command is finished when the IDL prompt is displayed.
515 This is evaluated if it is a list or called with funcall.")
516
517 (defvar idlwave-shell-hide-output nil
518 "If non-nil the process output is not inserted into the output
519 buffer.")
520
521 (defvar idlwave-shell-accumulation nil
522 "Accumulate last line of output.")
523
524 (defvar idlwave-shell-command-line-to-execute nil)
525 (defvar idlwave-shell-cleanup-hook nil
526 "List of functions to do cleanup when the shell exits.")
527
528 (defvar idlwave-shell-pending-commands nil
529 "List of commands to be sent to IDL.
530 Each element of the list is list of \(CMD PCMD HIDE\), where CMD is a
531 string to be sent to IDL and PCMD is a post-command to be placed on
532 `idlwave-shell-post-command-hook'. If HIDE is non-nil, hide the output
533 from command CMD. PCMD and HIDE are optional.")
534
535 (defun idlwave-shell-buffer ()
536 "Name of buffer associated with IDL process.
537 The name of the buffer is made by surrounding `idlwave-shell-process-name
538 with `*'s."
539 (concat "*" idlwave-shell-process-name "*"))
540
541 (defvar idlwave-shell-ready nil
542 "If non-nil can send next command to IDL process.")
543
544 ;;; The following are the types of messages we attempt to catch to
545 ;;; resync our idea of where IDL execution currently is.
546 ;;;
547
548 (defvar idlwave-shell-halt-frame nil
549 "The frame associated with halt/breakpoint messages.")
550
551 (defvar idlwave-shell-step-frame nil
552 "The frame associated with step messages.")
553
554 (defvar idlwave-shell-trace-frame nil
555 "The frame associated with trace messages.")
556
557 (defconst idlwave-shell-halt-messages
558 '("^% Execution halted at"
559 "^% Interrupted at:"
560 "^% Stepped to:"
561 "^% At "
562 "^% Stop encountered:"
563 )
564 "*A list of regular expressions matching IDL messages.
565 These are the messages containing file and line information where
566 IDL is currently stopped.")
567
568 (defconst idlwave-shell-halt-messages-re
569 (mapconcat 'identity idlwave-shell-halt-messages "\\|")
570 "The regular expression computed from idlwave-shell-halt-messages")
571
572 (defconst idlwave-shell-trace-messages
573 '("^% At " ;; First line of a trace message
574 )
575 "*A list of regular expressions matching IDL trace messages.
576 These are the messages containing file and line information where
577 IDL will begin looking for the next statement to execute.")
578
579 (defconst idlwave-shell-step-messages
580 '("^% Stepped to:"
581 )
582 "*A list of regular expressions matching stepped execution messages.
583 These are IDL messages containing file and line information where
584 IDL has currently stepped.")
585
586 (defvar idlwave-shell-break-message "^% Breakpoint at:"
587 "*Regular expression matching an IDL breakpoint message line.")
588
589
590 (defvar idlwave-shell-bp-alist)
591 ;(defvar idlwave-shell-post-command-output)
592 (defvar idlwave-shell-sources-alist)
593 (defvar idlwave-shell-menu-def)
594 (defvar idlwave-shell-mode-menu)
595 (defvar idlwave-shell-initial-commands)
596 (defvar idlwave-shell-syntax-error)
597 (defvar idlwave-shell-other-error)
598 (defvar idlwave-shell-error-buffer)
599 (defvar idlwave-shell-error-last)
600 (defvar idlwave-shell-bp-buffer)
601 (defvar idlwave-shell-sources-query)
602 (defvar idlwave-shell-mode-map)
603 (defvar idlwave-shell-calling-stack-index)
604
605 (defun idlwave-shell-mode ()
606 "Major mode for interacting with an inferior IDL process.
607
608 1. Shell Interaction
609 -----------------
610 RET after the end of the process' output sends the text from the
611 end of process to the end of the current line. RET before end of
612 process output copies the current line (except for the prompt) to the
613 end of the buffer.
614
615 Command history, searching of previous commands, command line
616 editing are available via the comint-mode key bindings, by default
617 mostly on the key `C-c'. Command history is also available with
618 the arrow keys UP and DOWN.
619
620 2. Completion
621 ----------
622 TAB and M-TAB do completion of IDL routines, classes and keywords -
623 similar to M-TAB in `idlwave-mode'. In executive commands and
624 strings, it completes file names. Abbreviations are also expanded
625 like in `idlwave-mode'.
626
627 3. Routine Info
628 ------------
629 `\\[idlwave-routine-info]' displays information about an IDL routine near point,
630 just like in `idlwave-mode'. The module used is the one at point or
631 the one whose argument list is being edited.
632 To update IDLWAVE's knowledge about compiled or edited modules, use
633 \\[idlwave-update-routine-info].
634 \\[idlwave-find-module] find the source of a module.
635 \\[idlwave-resolve] tells IDL to compile an unresolved module.
636 \\[idlwave-context-help] shows the online help on the item at
637 point, if online help has been installed.
638
639
640 4. Debugging
641 ---------
642 A complete set of commands for compiling and debugging IDL programs
643 is available from the menu. Also keybindings starting with a
644 `C-c C-d' prefix are available for most commands in the *idl* buffer
645 and also in source buffers. The best place to learn about the
646 keybindings is again the menu.
647
648 On Emacs versions where this is possible, a debugging toolbar is
649 installed.
650
651 When IDL is halted in the middle of a procedure, the corresponding
652 line of that procedure file is displayed with an overlay in another
653 window. Breakpoints are also highlighted in the source.
654
655 \\[idlwave-shell-resync-dirs] queries IDL in order to change Emacs current directory
656 to correspond to the IDL process current directory.
657
658 5. Hooks
659 -----
660 Turning on `idlwave-shell-mode' runs `comint-mode-hook' and
661 `idlwave-shell-mode-hook' (in that order).
662
663 6. Documentation and Customization
664 -------------------------------
665 Info documentation for this package is available. Use \\[idlwave-info]
666 to display (complain to your sysadmin if that does not work).
667 For Postscript and HTML versions of the documentation, check IDLWAVE's
668 homepage at `http://www.strw.leidenuniv.nl/~dominik/Tools/idlwave'.
669 IDLWAVE has customize support - see the group `idlwave'.
670
671 7. Keybindings
672 -----------
673 \\{idlwave-shell-mode-map}"
674
675 (interactive)
676 ;; We don't do `kill-all-local-variables' here, because this is done by
677 ;; comint - idlwave-shell-mode only add on top of that.
678 (setq comint-prompt-regexp idlwave-shell-prompt-pattern)
679 (setq comint-process-echoes t)
680 ;; Can not use history expansion because "!" is used for system variables.
681 (setq comint-input-autoexpand nil)
682 (setq comint-input-ring-size 64)
683 (make-local-variable 'comint-completion-addsuffix)
684 (set (make-local-variable 'completion-ignore-case) t)
685 (setq comint-completion-addsuffix '("/" . ""))
686 (setq comint-input-ignoredups t)
687 (setq major-mode 'idlwave-shell-mode)
688 (setq mode-name "IDL-Shell")
689 (setq idlwave-shell-mode-line-info nil)
690 (setq mode-line-format
691 '(""
692 mode-line-modified
693 mode-line-buffer-identification
694 " "
695 global-mode-string
696 " %[("
697 mode-name
698 mode-line-process
699 minor-mode-alist
700 "%n"
701 ")%]-"
702 idlwave-shell-mode-line-info
703 "---"
704 (line-number-mode "L%l--")
705 (column-number-mode "C%c--")
706 (-3 . "%p")
707 "-%-"))
708 ;; (make-local-variable 'idlwave-shell-bp-alist)
709 (setq idlwave-shell-halt-frame nil
710 idlwave-shell-trace-frame nil
711 idlwave-shell-command-output nil
712 idlwave-shell-step-frame nil)
713 (idlwave-shell-display-line nil)
714 (setq idlwave-shell-calling-stack-index 0)
715
716 ;; Make sure comint-last-input-end does not go to beginning of
717 ;; buffer (in case there were other processes already in this buffer).
718 (set-marker comint-last-input-end (point))
719 (setq idlwave-idlwave_routine_info-compiled nil)
720 (setq idlwave-shell-ready nil)
721 (setq idlwave-shell-bp-alist nil)
722 (idlwave-shell-update-bp-overlays) ; Throw away old overlays
723 (setq idlwave-shell-sources-alist nil)
724 (setq idlwave-shell-default-directory default-directory)
725 (setq idlwave-shell-hide-output nil)
726 (make-local-hook 'kill-buffer-hook)
727 (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm
728 nil 'local)
729 (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local)
730 (add-hook 'kill-emacs-hook 'idlwave-shell-delete-temp-files)
731 (use-local-map idlwave-shell-mode-map)
732 (easy-menu-add idlwave-shell-mode-menu idlwave-shell-mode-map)
733
734 (set (make-local-variable 'comint-scroll-to-bottom-on-input) t)
735 (set (make-local-variable 'comint-scroll-show-maximum-output) t)
736
737 ;; IDLWAVE syntax, and turn on abbreviations
738 (setq local-abbrev-table idlwave-mode-abbrev-table)
739 (set-syntax-table idlwave-mode-syntax-table)
740 (set (make-local-variable 'comment-start) ";")
741 (setq abbrev-mode t)
742 (make-local-hook 'post-command-hook)
743 (add-hook 'post-command-hook 'idlwave-command-hook nil t)
744
745 ;; Run the hooks.
746 (run-hooks 'idlwave-shell-mode-hook)
747 (idlwave-shell-send-command idlwave-shell-initial-commands nil 'hide)
748 ;; Define a system variable which knows the version of IDLWAVE
749 (idlwave-shell-send-command
750 (format "defsysv,'!idlwave_version','%s',1" idlwave-mode-version)
751 nil 'hide)
752 (if (and (not idlwave-path-alist)
753 (not idlwave-sys-dir))
754 (idlwave-shell-send-command idlwave-shell-path-query
755 'idlwave-shell-get-path-info
756 'hide)))
757
758 (defun idlwave-shell-get-path-info ()
759 (let* ((rpl (idlwave-shell-path-filter))
760 (sysdir (car rpl))
761 (dirs (cdr rpl)))
762 (setq idlwave-sys-dir sysdir)
763 (setq idlwave-path-alist (mapcar (lambda(x) (cons x nil))
764 dirs))))
765
766 (if (not (fboundp 'idl-shell))
767 (fset 'idl-shell 'idlwave-shell))
768
769 (defvar idlwave-shell-idl-wframe nil
770 "Frame for displaying the idl shell window.")
771 (defvar idlwave-shell-display-wframe nil
772 "Frame for displaying the idl source files.")
773
774 (defvar idlwave-shell-calling-stack-index 0)
775 (defvar idlwave-shell-calling-stack-routine nil)
776
777 (defun idlwave-shell-source-frame ()
778 "Return the frame to be used for source display."
779 (if idlwave-shell-use-dedicated-frame
780 ;; We want separate frames for source and shell
781 (if (frame-live-p idlwave-shell-display-wframe)
782 ;; The frame exists, so we use it.
783 idlwave-shell-display-wframe
784 ;; The frame does not exist. We use the current frame.
785 ;; However, if the current is the shell frame, we make a new frame.
786 (setq idlwave-shell-display-wframe
787 (if (eq (selected-frame) idlwave-shell-idl-wframe)
788 (make-frame)
789 (selected-frame))))))
790
791 (defun idlwave-shell-shell-frame ()
792 "Return the frame to be used for the shell buffer."
793 (if idlwave-shell-use-dedicated-frame
794 ;; We want a dedicated frame
795 (if (frame-live-p idlwave-shell-idl-wframe)
796 ;; It does exist, so we use it.
797 idlwave-shell-idl-wframe
798 ;; It does not exist. Check if we have a source frame.
799 (if (not (frame-live-p idlwave-shell-display-wframe))
800 ;; We do not have a source frame, so we use this one.
801 (setq idlwave-shell-display-wframe (selected-frame)))
802 ;; Return a new frame
803 (setq idlwave-shell-idl-wframe
804 (make-frame idlwave-shell-frame-parameters)))))
805
806 ;;;###autoload
807 (defun idlwave-shell (&optional arg)
808 "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'.
809 If buffer exists but shell process is not running, start new IDL.
810 If buffer exists and shell process is running, just switch to the buffer.
811
812 When called with a prefix ARG, or when `idlwave-shell-use-dedicated-frame'
813 is non-nil, the shell buffer and the source buffers will be in
814 separate frames.
815
816 The command to run comes from variable `idlwave-shell-explicit-file-name'.
817
818 The buffer is put in `idlwave-shell-mode', providing commands for sending
819 input and controlling the IDL job. See help on `idlwave-shell-mode'.
820 See also the variable `idlwave-shell-prompt-pattern'.
821
822 \(Type \\[describe-mode] in the shell buffer for a list of commands.)"
823 (interactive "P")
824
825 ;; A non-nil arg means, we want a dedicated frame. This will last
826 ;; for the current editing session.
827 (if arg (setq idlwave-shell-use-dedicated-frame t))
828 (if (equal arg '(16)) (setq idlwave-shell-use-dedicated-frame nil))
829
830 ;; Check if the process still exists. If not, create it.
831 (unless (comint-check-proc (idlwave-shell-buffer))
832 (let* ((prg (or idlwave-shell-explicit-file-name "idl"))
833 (buf (apply 'make-comint
834 idlwave-shell-process-name prg nil
835 idlwave-shell-command-line-options))
836 (process (get-buffer-process buf)))
837 (setq idlwave-idlwave_routine_info-compiled nil)
838 (set-process-filter process 'idlwave-shell-filter)
839 (set-process-sentinel process 'idlwave-shell-sentinel)
840 (set-buffer buf)
841 (idlwave-shell-mode)))
842 (let ((window (idlwave-display-buffer (idlwave-shell-buffer) nil
843 (idlwave-shell-shell-frame)))
844 (current-window (selected-window)))
845 (select-window window)
846 (goto-char (point-max))
847 (select-window current-window)
848 (raise-frame (window-frame window))
849 (if (eq (selected-frame) (window-frame window))
850 (select-window window))
851 ))
852
853 (defun idlwave-shell-recenter-shell-window (&optional arg)
854 "Run `idlwave-shell', but make sure the current window stays selected."
855 (interactive "P")
856 (let ((window (selected-window)))
857 (idlwave-shell arg)
858 (select-window window)))
859
860 (defun idlwave-shell-send-command (&optional cmd pcmd hide preempt)
861 "Send a command to IDL process.
862
863 \(CMD PCMD HIDE\) are placed at the end of `idlwave-shell-pending-commands'.
864 If IDL is ready the first command, CMD, in
865 `idlwave-shell-pending-commands' is sent to the IDL process. If optional
866 second argument PCMD is non-nil it will be placed on
867 `idlwave-shell-post-command-hook' when CMD is executed. If the optional
868 third argument HIDE is non-nil, then hide output from CMD.
869 If optional fourth argument PREEMPT is non-nil CMD is put at front of
870 `idlwave-shell-pending-commands'.
871
872 IDL is considered ready if the prompt is present
873 and if `idlwave-shell-ready' is non-nil."
874
875 ;(setq hide nil) ; FIXME: turn this on for debugging only
876 (let (buf proc)
877 ;; Get or make the buffer and its process
878 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
879 (not (setq proc (get-buffer-process buf))))
880 (if (not idlwave-shell-automatic-start)
881 (error
882 (substitute-command-keys
883 "You need to first start an IDL shell with \\[idlwave-shell]"))
884 (idlwave-shell-recenter-shell-window)
885 (setq buf (get-buffer (idlwave-shell-buffer)))
886 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
887 (not (setq proc (get-buffer-process buf))))
888 ;; Still nothing
889 (error "Problem with autostarting IDL shell"))))
890
891 (save-excursion
892 (set-buffer buf)
893 (goto-char (process-mark proc))
894 ;; To make this easy, always push CMD onto pending commands
895 (if cmd
896 (setq idlwave-shell-pending-commands
897 (if preempt
898 ;; Put at front.
899 (append (list (list cmd pcmd hide))
900 idlwave-shell-pending-commands)
901 ;; Put at end.
902 (append idlwave-shell-pending-commands
903 (list (list cmd pcmd hide))))))
904 ;; Check if IDL ready
905 (if (and idlwave-shell-ready
906 ;; Check for IDL prompt
907 (save-excursion
908 (forward-line 0)
909 ;; (beginning-of-line) ; Changed for Emacs 21
910 (looking-at idlwave-shell-prompt-pattern)))
911 ;; IDL ready for command
912 (if idlwave-shell-pending-commands
913 ;; execute command
914 (let* ((lcmd (car idlwave-shell-pending-commands))
915 (cmd (car lcmd))
916 (pcmd (nth 1 lcmd))
917 (hide (nth 2 lcmd)))
918 ;; If this is an executive command, reset the stack pointer
919 (if (eq (string-to-char cmd) ?.)
920 (setq idlwave-shell-calling-stack-index 0))
921 ;; Set post-command
922 (setq idlwave-shell-post-command-hook pcmd)
923 ;; Output hiding
924 ;;; Debug code
925 ;;; (setq idlwave-shell-hide-output nil)
926 (setq idlwave-shell-hide-output hide)
927 ;; Pop command
928 (setq idlwave-shell-pending-commands
929 (cdr idlwave-shell-pending-commands))
930 ;; Send command for execution
931 (set-marker comint-last-input-start (point))
932 (set-marker comint-last-input-end (point))
933 (comint-simple-send proc cmd)
934 (setq idlwave-shell-ready nil)))))))
935
936 (defun idlwave-shell-send-char (c &optional no-error)
937 "Send one character to the shell, without a newline."
938 (interactive "cChar to send to IDL: ")
939 (let ((errf (if (interactive-p) 'error 'message))
940 buf proc)
941 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
942 (not (setq proc (get-buffer-process buf))))
943 (funcall errf "Shell is not running"))
944 (if (equal c ?\C-g)
945 (funcall errf "Abort")
946 (comint-send-string proc (char-to-string c)))))
947
948 (defvar idlwave-shell-char-mode-active)
949 (defun idlwave-shell-input-mode-magic (string)
950 "Check STRING for magic words and toggle character input mode.
951 See also the variable `idlwave-shell-input-mode-spells'."
952 (cond
953 ((string-match (car idlwave-shell-input-mode-spells) string)
954 (call-interactively 'idlwave-shell-send-char))
955 ((and (boundp 'idlwave-shell-char-mode-active)
956 (string-match (nth 2 idlwave-shell-input-mode-spells) string))
957 (setq idlwave-shell-char-mode-active 'exit))
958 ((string-match (nth 1 idlwave-shell-input-mode-spells) string)
959 ;; Set a timer which will soon start the character loop
960 (if (fboundp 'start-itimer)
961 (start-itimer "IDLWAVE Char Mode" 'idlwave-shell-char-mode-loop 0.5
962 nil nil t 'no-error)
963 (run-at-time 0.5 nil 'idlwave-shell-char-mode-loop 'no-error)))))
964
965 (defvar keyboard-quit)
966 (defun idlwave-shell-char-mode-loop (&optional no-error)
967 "Enter a loop which accepts single characters and sends them to IDL.
968 Characters are sent one by one, without newlines. The loop is blocking
969 and intercepts all input events to Emacs. You can use this command
970 to interact with the IDL command GET_KBRD.
971 The loop can be aborted by typing `C-g'. The loop also exits automatically
972 when the IDL prompt gets displayed again after the current IDL command."
973 (interactive)
974
975 ;; First check if there is a shell waiting for input
976 (let ((idlwave-shell-char-mode-active t)
977 (errf (if no-error 'message 'error))
978 buf proc c)
979 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
980 (not (setq proc (get-buffer-process buf))))
981 (funcall errf "Shell is not running"))
982 (if idlwave-shell-ready
983 (funcall errf "No IDL program seems to be waiting for input"))
984
985 ;; OK, start the loop
986 (message "Character mode on: Sending single chars (`C-g' to exit)")
987 (message
988 (catch 'exit
989 (while t
990 ;; Wait for input
991 ;; FIXME: Is it too dangerous to inhibit quit here?
992 (let ((inhibit-quit t))
993 ;; We wait and check frequently if we should abort
994 (while (sit-for 0.3)
995 (and idlwave-shell-ready
996 (throw 'exit "Character mode off (prompt displayed)"))
997 (and (eq idlwave-shell-char-mode-active 'exit)
998 (throw 'exit "Character mode off (closing spell incantation)")))
999 ;; Interpret input as a character - ignore non-char input
1000 (condition-case nil
1001 (setq c (read-char))
1002 (error (ding) (throw 'exit "Character mode off")))
1003 (cond
1004 ((null c) ; Non-char event: ignore
1005 (ding))
1006 ((equal c ?\C-g) ; Abort the loop
1007 (setq keyboard-quit nil)
1008 (ding)
1009 (throw 'exit "Character mode off (keyboard quit)"))
1010 (t ; Send the character and continue the loop
1011 (comint-send-string proc (char-to-string c))))
1012 (and (eq idlwave-shell-char-mode-active 'exit)
1013 (throw 'exit "Single char loop exited"))))))))
1014
1015 (defun idlwave-shell-up-or-history (&optional arg)
1016 "When in last line of process buffer, do `comint-previous-input'.
1017 Otherwise just do `previous-line'."
1018 (interactive "p")
1019 (if (eq t idlwave-shell-arrows-do-history) (goto-char (point-max)))
1020 (if (and idlwave-shell-arrows-do-history
1021 (>= (1+ (save-excursion (end-of-line) (point)))
1022 (marker-position
1023 (process-mark (get-buffer-process (current-buffer))))))
1024 (progn
1025 (and (not (eolp)) (kill-line nil))
1026 (comint-previous-input arg))
1027 (previous-line arg)))
1028
1029 (defun idlwave-shell-down-or-history (&optional arg)
1030 "When in last line of process buffer, do `comint-next-input'.
1031 Otherwise just do `next-line'."
1032 (interactive "p")
1033 (if (eq t idlwave-shell-arrows-do-history) (goto-char (point-max)))
1034 (if (and idlwave-shell-arrows-do-history
1035 (>= (1+ (save-excursion (end-of-line) (point)))
1036 (marker-position
1037 (process-mark (get-buffer-process (current-buffer))))))
1038 (progn
1039 (and (not (eolp)) (kill-line nil))
1040 (comint-next-input arg))
1041 (next-line arg)))
1042
1043 ;; There was a report that a newer version of comint.el changed the
1044 ;; name of comint-filter to comint-output-filter. Unfortunately, we
1045 ;; have yet to upgrade.
1046
1047 (defun idlwave-shell-comint-filter (process string) nil)
1048 (if (fboundp 'comint-output-filter)
1049 (fset 'idlwave-shell-comint-filter (symbol-function 'comint-output-filter))
1050 (fset 'idlwave-shell-comint-filter (symbol-function 'comint-filter)))
1051
1052 (defun idlwave-shell-is-running ()
1053 "Return t if the shell process is running."
1054 (eq (process-status idlwave-shell-process-name) 'run))
1055
1056 (defvar idlwave-shell-hidden-output-buffer " *idlwave-shell-hidden-output*"
1057 "Buffer containing hidden output from IDL commands.")
1058
1059 (defun idlwave-shell-filter (proc string)
1060 "Replace Carriage returns in output. Watch for prompt.
1061 When the IDL prompt is received executes `idlwave-shell-post-command-hook'
1062 and then calls `idlwave-shell-send-command' for any pending commands."
1063 ;; We no longer do the cleanup here - this is done by the process sentinel
1064 (when (eq (process-status idlwave-shell-process-name) 'run)
1065 ;; OK, process is still running, so we can use it.
1066 (let ((data (match-data)))
1067 (unwind-protect
1068 (progn
1069 ;; May change the original match data.
1070 (let (p)
1071 (while (setq p (string-match "\C-M" string))
1072 (aset string p ? )))
1073 ;;; Test/Debug code
1074 ;; (save-excursion (set-buffer (get-buffer-create "*test*"))
1075 ;; (goto-char (point-max))
1076 ;; (insert "%%%" string))
1077 ;;
1078 ;; Keep output
1079
1080 ; Should not keep output because the concat is costly. If hidden put
1081 ; the output in a hide-buffer. Then when the output is needed in post
1082 ; processing can access either the hide buffer or the idlwave-shell
1083 ; buffer. Then watching for the prompt is easier. Furthermore, if it
1084 ; is hidden and there is no post command, could throw away output.
1085 ; (setq idlwave-shell-command-output
1086 ; (concat idlwave-shell-command-output string))
1087 ;; Insert the string. Do this before getting the
1088 ;; state.
1089 (if idlwave-shell-hide-output
1090 (save-excursion
1091 (set-buffer
1092 (get-buffer-create idlwave-shell-hidden-output-buffer))
1093 (goto-char (point-max))
1094 (insert string))
1095 (idlwave-shell-comint-filter proc string))
1096 ;; Watch for prompt - need to accumulate the current line
1097 ;; since it may not be sent all at once.
1098 (if (string-match "\n" string)
1099 (progn
1100 (if idlwave-shell-use-input-mode-magic
1101 (idlwave-shell-input-mode-magic
1102 (concat idlwave-shell-accumulation string)))
1103 (setq idlwave-shell-accumulation
1104 (substring string
1105 (progn (string-match "\\(.*\n\\)*" string)
1106 (match-end 0)))))
1107 (setq idlwave-shell-accumulation
1108 (concat idlwave-shell-accumulation string)))
1109
1110
1111 ;; Check for prompt in current line
1112 (if (setq idlwave-shell-ready
1113 (string-match idlwave-shell-prompt-pattern
1114 idlwave-shell-accumulation))
1115 (progn
1116 (if idlwave-shell-hide-output
1117 (save-excursion
1118 (set-buffer idlwave-shell-hidden-output-buffer)
1119 (goto-char (point-min))
1120 (re-search-forward idlwave-shell-prompt-pattern nil t)
1121 (setq idlwave-shell-command-output
1122 (buffer-substring (point-min) (point)))
1123 (delete-region (point-min) (point)))
1124 (setq idlwave-shell-command-output
1125 (save-excursion
1126 (set-buffer
1127 (process-buffer proc))
1128 (buffer-substring
1129 (progn
1130 (goto-char (process-mark proc))
1131 (beginning-of-line nil)
1132 (point))
1133 comint-last-input-end))))
1134 ;;; Test/Debug code
1135 ;; (save-excursion (set-buffer
1136 ;; (get-buffer-create "*idlwave-shell-output*"))
1137 ;; (goto-char (point-max))
1138 ;; (insert "%%%" string))
1139 ;; Scan for state and do post command - bracket them
1140 ;; with idlwave-shell-ready=nil since they
1141 ;; may call idlwave-shell-send-command.
1142 (let ((idlwave-shell-ready nil))
1143 (idlwave-shell-scan-for-state)
1144 ;; Unset idlwave-shell-ready to prevent sending
1145 ;; commands to IDL while running hook.
1146 (if (listp idlwave-shell-post-command-hook)
1147 (eval idlwave-shell-post-command-hook)
1148 (funcall idlwave-shell-post-command-hook))
1149 ;; Reset to default state for next command.
1150 ;; Also we do not want to find this prompt again.
1151 (setq idlwave-shell-accumulation nil
1152 idlwave-shell-command-output nil
1153 idlwave-shell-post-command-hook nil
1154 idlwave-shell-hide-output nil))
1155 ;; Done with post command. Do pending command if
1156 ;; any.
1157 (idlwave-shell-send-command))))
1158 (store-match-data data)))))
1159
1160 (defun idlwave-shell-sentinel (process event)
1161 "The sentinel function for the IDLWAVE shell process."
1162 (let* ((buf (idlwave-shell-buffer))
1163 (win (get-buffer-window buf)))
1164 (when (get-buffer buf)
1165 (save-excursion
1166 (set-buffer (idlwave-shell-buffer))
1167 (goto-char (point-max))
1168 (insert (format "\n\n Process %s %s" process event))))
1169 (when (and (> (length (frame-list)) 1)
1170 (frame-live-p idlwave-shell-idl-wframe))
1171 (delete-frame idlwave-shell-idl-wframe)
1172 (setq idlwave-shell-idl-wframe nil
1173 idlwave-shell-display-wframe nil))
1174 (when (window-live-p win)
1175 (delete-window win))
1176 (idlwave-shell-cleanup)))
1177
1178 (defun idlwave-shell-scan-for-state ()
1179 "Scan for state info.
1180 Looks for messages in output from last IDL command indicating where
1181 IDL has stopped. The types of messages we are interested in are
1182 execution halted, stepped, breakpoint, interrupted at and trace
1183 messages. We ignore error messages otherwise.
1184 For breakpoint messages process any attached count or command
1185 parameters.
1186 Update the windows if a message is found."
1187 (let (update)
1188 (cond
1189 ;; Make sure we have output
1190 ((not idlwave-shell-command-output))
1191
1192 ;; Various types of HALT messages.
1193 ((string-match idlwave-shell-halt-messages-re
1194 idlwave-shell-command-output)
1195 ;; Grab the file and line state info.
1196 (setq idlwave-shell-calling-stack-index 0)
1197 (setq idlwave-shell-halt-frame
1198 (idlwave-shell-parse-line
1199 (substring idlwave-shell-command-output (match-end 0)))
1200 update t))
1201
1202 ;; Handle breakpoints separately
1203 ((string-match idlwave-shell-break-message
1204 idlwave-shell-command-output)
1205 (setq idlwave-shell-calling-stack-index 0)
1206 (setq idlwave-shell-halt-frame
1207 (idlwave-shell-parse-line
1208 (substring idlwave-shell-command-output (match-end 0)))
1209 update t)
1210 ;; We used to to counting hits on breakpoints
1211 ;; this is no longer supported since IDL breakpoints
1212 ;; have learned counting.
1213 ;; Do breakpoint command processing
1214 (let ((bp (assoc
1215 (list
1216 (nth 0 idlwave-shell-halt-frame)
1217 (nth 1 idlwave-shell-halt-frame))
1218 idlwave-shell-bp-alist)))
1219 (if bp
1220 (let ((cmd (idlwave-shell-bp-get bp 'cmd)))
1221 (if cmd
1222 ;; Execute command
1223 (if (listp cmd)
1224 (eval cmd)
1225 (funcall cmd))))
1226 ;; A breakpoint that we did not know about - perhaps it was
1227 ;; set by the user or IDL isn't reporting breakpoints like
1228 ;; we expect. Lets update our list.
1229 (idlwave-shell-bp-query)))))
1230
1231 ;; Handle compilation errors in addition to the above
1232 (if (and idlwave-shell-command-output
1233 (or (string-match
1234 idlwave-shell-syntax-error idlwave-shell-command-output)
1235 (string-match
1236 idlwave-shell-other-error idlwave-shell-command-output)))
1237 (progn
1238 (save-excursion
1239 (set-buffer
1240 (get-buffer-create idlwave-shell-error-buffer))
1241 (erase-buffer)
1242 (insert idlwave-shell-command-output)
1243 (goto-char (point-min))
1244 (setq idlwave-shell-error-last (point)))
1245 (idlwave-shell-goto-next-error)))
1246
1247 ;; Do update
1248 (when update
1249 (idlwave-shell-display-line (idlwave-shell-pc-frame)))))
1250
1251
1252 (defvar idlwave-shell-error-buffer " *idlwave-shell-errors*"
1253 "Buffer containing syntax errors from IDL compilations.")
1254
1255
1256 ;; FIXME: the following two variables do not currently allow line breaks
1257 ;; in module and file names. I am not sure if it will be necessary to
1258 ;; change this. Currently it seems to work the way it is.
1259 (defvar idlwave-shell-syntax-error
1260 "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"
1261 "A regular expression to match an IDL syntax error.
1262 The first \(..\) pair should match the file name. The second pair
1263 should match the line number.")
1264
1265 (defvar idlwave-shell-other-error
1266 "^% .*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"
1267 "A regular expression to match any IDL error.
1268 The first \(..\) pair should match the file name. The second pair
1269 should match the line number.")
1270
1271 (defvar idlwave-shell-file-line-message
1272 (concat
1273 "\\(" ; program name group (1)
1274 "\\<[a-zA-Z][a-zA-Z0-9_$:]*" ; start with a letter, followed by [..]
1275 "\\([ \t]*\n[ \t]*[a-zA-Z0-9_$:]+\\)*"; continuation lines program name (2)
1276 "\\)" ; end program name group (1)
1277 "[ \t\n]+" ; white space
1278 "\\(" ; line number group (3)
1279 "[0-9]+" ; the line number (the fix point)
1280 "\\([ \t]*\n[ \t]*[0-9]+\\)*" ; continuation lines number (4)
1281 "\\)" ; end line number group (3)
1282 "[ \t\n]+" ; white space
1283 "\\(" ; file name group (5)
1284 "[^ \t\n]+" ; file names can contain any non-white
1285 "\\([ \t]*\n[ \t]*[^ \t\n]+\\)*" ; continuation lines file name (6)
1286 "\\)" ; end line number group (5)
1287 )
1288 "*A regular expression to parse out the file name and line number.
1289 The 1st group should match the subroutine name.
1290 The 3rd group is the line number.
1291 The 5th group is the file name.
1292 All parts may contain linebreaks surrounded by spaces. This is important
1293 in IDL5 which inserts random linebreaks in long module and file names.")
1294
1295 (defun idlwave-shell-parse-line (string)
1296 "Parse IDL message for the subroutine, file name and line number.
1297 We need to work hard here to remove the stupid line breaks inserted by
1298 IDL5. These line breaks can be right in the middle of procedure
1299 or file names.
1300 It is very difficult to come up with a robust solution. This one seems
1301 to be pretty good though.
1302
1303 Here is in what ways it improves over the previous solution:
1304
1305 1. The procedure name can be split and will be restored.
1306 2. The number can be split. I have never seen this, but who knows.
1307 3. We do not require the `.pro' extension for files.
1308
1309 This function can still break when the file name ends on a end line
1310 and the message line contains an additional line with garbage. Then
1311 the first part of that garbage will be added to the file name.
1312 However, the function checks the existence of the files with and
1313 without this last part - thus the function only breaks if file name
1314 plus garbage match an existing regular file. This is hopefully very
1315 unlikely."
1316
1317 (let (number procedure file)
1318 (when (string-match idlwave-shell-file-line-message string)
1319 (setq procedure (match-string 1 string)
1320 number (match-string 3 string)
1321 file (match-string 5 string))
1322
1323 ;; Repair the strings
1324 (setq procedure (idlwave-shell-repair-string procedure))
1325 (setq number (idlwave-shell-repair-string number))
1326 (setq file (idlwave-shell-repair-file-name file))
1327
1328 ;; If we have a file, return the frame list
1329 (if file
1330 (list (idlwave-shell-file-name file)
1331 (string-to-int number)
1332 procedure)
1333 ;; No success finding a file
1334 nil))))
1335
1336 (defun idlwave-shell-repair-string (string)
1337 "Repair a string by taking out all linebreaks. This is destructive!"
1338 (while (string-match "[ \t]*\n[ \t]*" string)
1339 (setq string (replace-match "" t t string)))
1340 string)
1341
1342 (defun idlwave-shell-repair-file-name (file)
1343 "Repair a file name string by taking out all linebreaks.
1344 The last line of STRING may be garbage - we check which one makes a valid
1345 file name."
1346 (let ((file1 "") (file2 "") (start 0))
1347 ;; We scan no further than to the next "^%" line
1348 (if (string-match "^%" file)
1349 (setq file (substring file 0 (match-beginning 0))))
1350 ;; Take out the line breaks
1351 (while (string-match "[ \t]*\n[ \t]*" file start)
1352 (setq file1 (concat file1 (substring file start (match-beginning 0)))
1353 start (match-end 0)))
1354 (setq file2 (concat file1 (substring file start)))
1355 (cond
1356 ((file-regular-p file2) file2)
1357 ((file-regular-p file1) file1)
1358 ;; If we cannot veryfy the existence of the file, we return the shorter
1359 ;; name. The idea behind this is that this may be a relative file name
1360 ;; and our idea about the current working directory may be wrong.
1361 ;; If it is a relative file name, it hopefully is short.
1362 ((not (string= "" file1)) file1)
1363 ((not (string= "" file2)) file2)
1364 (t nil))))
1365
1366 (defun idlwave-shell-cleanup ()
1367 "Do necessary cleanup for a terminated IDL process."
1368 (setq idlwave-shell-step-frame nil
1369 idlwave-shell-halt-frame nil
1370 idlwave-shell-pending-commands nil
1371 idlwave-shell-command-line-to-execute nil
1372 idlwave-shell-bp-alist nil
1373 idlwave-shell-calling-stack-index 0
1374 idlwave-idlwave_routine_info-compiled nil)
1375 (idlwave-shell-delete-temp-files)
1376 (idlwave-shell-display-line nil)
1377 (idlwave-shell-update-bp-overlays) ; kill old overlays
1378 (idlwave-shell-kill-buffer idlwave-shell-hidden-output-buffer)
1379 (idlwave-shell-kill-buffer idlwave-shell-bp-buffer)
1380 (idlwave-shell-kill-buffer idlwave-shell-error-buffer)
1381 ;; (idlwave-shell-kill-buffer (idlwave-shell-buffer))
1382 (and (get-buffer (idlwave-shell-buffer))
1383 (bury-buffer (get-buffer (idlwave-shell-buffer))))
1384 (run-hooks 'idlwave-shell-cleanup-hook))
1385
1386 (defun idlwave-shell-kill-buffer (buf)
1387 "Kill buffer BUF if it exists."
1388 (if (setq buf (get-buffer buf))
1389 (kill-buffer buf)))
1390
1391 (defun idlwave-shell-kill-shell-buffer-confirm ()
1392 (when (idlwave-shell-is-running)
1393 (ding)
1394 (unless (y-or-n-p "IDL shell is running. Are you sure you want to kill the buffer? ")
1395 (error "Abort"))
1396 (message "Killing buffer *idl* and the associated process")))
1397
1398 (defun idlwave-shell-window (n)
1399 "Issue a `window,N' command to IDL, with special window size.
1400 The size is given by `idlwave-shell-graphics-window-size'."
1401 (interactive "P")
1402 (let ((n (if n (prefix-numeric-value n) 0)))
1403 (idlwave-shell-send-command
1404 (apply 'format "window,%d,xs=%d,ys=%d"
1405 n idlwave-shell-graphics-window-size))))
1406
1407 (defun idlwave-shell-resync-dirs ()
1408 "Resync the buffer's idea of the current directory stack.
1409 This command queries IDL with the command bound to
1410 `idlwave-shell-dirstack-query' (default \"printd\"), reads the
1411 output for the new directory stack."
1412 (interactive)
1413 (idlwave-shell-send-command idlwave-shell-dirstack-query
1414 'idlwave-shell-filter-directory
1415 'hide))
1416
1417 (defun idlwave-shell-retall (&optional arg)
1418 "Return from the entire calling stack."
1419 (interactive "P")
1420 (idlwave-shell-send-command "retall"))
1421
1422 (defun idlwave-shell-closeall (&optional arg)
1423 "Close all open files."
1424 (interactive "P")
1425 (idlwave-shell-send-command "close,/all"))
1426
1427 (defun idlwave-shell-quit (&optional arg)
1428 "Exit the idl process after confirmation.
1429 With prefix ARG, exit without confirmation."
1430 (interactive "P")
1431 (if (not (idlwave-shell-is-running))
1432 (error "Shell is not running")
1433 (if (or arg (y-or-n-p "Exit the IDLWAVE Shell? "))
1434 (condition-case nil
1435 (idlwave-shell-send-command "exit")
1436 (error nil)))))
1437
1438 (defun idlwave-shell-reset (&optional hidden)
1439 "Reset IDL. Return to main level and destroy the leaftover variables.
1440 This issues the following commands:
1441 RETALL
1442 WIDGET_CONTROL,/RESET
1443 CLOSE, /ALL
1444 HEAP_GC, /VERBOSE"
1445 ;; OBJ_DESTROY, OBJ_VALID() FIXME: should this be added?
1446 (interactive "P")
1447 (message "Resetting IDL")
1448 (setq idlwave-shell-calling-stack-index 0)
1449 (idlwave-shell-send-command "retall" nil hidden)
1450 (idlwave-shell-send-command "widget_control,/reset" nil hidden)
1451 (idlwave-shell-send-command "close,/all" nil hidden)
1452 ;; (idlwave-shell-send-command "obj_destroy, obj_valid()" nil hidden)
1453 (idlwave-shell-send-command "heap_gc,/verbose" nil hidden)
1454 (idlwave-shell-display-line nil))
1455
1456 (defun idlwave-shell-path-filter ()
1457 ;; Convert the output of the path query into a list of directories
1458 (let ((path-string idlwave-shell-command-output)
1459 (case-fold-search t)
1460 (start 0)
1461 dirs sysdir)
1462 (while (string-match "^PATH:[ \t]*<\\(.*\\)>[ \t]*\n" path-string start)
1463 (push (match-string 1 path-string) dirs)
1464 (setq start (match-end 0)))
1465 (setq dirs (mapcar 'file-name-as-directory dirs))
1466 (if (string-match "^SYSDIR:[ \t]*<\\(.*\\)>[ \t]*\n" path-string)
1467 (setq sysdir (file-name-as-directory
1468 (match-string 1 path-string))))
1469 (cons sysdir (nreverse dirs))))
1470
1471 (defun idlwave-shell-routine-info-filter ()
1472 "Function which parses the special output from idlwave_routine_info.pro."
1473 (let ((text idlwave-shell-command-output)
1474 (start 0)
1475 sep sep-re file type spec specs name cs key keys class entry)
1476 ;; Initialize variables
1477 (setq idlwave-compiled-routines nil
1478 idlwave-unresolved-routines nil)
1479 ;; Cut out the correct part of the output.
1480 (if (string-match
1481 "^>>>BEGIN OF IDLWAVE ROUTINE INFO (\"\\(.+\\)\" IS THE SEPARATOR.*"
1482 text)
1483 (setq sep (match-string 1 text)
1484 sep-re (concat (regexp-quote sep) " *")
1485 text (substring text (match-end 0)))
1486 ;; Set dummy values and kill the text
1487 (setq sep "@" sep-re "@ *" text "")
1488 (message "Routine Info warning: No match for BEGIN line"))
1489 (if (string-match "^>>>END OF IDLWAVE ROUTINE INFO.*" text)
1490 (setq text (substring text 0 (match-beginning 0)))
1491 (message "Routine Info warning: No match for END line"))
1492 (if (string-match "\\S-" text)
1493 ;; Obviously, the pro worked. Make a note that we have it now.
1494 (setq idlwave-idlwave_routine_info-compiled t))
1495 ;; Match the output lines
1496 (while (string-match "^IDLWAVE-\\(PRO\\|FUN\\): \\(.*\\)" text start)
1497 (setq start (match-end 0))
1498 (setq type (match-string 1 text)
1499 spec (match-string 2 text)
1500 specs (idlwave-split-string spec sep-re)
1501 name (nth 0 specs)
1502 class (if (equal (nth 1 specs) "") nil (nth 1 specs))
1503 file (nth 2 specs)
1504 cs (nth 3 specs)
1505 key (nth 4 specs)
1506 keys (if (and (stringp key)
1507 (not (string-match "\\` *\\'" key)))
1508 (mapcar 'list
1509 (delete "" (idlwave-split-string key " +")))))
1510 (setq name (idlwave-sintern-routine-or-method name class t)
1511 class (idlwave-sintern-class class t)
1512 file (if (equal file "") nil file)
1513 keys (mapcar (lambda (x)
1514 (list (idlwave-sintern-keyword (car x) t))) keys))
1515 ;; Make sure we use the same string object for the same file
1516 (setq file (idlwave-sintern-file file t))
1517 ;; FIXME: What should I do with routines from the temp file???
1518 ;; Maybe just leave it in - there is a chance that the
1519 ;; routine is still in there.
1520 ;; (if (equal file idlwave-shell-temp-pro-file)
1521 ;; (setq file nil))
1522
1523 ;; In the following ignore routines already defined in buffers,
1524 ;; assuming that if the buffer stuff differs, it is a "new"
1525 ;; version.
1526 ;; We could do the same for the library to avoid duplicates -
1527 ;; but I think frequently a user might have several versions of
1528 ;; the same function in different programs, and in this case the
1529 ;; compiled one will be the best guess of all version.
1530 ;; Therefore, we leave duplicates of library routines in.
1531
1532 (cond ((string= name "$MAIN$")) ; ignore this one
1533 ((and (string= type "PRO")
1534 ;; FIXME: is it OK to make the buffer routines dominate?
1535 (or t (null file)
1536 (not (idlwave-rinfo-assq name 'pro class
1537 idlwave-buffer-routines)))
1538 ;; FIXME: is it OK to make the library routines dominate?
1539 ;;(not (idlwave-rinfo-assq name 'pro class
1540 ;; idlwave-library-routines))
1541 )
1542 (setq entry (list name 'pro class (cons 'compiled file) cs keys))
1543 (if file
1544 (push entry idlwave-compiled-routines)
1545 (push entry idlwave-unresolved-routines)))
1546
1547 ((and (string= type "FUN")
1548 ;; FIXME: is it OK to make the buffer routines dominate?
1549 (or t (not file)
1550 (not (idlwave-rinfo-assq name 'fun class
1551 idlwave-buffer-routines)))
1552 ;; FIXME: is it OK to make the library routines dominate?
1553 ;; (not (idlwave-rinfo-assq name 'fun class
1554 ;; idlwave-library-routines))
1555 )
1556 (setq entry (list name 'fun class (cons 'compiled file) cs keys))
1557 (if file
1558 (push entry idlwave-compiled-routines)
1559 (push entry idlwave-unresolved-routines))))))
1560 ;; Reverse the definitions so that they are alphabetically sorted.
1561 (setq idlwave-compiled-routines (nreverse idlwave-compiled-routines)
1562 idlwave-unresolved-routines (nreverse idlwave-unresolved-routines)))
1563
1564 (defun idlwave-shell-filter-directory ()
1565 "Get the current directory from `idlwave-shell-command-output'.
1566 Change the default directory for the process buffer to concur."
1567 (save-excursion
1568 (set-buffer (idlwave-shell-buffer))
1569 (if (string-match "Current Directory: *\\(\\S-*\\) *$"
1570 idlwave-shell-command-output)
1571 (let ((dir (substring idlwave-shell-command-output
1572 (match-beginning 1) (match-end 1))))
1573 (message "Setting Emacs wd to %s" dir)
1574 (setq idlwave-shell-default-directory dir)
1575 (setq default-directory (file-name-as-directory dir))))))
1576
1577 (defun idlwave-shell-complete (&optional arg)
1578 "Do completion in the idlwave-shell buffer.
1579 Calls `idlwave-shell-complete-filename' after some executive commands or
1580 in strings. Otherwise, calls `idlwave-complete' to complete modules and
1581 keywords."
1582 ;;FIXME: batch files?
1583 (interactive "P")
1584 (let (cmd)
1585 (cond
1586 ((setq cmd (idlwave-shell-executive-command))
1587 ;; We are in a command line with an executive command
1588 (if (member (upcase cmd)
1589 '(".R" ".RU" ".RUN" ".RN" ".RNE" ".RNEW"
1590 ".COM" ".COMP" ".COMPI" ".COMPIL" ".COMPILE"))
1591 ;; This command expects file names
1592 (idlwave-shell-complete-filename)))
1593 ((and (idlwave-shell-filename-string)
1594 (save-excursion
1595 (beginning-of-line)
1596 (let ((case-fold-search t))
1597 (not (looking-at ".*obj_new"))))
1598 ;; In a string, could be a file name to here
1599 (idlwave-shell-complete-filename)))
1600 (t
1601 ;; Default completion of modules and keywords
1602 (idlwave-complete arg)))))
1603
1604 (defun idlwave-shell-complete-filename (&optional arg)
1605 "Complete a file name at point if after a file name.
1606 We assume that we are after a file name when completing one of the
1607 args of an executive .run, .rnew or .compile. Also, in a string
1608 constant we complete file names. Otherwise return nil, so that
1609 other completion functions can do thier work."
1610 (let* ((comint-file-name-chars idlwave-shell-file-name-chars)
1611 (completion-ignore-case (default-value 'completion-ignore-case)))
1612 (comint-dynamic-complete-filename)))
1613
1614 (defun idlwave-shell-executive-command ()
1615 "Return the name of the current executive command, if any."
1616 (save-excursion
1617 (idlwave-beginning-of-statement)
1618 (if (looking-at "[ \t]*\\([.][^ \t\n\r]*\\)")
1619 (match-string 1))))
1620
1621 (defun idlwave-shell-filename-string ()
1622 "Return t if in a string and after what could be a file name."
1623 (let ((limit (save-excursion (beginning-of-line) (point))))
1624 (save-excursion
1625 ;; Skip backwards over file name chars
1626 (skip-chars-backward idlwave-shell-file-name-chars limit)
1627 ;; Check of the next char is a string delimiter
1628 (memq (preceding-char) '(?\' ?\")))))
1629
1630 ;;;
1631 ;;; This section contains code for debugging IDL programs. --------------------
1632 ;;;
1633
1634 (defun idlwave-shell-redisplay (&optional hide)
1635 "Tries to resync the display with where execution has stopped.
1636 Issues a \"help,/trace\" command followed by a call to
1637 `idlwave-shell-display-line'. Also updates the breakpoint
1638 overlays."
1639 (interactive)
1640 (setq idlwave-shell-calling-stack-index 0)
1641 (idlwave-shell-send-command
1642 "help,/trace"
1643 '(idlwave-shell-display-line
1644 (idlwave-shell-pc-frame))
1645 hide)
1646 (idlwave-shell-bp-query))
1647
1648 (defun idlwave-shell-display-level-in-calling-stack (&optional hide)
1649 (idlwave-shell-send-command
1650 "help,/trace"
1651 `(progn
1652 ;; scanning for the state will reset the stack level - restore it
1653 (setq idlwave-shell-calling-stack-index
1654 ,idlwave-shell-calling-stack-index)
1655 ;; parse the stack and visit the selected frame
1656 (idlwave-shell-parse-stack-and-display))
1657 hide))
1658
1659 (defun idlwave-shell-parse-stack-and-display ()
1660 (let* ((lines (delete "" (idlwave-split-string
1661 idlwave-shell-command-output "^%")))
1662 (stack (delq nil (mapcar 'idlwave-shell-parse-line lines)))
1663 (nmax (1- (length stack)))
1664 (nmin 0) message)
1665 (cond
1666 ((< nmax nmin)
1667 (setq idlwave-shell-calling-stack-index 0)
1668 (ding)
1669 (message "Problem with calling stack"))
1670 ((> idlwave-shell-calling-stack-index nmax)
1671 (ding)
1672 (setq idlwave-shell-calling-stack-index nmax
1673 message (format "%d is the highest calling stack level - can't go further up"
1674 (- nmax))))
1675 ((< idlwave-shell-calling-stack-index nmin)
1676 (ding)
1677 (setq idlwave-shell-calling-stack-index nmin
1678 message (format "%d is the current calling stack level - can't go further down"
1679 (- nmin)))))
1680 (setq idlwave-shell-calling-stack-routine
1681 (nth 2 (nth idlwave-shell-calling-stack-index stack)))
1682 (idlwave-shell-display-line
1683 (nth idlwave-shell-calling-stack-index stack))
1684 (message (or message
1685 (format "In routine %s (stack level %d)"
1686 idlwave-shell-calling-stack-routine
1687 (- idlwave-shell-calling-stack-index))))))
1688
1689 (defun idlwave-shell-stack-up ()
1690 "Display the source code one step up the calling stack."
1691 (interactive)
1692 (incf idlwave-shell-calling-stack-index)
1693 (idlwave-shell-display-level-in-calling-stack 'hide))
1694 (defun idlwave-shell-stack-down ()
1695 "Display the source code one step down the calling stack."
1696 (interactive)
1697 (decf idlwave-shell-calling-stack-index)
1698 (idlwave-shell-display-level-in-calling-stack 'hide))
1699
1700 (defun idlwave-shell-goto-frame (&optional frame)
1701 "Set buffer to FRAME with point at the frame line.
1702 If the optional argument FRAME is nil then idlwave-shell-pc-frame is
1703 used. Does nothing if the resulting frame is nil."
1704 (if frame ()
1705 (setq frame (idlwave-shell-pc-frame)))
1706 (cond
1707 (frame
1708 (set-buffer (idlwave-find-file-noselect (car frame) 'shell))
1709 (widen)
1710 (goto-line (nth 1 frame)))))
1711
1712 (defun idlwave-shell-pc-frame ()
1713 "Returns the frame for IDL execution."
1714 (and idlwave-shell-halt-frame
1715 (list (nth 0 idlwave-shell-halt-frame)
1716 (nth 1 idlwave-shell-halt-frame)
1717 (nth 2 idlwave-shell-halt-frame))))
1718
1719 (defun idlwave-shell-valid-frame (frame)
1720 "Check that frame is for an existing file."
1721 (file-readable-p (car frame)))
1722
1723 (defun idlwave-shell-display-line (frame &optional col)
1724 "Display FRAME file in other window with overlay arrow.
1725
1726 FRAME is a list of file name, line number, and subroutine name.
1727 If FRAME is nil then remove overlay."
1728 (if (not frame)
1729 ;; Remove stop-line overlay from old position
1730 (progn
1731 (setq overlay-arrow-string nil)
1732 (setq idlwave-shell-mode-line-info nil)
1733 (setq idlwave-shell-is-stopped nil)
1734 (if idlwave-shell-stop-line-overlay
1735 (delete-overlay idlwave-shell-stop-line-overlay)))
1736 (if (not (idlwave-shell-valid-frame frame))
1737 ;; FIXME: errors are dangerous in shell filters. But I think I
1738 ;; have never encountered this one.
1739 (error (concat "Invalid frame - unable to access file: " (car frame)))
1740 ;;;
1741 ;;; buffer : the buffer to display a line in.
1742 ;;; select-shell: current buffer is the shell.
1743 ;;;
1744 (setq idlwave-shell-mode-line-info
1745 (if (nth 2 frame)
1746 (format "[%d:%s]"
1747 (- idlwave-shell-calling-stack-index)
1748 (nth 2 frame))))
1749 (let* ((buffer (idlwave-find-file-noselect (car frame) 'shell))
1750 (select-shell (equal (buffer-name) (idlwave-shell-buffer)))
1751 window pos)
1752
1753 ;; First make sure the shell window is visible
1754 (idlwave-display-buffer (idlwave-shell-buffer)
1755 nil (idlwave-shell-shell-frame))
1756
1757 ;; Now display the buffer and remember which window it is.
1758 (setq window (idlwave-display-buffer buffer
1759 nil (idlwave-shell-source-frame)))
1760
1761 ;; Enter the buffer and mark the line
1762 (save-excursion
1763 (set-buffer buffer)
1764 (save-restriction
1765 (widen)
1766 (goto-line (nth 1 frame))
1767 (setq pos (point))
1768 (setq idlwave-shell-is-stopped t)
1769 (if idlwave-shell-stop-line-overlay
1770 ;; Move overlay
1771 (move-overlay idlwave-shell-stop-line-overlay
1772 (point) (save-excursion (end-of-line) (point))
1773 (current-buffer))
1774 ;; Use the arrow instead, but only if marking is wanted.
1775 (if idlwave-shell-mark-stop-line
1776 (setq overlay-arrow-string idlwave-shell-overlay-arrow))
1777 (or overlay-arrow-position ; create the marker if necessary
1778 (setq overlay-arrow-position (make-marker)))
1779 (set-marker overlay-arrow-position (point) buffer)))
1780
1781 ;; If the point is outside the restriction, widen the buffer.
1782 (if (or (< pos (point-min)) (> pos (point-max)))
1783 (progn
1784 (widen)
1785 (goto-char pos)))
1786
1787 ;; If we have the column of the error, move the cursor there.
1788 (if col (move-to-column col))
1789 (setq pos (point)))
1790
1791 ;; Make sure pos is really displayed in the window.
1792 (set-window-point window pos)
1793
1794 ;; If we came from the shell, go back there. Otherwise select
1795 ;; the window where the error is displayed.
1796 (if (and (equal (buffer-name) (idlwave-shell-buffer))
1797 (not select-shell))
1798 (select-window window))))))
1799
1800
1801 (defun idlwave-shell-step (arg)
1802 "Step one source line. If given prefix argument ARG, step ARG source lines."
1803 (interactive "p")
1804 (or (not arg) (< arg 1)
1805 (setq arg 1))
1806 (idlwave-shell-send-command
1807 (concat ".s " (if (integerp arg) (int-to-string arg) arg))))
1808
1809 (defun idlwave-shell-stepover (arg)
1810 "Stepover one source line.
1811 If given prefix argument ARG, step ARG source lines.
1812 Uses IDL's stepover executive command which does not enter called functions."
1813 (interactive "p")
1814 (or (not arg) (< arg 1)
1815 (setq arg 1))
1816 (idlwave-shell-send-command
1817 (concat ".so " (if (integerp arg) (int-to-string arg) arg))))
1818
1819 (defun idlwave-shell-break-here (&optional count cmd)
1820 "Set breakpoint at current line.
1821
1822 If Count is nil then an ordinary breakpoint is set. We treat a count
1823 of 1 as a temporary breakpoint using the ONCE keyword. Counts greater
1824 than 1 use the IDL AFTER=count keyword to break only after reaching
1825 the statement count times.
1826
1827 Optional argument CMD is a list or function to evaluate upon reaching
1828 the breakpoint."
1829
1830 (interactive "P")
1831 (if (listp count)
1832 (setq count nil))
1833 (idlwave-shell-set-bp
1834 ;; Create breakpoint
1835 (idlwave-shell-bp (idlwave-shell-current-frame)
1836 (list count cmd)
1837 (idlwave-shell-current-module))))
1838
1839 (defun idlwave-shell-set-bp-check (bp)
1840 "Check for failure to set breakpoint.
1841 This is run on `idlwave-shell-post-command-hook'.
1842 Offers to recompile the procedure if we failed. This usually fixes
1843 the problem with not being able to set the breakpoint."
1844 ;; Scan for message
1845 (if (and idlwave-shell-command-output
1846 (string-match "% BREAKPOINT: *Unable to find code"
1847 idlwave-shell-command-output))
1848 ;; Offer to recompile
1849 (progn
1850 (if (progn
1851 (beep)
1852 (y-or-n-p
1853 (concat "Okay to recompile file "
1854 (idlwave-shell-bp-get bp 'file) " ")))
1855 ;; Recompile
1856 (progn
1857 ;; Clean up before retrying
1858 (idlwave-shell-command-failure)
1859 (idlwave-shell-send-command
1860 (concat ".run " (idlwave-shell-bp-get bp 'file)) nil nil)
1861 ;; Try setting breakpoint again
1862 (idlwave-shell-set-bp bp))
1863 (beep)
1864 (message "Unable to set breakpoint.")
1865 (idlwave-shell-command-failure)
1866 )
1867 ;; return non-nil if no error found
1868 nil)
1869 'okay))
1870
1871 (defun idlwave-shell-command-failure ()
1872 "Do any necessary clean up when an IDL command fails.
1873 Call this from a function attached to `idlwave-shell-post-command-hook'
1874 that detects the failure of a command.
1875 For example, this is called from `idlwave-shell-set-bp-check' when a
1876 breakpoint can not be set."
1877 ;; Clear pending commands
1878 (setq idlwave-shell-pending-commands nil))
1879
1880 (defun idlwave-shell-cont ()
1881 "Continue executing."
1882 (interactive)
1883 (idlwave-shell-send-command ".c" '(idlwave-shell-redisplay 'hide)))
1884
1885 (defun idlwave-shell-go ()
1886 "Run .GO. This starts the main program of the last compiled file."
1887 (interactive)
1888 (idlwave-shell-send-command ".go" '(idlwave-shell-redisplay 'hide)))
1889
1890 (defun idlwave-shell-return ()
1891 "Run .RETURN (continue to next return, but stay in subprogram)."
1892 (interactive)
1893 (idlwave-shell-send-command ".return" '(idlwave-shell-redisplay 'hide)))
1894
1895 (defun idlwave-shell-skip ()
1896 "Run .SKIP (skip one line, then step)."
1897 (interactive)
1898 (idlwave-shell-send-command ".skip" '(idlwave-shell-redisplay 'hide)))
1899
1900 (defun idlwave-shell-clear-bp (bp)
1901 "Clear breakpoint BP.
1902 Clears in IDL and in `idlwave-shell-bp-alist'."
1903 (let ((index (idlwave-shell-bp-get bp)))
1904 (if index
1905 (progn
1906 (idlwave-shell-send-command
1907 (concat "breakpoint,/clear,"
1908 (if (integerp index) (int-to-string index) index)))
1909 (idlwave-shell-bp-query)))))
1910
1911 (defun idlwave-shell-current-frame ()
1912 "Return a list containing the current file name and line point is in.
1913 If in the IDL shell buffer, returns `idlwave-shell-pc-frame'."
1914 (if (eq (current-buffer) (get-buffer (idlwave-shell-buffer)))
1915 ;; In IDL shell
1916 (idlwave-shell-pc-frame)
1917 ;; In source
1918 (list (idlwave-shell-file-name (buffer-file-name))
1919 (save-restriction
1920 (widen)
1921 (save-excursion
1922 (beginning-of-line)
1923 (1+ (count-lines 1 (point))))))))
1924
1925 (defun idlwave-shell-current-module ()
1926 "Return the name of the module for the current file.
1927 Returns nil if unable to obtain a module name."
1928 (if (eq (current-buffer) (get-buffer (idlwave-shell-buffer)))
1929 ;; In IDL shell
1930 (nth 2 idlwave-shell-halt-frame)
1931 ;; In pro file
1932 (save-restriction
1933 (widen)
1934 (save-excursion
1935 (if (idlwave-prev-index-position)
1936 (upcase (idlwave-unit-name)))))))
1937
1938 (defun idlwave-shell-clear-current-bp ()
1939 "Remove breakpoint at current line.
1940 This command can be called from the shell buffer if IDL is currently stopped
1941 at a breakpoint."
1942 (interactive)
1943 (let ((bp (idlwave-shell-find-bp (idlwave-shell-current-frame))))
1944 (if bp (idlwave-shell-clear-bp bp)
1945 ;; Try moving to beginning of statement
1946 (save-excursion
1947 (idlwave-shell-goto-frame)
1948 (idlwave-beginning-of-statement)
1949 (setq bp (idlwave-shell-find-bp (idlwave-shell-current-frame)))
1950 (if bp (idlwave-shell-clear-bp bp)
1951 (beep)
1952 (message "Cannot identify breakpoint for this line"))))))
1953
1954 (defun idlwave-shell-to-here ()
1955 "Set a breakpoint with count 1 then continue."
1956 (interactive)
1957 (idlwave-shell-break-here 1)
1958 (idlwave-shell-cont))
1959
1960 (defun idlwave-shell-break-in (&optional module)
1961 "Look for a module name near point and set a break point for it.
1962 The command looks for an identifier near point and sets a breakpoint
1963 for the first line of the corresponding module."
1964 (interactive)
1965 ;; get the identifier
1966 (let (module)
1967 (save-excursion
1968 (skip-chars-backward "a-zA-Z0-9_$")
1969 (if (looking-at idlwave-identifier)
1970 (setq module (match-string 0))
1971 (error "No identifier at point")))
1972 (idlwave-shell-send-command
1973 idlwave-shell-sources-query
1974 `(progn
1975 (idlwave-shell-sources-filter)
1976 (idlwave-shell-set-bp-in-module ,module))
1977 'hide)))
1978
1979 (defun idlwave-shell-set-bp-in-module (module)
1980 "Set breakpoint in module. Assumes that `idlwave-shell-sources-alist'
1981 contains an entry for that module."
1982 (let ((source-file (car-safe
1983 (cdr-safe
1984 (assoc (upcase module)
1985 idlwave-shell-sources-alist))))
1986 buf)
1987 (if (or (not source-file)
1988 (not (file-regular-p source-file))
1989 (not (setq buf
1990 (or (idlwave-get-buffer-visiting source-file)
1991 (find-file-noselect source-file)))))
1992 (progn
1993 (message "The source file for module %s is probably not compiled"
1994 module)
1995 (beep))
1996 (save-excursion
1997 (set-buffer buf)
1998 (save-excursion
1999 (goto-char (point-min))
2000 (let ((case-fold-search t))
2001 (if (re-search-forward
2002 (concat "^[ \t]*\\(pro\\|function\\)[ \t]+"
2003 (downcase module)
2004 "[ \t\n,]") nil t)
2005 (progn
2006 (goto-char (match-beginning 1))
2007 (message "Setting breakpoint for module %s" module)
2008 (idlwave-shell-break-here))
2009 (message "Cannot find module %s in file %s" module source-file)
2010 (beep))))))))
2011
2012 (defun idlwave-shell-up ()
2013 "Run to end of current block.
2014 Sets a breakpoint with count 1 at end of block, then continues."
2015 (interactive)
2016 (if (idlwave-shell-pc-frame)
2017 (save-excursion
2018 (idlwave-shell-goto-frame)
2019 ;; find end of subprogram
2020 (let ((eos (save-excursion
2021 (idlwave-beginning-of-subprogram)
2022 (idlwave-forward-block)
2023 (point))))
2024 (idlwave-backward-up-block -1)
2025 ;; move beyond end block line - IDL will not break there.
2026 ;; That is, you can put a breakpoint there but when IDL does
2027 ;; break it will report that it is at the next line.
2028 (idlwave-next-statement)
2029 (idlwave-end-of-statement)
2030 ;; Make sure we are not beyond subprogram
2031 (if (< (point) eos)
2032 ;; okay
2033 ()
2034 ;; Move back inside subprogram
2035 (goto-char eos)
2036 (idlwave-previous-statement))
2037 (idlwave-shell-to-here)))))
2038
2039 (defun idlwave-shell-out ()
2040 "Attempt to run until this procedure exits.
2041 Runs to the last statement and then steps 1 statement. Use the .out command."
2042 (interactive)
2043 (idlwave-shell-send-command (concat ".o")))
2044
2045 (defun idlwave-shell-help-expression (arg)
2046 "Print help on current expression. See `idlwave-shell-print'."
2047 (interactive "P")
2048 (idlwave-shell-print arg 'help))
2049
2050 (defun idlwave-shell-mouse-print (event)
2051 "Call `idlwave-shell-print' at the mouse position."
2052 (interactive "e")
2053 (mouse-set-point event)
2054 (idlwave-shell-print nil nil 'mouse))
2055
2056 (defun idlwave-shell-mouse-help (event)
2057 "Call `idlwave-shell-print' at the mouse position."
2058 (interactive "e")
2059 (mouse-set-point event)
2060 (idlwave-shell-print nil 'help 'mouse))
2061
2062 (defun idlwave-shell-print (arg &optional help mouse)
2063 "Print current expression. With HELP, show help on expression.
2064 An expression is an identifier plus 1 pair of matched parentheses
2065 directly following the identifier - an array or function
2066 call. Alternatively, an expression is the contents of any matched
2067 parentheses when the open parentheses is not directly preceded by an
2068 identifier. If point is at the beginning or within an expression
2069 return the inner-most containing expression, otherwise, return the
2070 preceding expression.
2071
2072 With prefix arg ARG, or when called from the shell buffer, prompt
2073 for an expression."
2074 (interactive "P")
2075 (save-excursion
2076 (let (expr beg end cmd)
2077 (if (and (not mouse)
2078 (or arg (eq major-mode 'idlwave-shell-mode)))
2079 (setq expr (read-string "Expression: "))
2080 (idlwave-with-special-syntax1
2081 ;; Move to beginning of current or previous expression
2082 (if (looking-at "\\<\\|(")
2083 ;; At beginning of expression, don't move backwards unless
2084 ;; this is at the end of an indentifier.
2085 (if (looking-at "\\>")
2086 (backward-sexp))
2087 (backward-sexp))
2088 (if (looking-at "\\>")
2089 ;; Move to beginning of identifier - must be an array or
2090 ;; function expression.
2091 (backward-sexp))
2092 ;; Move to end of expression
2093 (setq beg (point))
2094 (forward-sexp)
2095 (while (looking-at "\\>[[(]\\|\\.")
2096 ;; an array
2097 (forward-sexp))
2098 (setq end (point))
2099 (setq expr (buffer-substring beg end))))
2100 (when (and beg end idlwave-shell-expression-overlay)
2101 (move-overlay idlwave-shell-expression-overlay beg end
2102 (current-buffer))
2103 (add-hook 'pre-command-hook 'idlwave-shell-delete-expression-overlay))
2104 (if (and (integerp idlwave-shell-calling-stack-index)
2105 (> idlwave-shell-calling-stack-index 0))
2106 (setq cmd (idlwave-retrieve-expression-from-level
2107 expr
2108 idlwave-shell-calling-stack-index
2109 idlwave-shell-calling-stack-routine
2110 help))
2111 (setq cmd (concat (if help "help," "print,") expr)))
2112 (if idlwave-shell-print-expression-function
2113 (idlwave-shell-send-command
2114 cmd
2115 (list idlwave-shell-print-expression-function expr)
2116 'hide)
2117 (idlwave-shell-recenter-shell-window)
2118 (idlwave-shell-send-command cmd)))))
2119
2120 (defun idlwave-retrieve-expression-from-level (expr level routine help)
2121 "Return IDL command to print the expression EXPR from stack level LEVEL.
2122
2123 It does not seem possible to evaluate an expression on a differnt
2124 level than the current. Therefore, this function retrieves *copies* of
2125 the variables involved in the expression from the desired level in the
2126 calling stack. The copies are given some unlikely names on the
2127 *current* level, and the expression is then evaluated on the *current*
2128 level.
2129
2130 Since this function depends upon the undocumented IDL routine routine_names,
2131 there is no guarantie that this will work with future versions of IDL."
2132 (let ((prefix "___") ;; No real variables should starts with this.
2133 (fetch (- 0 level))
2134 (start 0)
2135 var tvar fetch-vars pre post)
2136
2137 ;; FIXME: In the following we try to find the variables in expression
2138 ;; This is quite empirical - I don't know in what situations this will
2139 ;; break. We will look for identifiers and exclude cases where we
2140 ;; know it is not a variable. To distinguish array references from
2141 ;; function calls, we require that arrays use [] instead of ()
2142
2143 (while (string-match
2144 "\\(\\`\\|[^a-zA-Z0-9$_]\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)\\([^a-zA-Z0-9$_]\\|\\'\\)" expr start)
2145 (setq var (match-string 2 expr)
2146 tvar (concat prefix var)
2147 start (match-beginning 2)
2148 pre (substring expr 0 (match-beginning 2))
2149 post (substring expr (match-end 2)))
2150 (cond
2151 ;; Exclude identifiers which are not variables
2152 ((string-match ",[ \t]*/\\'" pre)) ;; a `/' KEYWORD
2153 ((and (string-match "[,(][ \t]*\\'" pre)
2154 (string-match "\\`[ \t]*=" post))) ;; a `=' KEYWORD
2155 ((string-match "\\`(" post)) ;; a function
2156 ((string-match "->[ \t]*\\'" pre)) ;; a method
2157 ((string-match "\\.\\'" pre)) ;; structure member
2158 (t ;; seems to be a variable - arrange to get it and replace
2159 ;; its name in the expression with the temproary name.
2160 (push (cons var tvar) fetch-vars)
2161 (setq expr (concat pre tvar post)))))
2162 ;; Make a command line that first copies the relevant variables
2163 ;; and then prints the expression.
2164 (concat
2165 (mapconcat
2166 (lambda (x)
2167 (format "%s = routine_names('%s',fetch=%d)" (cdr x) (car x) fetch))
2168 (nreverse fetch-vars)
2169 " & ")
2170 (if idlwave-shell-print-expression-function " & " "\n")
2171 (if help "help, " "print, ")
2172 expr
2173 (format " ; [-%d:%s]" level routine))))
2174
2175 (defun idlwave-shell-delete-expression-overlay ()
2176 (condition-case nil
2177 (if idlwave-shell-expression-overlay
2178 (delete-overlay idlwave-shell-expression-overlay))
2179 (error nil))
2180 (remove-hook 'pre-command-hook 'idlwave-shell-delete-expression-overlay))
2181
2182 (defvar idlwave-shell-bp-alist nil
2183 "Alist of breakpoints.
2184 A breakpoint is a cons cell \(\(file line\) . \(\(index module\) data\)\)
2185
2186 The car is the frame for the breakpoint:
2187 file - full path file name.
2188 line - line number of breakpoint - integer.
2189
2190 The first element of the cdr is a list of internal IDL data:
2191 index - the index number of the breakpoint internal to IDL.
2192 module - the module for breakpoint internal to IDL.
2193
2194 Remaining elements of the cdr:
2195 data - Data associated with the breakpoint by idlwave-shell currently
2196 contains two items:
2197
2198 count - number of times to execute breakpoint. When count reaches 0
2199 the breakpoint is cleared and removed from the alist.
2200 command - command to execute when breakpoint is reached, either a
2201 lisp function to be called with `funcall' with no arguments or a
2202 list to be evaluated with `eval'.")
2203
2204 (defun idlwave-shell-run-region (beg end &optional n)
2205 "Compile and run the region using the IDL process.
2206 Copies the region to a temporary file `idlwave-shell-temp-pro-file'
2207 and issues the IDL .run command for the file. Because the
2208 region is compiled and run as a main program there is no
2209 problem with begin-end blocks extending over multiple
2210 lines - which would be a problem if `idlwave-shell-evaluate-region'
2211 was used. An END statement is appended to the region if necessary.
2212
2213 If there is a prefix argument, display IDL process."
2214 (interactive "r\nP")
2215 (let ((oldbuf (current-buffer)))
2216 (save-excursion
2217 (set-buffer (idlwave-find-file-noselect
2218 idlwave-shell-temp-pro-file 'tmp))
2219 (erase-buffer)
2220 (insert-buffer-substring oldbuf beg end)
2221 (if (not (save-excursion
2222 (idlwave-previous-statement)
2223 (idlwave-look-at "\\<end\\>")))
2224 (insert "\nend\n"))
2225 (save-buffer 0)))
2226 (idlwave-shell-send-command (concat ".run " idlwave-shell-temp-pro-file))
2227 (if n
2228 (idlwave-display-buffer (idlwave-shell-buffer)
2229 nil (idlwave-shell-shell-frame))))
2230
2231 (defun idlwave-shell-evaluate-region (beg end &optional n)
2232 "Send region to the IDL process.
2233 If there is a prefix argument, display IDL process.
2234 Does not work for a region with multiline blocks - use
2235 `idlwave-shell-run-region' for this."
2236 (interactive "r\nP")
2237 (idlwave-shell-send-command (buffer-substring beg end))
2238 (if n
2239 (idlwave-display-buffer (idlwave-shell-buffer)
2240 nil (idlwave-shell-shell-frame))))
2241
2242 (defun idlwave-shell-delete-temp-files ()
2243 "Delete the temporary files and kill associated buffers."
2244 (if (stringp idlwave-shell-temp-pro-file)
2245 (condition-case nil
2246 (let ((buf (idlwave-get-buffer-visiting
2247 idlwave-shell-temp-pro-file)))
2248 (if (buffer-live-p buf)
2249 (kill-buffer buf))
2250 (delete-file idlwave-shell-temp-pro-file))
2251 (error nil)))
2252 (if (stringp idlwave-shell-temp-rinfo-save-file)
2253 (condition-case nil
2254 (delete-file idlwave-shell-temp-rinfo-save-file)
2255 (error nil))))
2256
2257 (defun idlwave-display-buffer (buf not-this-window-p &optional frame)
2258 (if (or (< emacs-major-version 20)
2259 (and (= emacs-major-version 20)
2260 (< emacs-minor-version 3)))
2261 ;; Only two args.
2262 (display-buffer buf not-this-window-p)
2263 ;; Three ares possible.
2264 (display-buffer buf not-this-window-p frame)))
2265
2266 (defvar idlwave-shell-bp-buffer " *idlwave-shell-bp*"
2267 "Scratch buffer for parsing IDL breakpoint lists and other stuff.")
2268
2269 (defun idlwave-shell-bp-query ()
2270 "Reconcile idlwave-shell's breakpoint list with IDL's.
2271 Queries IDL using the string in `idlwave-shell-bp-query'."
2272 (interactive)
2273 (idlwave-shell-send-command idlwave-shell-bp-query
2274 'idlwave-shell-filter-bp
2275 'hide))
2276
2277 (defun idlwave-shell-bp-get (bp &optional item)
2278 "Get a value for a breakpoint.
2279 BP has the form of elements in idlwave-shell-bp-alist.
2280 Optional second arg ITEM is the particular value to retrieve.
2281 ITEM can be 'file, 'line, 'index, 'module, 'count, 'cmd, or 'data.
2282 'data returns a list of 'count and 'cmd.
2283 Defaults to 'index."
2284 (cond
2285 ;; Frame
2286 ((eq item 'line) (nth 1 (car bp)))
2287 ((eq item 'file) (nth 0 (car bp)))
2288 ;; idlwave-shell breakpoint data
2289 ((eq item 'data) (cdr (cdr bp)))
2290 ((eq item 'count) (nth 0 (cdr (cdr bp))))
2291 ((eq item 'cmd) (nth 1 (cdr (cdr bp))))
2292 ;; IDL breakpoint info
2293 ((eq item 'module) (nth 1 (car (cdr bp))))
2294 ;; index - default
2295 (t (nth 0 (car (cdr bp))))))
2296
2297 (defun idlwave-shell-filter-bp ()
2298 "Get the breakpoints from `idlwave-shell-command-output'.
2299 Create `idlwave-shell-bp-alist' updating breakpoint count and command data
2300 from previous breakpoint list."
2301 (save-excursion
2302 (set-buffer (get-buffer-create idlwave-shell-bp-buffer))
2303 (erase-buffer)
2304 (insert idlwave-shell-command-output)
2305 (goto-char (point-min))
2306 (let ((old-bp-alist idlwave-shell-bp-alist)
2307 file line index module)
2308 (setq idlwave-shell-bp-alist (list nil))
2309 (when (re-search-forward "^\\s-*Index.*\n\\s-*-" nil t)
2310 ;; There seems to be a breakpoint listing here.
2311 ;; Parse breakpoint lines.
2312 ;; Breakpoints have the form:
2313 ;; Index Module Line File
2314 ;; All seperated by whitespace.
2315 ;; Module may be missing if the file is not compiled.
2316 ;;
2317 (while (re-search-forward
2318 "^[ \t]*\\([0-9]+\\)[ \t]+\\(\\S-+\\)?[ \t]+\\([0-9]+\\)[ \t]+\\(\\S-+\\)" nil t)
2319 (setq index (match-string 1)
2320 module (match-string 2)
2321 line (string-to-int (match-string 3))
2322 file (idlwave-shell-file-name (match-string 4)))
2323 ;; Add the breakpoint info to the list
2324 (nconc idlwave-shell-bp-alist
2325 (list (cons (list file line)
2326 (list
2327 (list index module)
2328 ;; idlwave-shell data: count, command
2329 nil nil))))))
2330 (setq idlwave-shell-bp-alist (cdr idlwave-shell-bp-alist))
2331 ;; Update count, commands of breakpoints
2332 (mapcar 'idlwave-shell-update-bp old-bp-alist)))
2333 ;; Update the breakpoint overlays
2334 (idlwave-shell-update-bp-overlays)
2335 ;; Return the new list
2336 idlwave-shell-bp-alist)
2337
2338 (defun idlwave-shell-update-bp (bp)
2339 "Update BP data in breakpoint list.
2340 If BP frame is in `idlwave-shell-bp-alist' updates the breakpoint data."
2341 (let ((match (assoc (car bp) idlwave-shell-bp-alist)))
2342 (if match (setcdr (cdr match) (cdr (cdr bp))))))
2343
2344 (defun idlwave-shell-set-bp-data (bp data)
2345 "Set the data of BP to DATA."
2346 (setcdr (cdr bp) data))
2347
2348 (defun idlwave-shell-bp (frame &optional data module)
2349 "Create a breakpoint structure containing FRAME and DATA. Second
2350 and third args, DATA and MODULE, are optional. Returns a breakpoint
2351 of the format used in `idlwave-shell-bp-alist'. Can be used in commands
2352 attempting match a breakpoint in `idlwave-shell-bp-alist'."
2353 (cons frame (cons (list nil module) data)))
2354
2355 (defvar idlwave-shell-old-bp nil
2356 "List of breakpoints previous to setting a new breakpoint.")
2357
2358 (defun idlwave-shell-sources-bp (bp)
2359 "Check `idlwave-shell-sources-alist' for source of breakpoint using BP.
2360 If an equivalency is found, return the IDL internal source name.
2361 Otherwise return the filename in bp."
2362 (let*
2363 ((bp-file (idlwave-shell-bp-get bp 'file))
2364 (bp-module (idlwave-shell-bp-get bp 'module))
2365 (internal-file-list (cdr (assoc bp-module idlwave-shell-sources-alist))))
2366 (if (and internal-file-list
2367 (equal bp-file (nth 0 internal-file-list)))
2368 (nth 1 internal-file-list)
2369 bp-file)))
2370
2371 (defun idlwave-shell-set-bp (bp)
2372 "Try to set a breakpoint BP.
2373
2374 The breakpoint will be placed at the beginning of the statement on the
2375 line specified by BP or at the next IDL statement if that line is not
2376 a statement.
2377 Determines IDL's internal representation for the breakpoint which may
2378 have occured at a different line then used with the breakpoint
2379 command."
2380
2381 ;; Get and save the old breakpoints
2382 (idlwave-shell-send-command
2383 idlwave-shell-bp-query
2384 '(progn
2385 (idlwave-shell-filter-bp)
2386 (setq idlwave-shell-old-bp idlwave-shell-bp-alist))
2387 'hide)
2388 ;; Get sources for IDL compiled procedures followed by setting
2389 ;; breakpoint.
2390 (idlwave-shell-send-command
2391 idlwave-shell-sources-query
2392 (` (progn
2393 (idlwave-shell-sources-filter)
2394 (idlwave-shell-set-bp2 (quote (, bp)))))
2395 'hide))
2396
2397 (defun idlwave-shell-set-bp2 (bp)
2398 "Use results of breakpoint and sources query to set bp.
2399 Use the count argument with IDLs breakpoint command.
2400 We treat a count of 1 as a temporary breakpoint.
2401 Counts greater than 1 use the IDL AFTER=count keyword to break
2402 only after reaching the statement count times."
2403 (let*
2404 ((arg (idlwave-shell-bp-get bp 'count))
2405 (key (cond
2406 ((not (and arg (numberp arg))) "")
2407 ((= arg 1)
2408 ",/once")
2409 ((> arg 1)
2410 (format ",after=%d" arg))))
2411 (line (idlwave-shell-bp-get bp 'line)))
2412 (idlwave-shell-send-command
2413 (concat "breakpoint,'"
2414 (idlwave-shell-sources-bp bp) "',"
2415 (if (integerp line) (setq line (int-to-string line)))
2416 key)
2417 ;; Check for failure and look for breakpoint in IDL's list
2418 (` (progn
2419 (if (idlwave-shell-set-bp-check (quote (, bp)))
2420 (idlwave-shell-set-bp3 (quote (, bp)))))
2421 )
2422 ;; do not hide output
2423 nil
2424 'preempt)))
2425
2426 (defun idlwave-shell-set-bp3 (bp)
2427 "Find the breakpoint in IDL's internal list of breakpoints."
2428 (idlwave-shell-send-command idlwave-shell-bp-query
2429 (` (progn
2430 (idlwave-shell-filter-bp)
2431 (idlwave-shell-new-bp (quote (, bp)))))
2432 'hide
2433 'preempt))
2434
2435 (defun idlwave-shell-find-bp (frame)
2436 "Return breakpoint from `idlwave-shell-bp-alist' for frame.
2437 Returns nil if frame not found."
2438 (assoc frame idlwave-shell-bp-alist))
2439
2440 (defun idlwave-shell-new-bp (bp)
2441 "Find the new breakpoint in IDL's list and update with DATA.
2442 The actual line number for a breakpoint in IDL may be different than
2443 the line number used with the IDL breakpoint command.
2444 Looks for a new breakpoint index number in the list. This is
2445 considered the new breakpoint if the file name of frame matches."
2446 (let ((obp-index (mapcar 'idlwave-shell-bp-get idlwave-shell-old-bp))
2447 (bpl idlwave-shell-bp-alist))
2448 (while (and (member (idlwave-shell-bp-get (car bpl)) obp-index)
2449 (setq bpl (cdr bpl))))
2450 (if (and
2451 (not bpl)
2452 ;; No additional breakpoint.
2453 ;; Need to check if we are just replacing a breakpoint.
2454 (setq bpl (assoc (car bp) idlwave-shell-bp-alist)))
2455 (setq bpl (list bpl)))
2456 (if (and bpl
2457 (equal (idlwave-shell-bp-get (setq bpl (car bpl)) 'file)
2458 (idlwave-shell-bp-get bp 'file)))
2459 ;; Got the breakpoint - add count, command to it.
2460 ;; This updates `idlwave-shell-bp-alist' because a deep copy was
2461 ;; not done for bpl.
2462 (idlwave-shell-set-bp-data bpl (idlwave-shell-bp-get bp 'data))
2463 (beep)
2464 (message "Failed to identify breakpoint in IDL"))))
2465
2466 (defvar idlwave-shell-bp-overlays nil
2467 "List of overlays marking breakpoints")
2468
2469 (defun idlwave-shell-update-bp-overlays ()
2470 "Update the overlays which mark breakpoints in the source code.
2471 Existing overlays are recycled, in order to minimize consumption."
2472 (when idlwave-shell-mark-breakpoints
2473 (let ((bp-list idlwave-shell-bp-alist)
2474 (ov-list idlwave-shell-bp-overlays)
2475 ov bp)
2476 ;; Delete the old overlays from their buffers
2477 (while (setq ov (pop ov-list))
2478 (delete-overlay ov))
2479 (setq ov-list idlwave-shell-bp-overlays
2480 idlwave-shell-bp-overlays nil)
2481 (while (setq bp (pop bp-list))
2482 (save-excursion
2483 (idlwave-shell-goto-frame (car bp))
2484 (let* ((end (progn (end-of-line 1) (point)))
2485 (beg (progn (beginning-of-line 1) (point)))
2486 (ov (or (pop ov-list)
2487 (idlwave-shell-make-new-bp-overlay))))
2488 (move-overlay ov beg end)
2489 (push ov idlwave-shell-bp-overlays)))))))
2490
2491 (defvar idlwave-shell-bp-glyph)
2492 (defun idlwave-shell-make-new-bp-overlay ()
2493 "Make a new overlay for highlighting breakpoints.
2494 This stuff is stringly dependant upon the version of Emacs."
2495 (let ((ov (make-overlay 1 1)))
2496 (if (featurep 'xemacs)
2497 ;; This is XEmacs
2498 (progn
2499 (cond
2500 ((eq (console-type) 'tty)
2501 ;; tty's cannot display glyphs
2502 (set-extent-property ov 'face idlwave-shell-breakpoint-face))
2503 ((and (memq idlwave-shell-mark-breakpoints '(t glyph))
2504 idlwave-shell-bp-glyph)
2505 ;; use the glyph
2506 (set-extent-property ov 'begin-glyph idlwave-shell-bp-glyph))
2507 (idlwave-shell-mark-breakpoints
2508 ;; use the face
2509 (set-extent-property ov 'face idlwave-shell-breakpoint-face))
2510 (t
2511 ;; no marking
2512 nil))
2513 (set-extent-priority ov -1)) ; make stop line face prevail
2514 ;; This is Emacs
2515 (cond
2516 (window-system
2517 (if (and (memq idlwave-shell-mark-breakpoints '(t glyph))
2518 idlwave-shell-bp-glyph) ; this var knows if glyph's possible
2519 ;; use a glyph
2520 (let ((string "@"))
2521 (put-text-property 0 1
2522 'display idlwave-shell-bp-glyph
2523 string)
2524 (overlay-put ov 'before-string string))
2525 (overlay-put ov 'face idlwave-shell-breakpoint-face)))
2526 (idlwave-shell-mark-breakpoints
2527 ;; use a face
2528 (overlay-put ov 'face idlwave-shell-breakpoint-face))
2529 (t
2530 ;; No marking
2531 nil)))
2532 ov))
2533
2534 (defun idlwave-shell-edit-default-command-line (arg)
2535 "Edit the current execute command."
2536 (interactive "P")
2537 (setq idlwave-shell-command-line-to-execute
2538 (read-string "IDL> " idlwave-shell-command-line-to-execute)))
2539
2540 (defun idlwave-shell-execute-default-command-line (arg)
2541 "Execute a command line. On first use, ask for the command.
2542 Also with prefix arg, ask for the command. You can also uase the command
2543 `idlwave-shell-edit-default-command-line' to edit the line."
2544 (interactive "P")
2545 (if (or (not idlwave-shell-command-line-to-execute)
2546 arg)
2547 (setq idlwave-shell-command-line-to-execute
2548 (read-string "IDL> " idlwave-shell-command-line-to-execute)))
2549 (idlwave-shell-reset 'hidden)
2550 (idlwave-shell-send-command idlwave-shell-command-line-to-execute
2551 '(idlwave-shell-redisplay 'hide)))
2552
2553 (defun idlwave-shell-save-and-run ()
2554 "Save file and run it in IDL.
2555 Runs `save-buffer' and sends a '.RUN' command for the associated file to IDL.
2556 When called from the shell buffer, re-run the file which was last handled by
2557 one of the save-and-.. commands."
2558 (interactive)
2559 (idlwave-shell-save-and-action 'run))
2560
2561 (defun idlwave-shell-save-and-compile ()
2562 "Save file and run it in IDL.
2563 Runs `save-buffer' and sends '.COMPILE' command for the associated file to IDL.
2564 When called from the shell buffer, re-compile the file which was last handled by
2565 one of the save-and-.. commands."
2566 (interactive)
2567 (idlwave-shell-save-and-action 'compile))
2568
2569 (defun idlwave-shell-save-and-batch ()
2570 "Save file and batch it in IDL.
2571 Runs `save-buffer' and sends a '@file' command for the associated file to IDL.
2572 When called from the shell buffer, re-batch the file which was last handled by
2573 one of the save-and-.. commands."
2574 (interactive)
2575 (idlwave-shell-save-and-action 'batch))
2576
2577 (defun idlwave-shell-save-and-action (action)
2578 "Save file and compile it in IDL.
2579 Runs `save-buffer' and sends a '.RUN' command for the associated file to IDL.
2580 When called from the shell buffer, re-compile the file which was last
2581 handled by this command."
2582 ;; Remove the stop overlay.
2583 (if idlwave-shell-stop-line-overlay
2584 (delete-overlay idlwave-shell-stop-line-overlay))
2585 (setq idlwave-shell-is-stopped nil)
2586 (setq overlay-arrow-string nil)
2587 (let (buf)
2588 (cond
2589 ((eq major-mode 'idlwave-mode)
2590 (save-buffer)
2591 (setq idlwave-shell-last-save-and-action-file (buffer-file-name)))
2592 (idlwave-shell-last-save-and-action-file
2593 (if (setq buf (idlwave-get-buffer-visiting
2594 idlwave-shell-last-save-and-action-file))
2595 (save-excursion
2596 (set-buffer buf)
2597 (save-buffer))))
2598 (t (setq idlwave-shell-last-save-and-action-file
2599 (read-file-name "File: ")))))
2600 (if (file-regular-p idlwave-shell-last-save-and-action-file)
2601 (progn
2602 (idlwave-shell-send-command
2603 (concat (cond ((eq action 'run) ".run ")
2604 ((eq action 'compile) ".compile ")
2605 ((eq action 'batch) "@")
2606 (t (error "Unknown action %s" action)))
2607 idlwave-shell-last-save-and-action-file)
2608 'idlwave-shell-maybe-update-routine-info
2609 nil)
2610 (idlwave-shell-bp-query))
2611 (let ((msg (format "No such file %s"
2612 idlwave-shell-last-save-and-action-file)))
2613 (setq idlwave-shell-last-save-and-action-file nil)
2614 (error msg))))
2615
2616 (defun idlwave-shell-maybe-update-routine-info ()
2617 "Update the routine info if the shell is not stopped at an error."
2618 (if (and (not idlwave-shell-is-stopped)
2619 (or (eq t idlwave-auto-routine-info-updates)
2620 (memq 'compile-buffer idlwave-auto-routine-info-updates))
2621 idlwave-query-shell-for-routine-info
2622 idlwave-routines)
2623 (idlwave-shell-update-routine-info t)))
2624
2625 (defvar idlwave-shell-sources-query "help,/source"
2626 "IDL command to obtain source files for compiled procedures.")
2627
2628 (defvar idlwave-shell-sources-alist nil
2629 "Alist of IDL procedure names and compiled source files.
2630 Elements of the alist have the form:
2631
2632 (module name . (source-file-truename idlwave-internal-filename)).")
2633
2634 (defun idlwave-shell-sources-query ()
2635 "Determine source files for IDL compiled procedures.
2636 Queries IDL using the string in `idlwave-shell-sources-query'."
2637 (interactive)
2638 (idlwave-shell-send-command idlwave-shell-sources-query
2639 'idlwave-shell-sources-filter
2640 'hide))
2641
2642 (defun idlwave-shell-sources-filter ()
2643 "Get source files from `idlwave-shell-sources-query' output.
2644 Create `idlwave-shell-sources-alist' consisting of
2645 list elements of the form:
2646 (module name . (source-file-truename idlwave-internal-filename))."
2647 (save-excursion
2648 (set-buffer (get-buffer-create idlwave-shell-bp-buffer))
2649 (erase-buffer)
2650 (insert idlwave-shell-command-output)
2651 (goto-char (point-min))
2652 (let (cpro cfun)
2653 (if (re-search-forward "Compiled Procedures:" nil t)
2654 (progn
2655 (forward-line) ; Skip $MAIN$
2656 (setq cpro (point))))
2657 (if (re-search-forward "Compiled Functions:" nil t)
2658 (progn
2659 (setq cfun (point))
2660 (setq idlwave-shell-sources-alist
2661 (append
2662 ;; compiled procedures
2663 (progn
2664 (beginning-of-line)
2665 (narrow-to-region cpro (point))
2666 (goto-char (point-min))
2667 (idlwave-shell-sources-grep))
2668 ;; compiled functions
2669 (progn
2670 (widen)
2671 (goto-char cfun)
2672 (idlwave-shell-sources-grep)))))))))
2673
2674 (defun idlwave-shell-sources-grep ()
2675 (save-excursion
2676 (let ((al (list nil)))
2677 (while (and
2678 (not (progn (forward-line) (eobp)))
2679 (re-search-forward
2680 "\\s-*\\(\\S-+\\)\\s-+\\(\\S-+\\)" nil t))
2681 (nconc al
2682 (list
2683 (cons
2684 (buffer-substring ; name
2685 (match-beginning 1) (match-end 1))
2686 (let ((internal-filename
2687 (buffer-substring ; source
2688 (match-beginning 2) (match-end 2))))
2689 (list
2690 (idlwave-shell-file-name internal-filename)
2691 internal-filename))
2692 ))))
2693 (cdr al))))
2694
2695
2696 (defun idlwave-shell-clear-all-bp ()
2697 "Remove all breakpoints in IDL."
2698 (interactive)
2699 (idlwave-shell-send-command
2700 idlwave-shell-bp-query
2701 '(progn
2702 (idlwave-shell-filter-bp)
2703 (mapcar 'idlwave-shell-clear-bp idlwave-shell-bp-alist))
2704 'hide))
2705
2706 (defun idlwave-shell-list-all-bp ()
2707 "List all breakpoints in IDL."
2708 (interactive)
2709 (idlwave-shell-send-command
2710 idlwave-shell-bp-query))
2711
2712 (defvar idlwave-shell-error-last 0
2713 "Position of last syntax error in `idlwave-shell-error-buffer'.")
2714
2715 (defun idlwave-shell-goto-next-error ()
2716 "Move point to next IDL syntax error."
2717 (interactive)
2718 (let (frame col)
2719 (save-excursion
2720 (set-buffer idlwave-shell-error-buffer)
2721 (goto-char idlwave-shell-error-last)
2722 (if (or (re-search-forward idlwave-shell-syntax-error nil t)
2723 (re-search-forward idlwave-shell-other-error nil t))
2724 (progn
2725 (setq frame
2726 (list
2727 (save-match-data
2728 (idlwave-shell-file-name
2729 (buffer-substring (match-beginning 1) (match-end 1))))
2730 (string-to-int
2731 (buffer-substring (match-beginning 2)
2732 (match-end 2)))))
2733 ;; Try to find the column of the error
2734 (save-excursion
2735 (setq col
2736 (if (re-search-backward "\\^" nil t)
2737 (current-column)
2738 0)))))
2739 (setq idlwave-shell-error-last (point)))
2740 (if frame
2741 (progn
2742 (idlwave-shell-display-line frame col))
2743 (beep)
2744 (message "No more errors."))))
2745
2746 (defun idlwave-shell-file-name (name)
2747 "If `idlwave-shell-use-truename' is non-nil, convert file name to true name.
2748 Otherwise, just expand the file name."
2749 (let ((def-dir (if (eq major-mode 'idlwave-shell-mode)
2750 default-directory
2751 idlwave-shell-default-directory)))
2752 (if idlwave-shell-use-truename
2753 (file-truename name def-dir)
2754 (expand-file-name name def-dir))))
2755
2756
2757 ;; Keybindings --------------------------------------------------------------
2758
2759 (defvar idlwave-shell-mode-map (copy-keymap comint-mode-map)
2760 "Keymap for idlwave-mode.")
2761 (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap))
2762 (fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map)
2763
2764 ;(define-key idlwave-shell-mode-map "\M-?" 'comint-dynamic-list-completions)
2765 ;(define-key idlwave-shell-mode-map "\t" 'comint-dynamic-complete)
2766 (define-key idlwave-shell-mode-map "\t" 'idlwave-shell-complete)
2767 (define-key idlwave-shell-mode-map "\M-\t" 'idlwave-shell-complete)
2768 (define-key idlwave-shell-mode-map "\C-c\C-s" 'idlwave-shell)
2769 (define-key idlwave-shell-mode-map "\C-c?" 'idlwave-routine-info)
2770 (define-key idlwave-shell-mode-map "\M-?" 'idlwave-context-help)
2771 (define-key idlwave-shell-mode-map "\C-c\C-i" 'idlwave-update-routine-info)
2772 (define-key idlwave-shell-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop)
2773 (define-key idlwave-shell-mode-map "\C-c\C-x" 'idlwave-shell-send-char)
2774 (define-key idlwave-shell-mode-map "\C-c=" 'idlwave-resolve)
2775 (define-key idlwave-shell-mode-map "\C-c\C-v" 'idlwave-find-module)
2776 (define-key idlwave-shell-mode-map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers)
2777 (define-key idlwave-shell-mode-map idlwave-shell-prefix-key
2778 'idlwave-shell-debug-map)
2779 (define-key idlwave-shell-mode-map [(up)] 'idlwave-shell-up-or-history)
2780 (define-key idlwave-shell-mode-map [(down)] 'idlwave-shell-down-or-history)
2781 (define-key idlwave-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop)
2782 (define-key idlwave-mode-map "\C-c\C-x" 'idlwave-shell-send-char)
2783 (define-key idlwave-mode-map
2784 (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
2785 'idlwave-shell-mouse-print)
2786 (define-key idlwave-mode-map
2787 (if (featurep 'xemacs) [(shift control button2)] [(shift control mouse-2)])
2788 'idlwave-shell-mouse-help)
2789 (define-key idlwave-shell-mode-map
2790 (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
2791 'idlwave-shell-mouse-print)
2792 (define-key idlwave-shell-mode-map
2793 (if (featurep 'xemacs) [(shift control button2)] [(shift control mouse-2)])
2794 'idlwave-shell-mouse-help)
2795 (define-key idlwave-shell-mode-map
2796 (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])
2797 'idlwave-mouse-context-help)
2798
2799
2800 ;; The following set of bindings is used to bind the debugging keys.
2801 ;; If `idlwave-shell-activate-prefix-keybindings' is non-nil, the first key
2802 ;; in the list gets bound the C-c C-d prefix map.
2803 ;; If `idlwave-shell-debug-modifiers' is non-nil, the second key
2804 ;; in the list gets bound with the specified modifiers in both
2805 ;; `idlwave-mode-map' and `idlwave-shell-mode-map'.
2806
2807 ;; Used keys: abcdef hi klmnopqrs u wxyz
2808 ;; Unused keys: g j t v
2809 (let* ((specs
2810 '(([(control ?b)] ?b idlwave-shell-break-here)
2811 ([(control ?i)] ?i idlwave-shell-break-in)
2812 ([(control ?d)] ?d idlwave-shell-clear-current-bp)
2813 ([(control ?a)] ?a idlwave-shell-clear-all-bp)
2814 ([(control ?s)] ?s idlwave-shell-step)
2815 ([(control ?n)] ?n idlwave-shell-stepover)
2816 ([(control ?k)] ?k idlwave-shell-skip)
2817 ([(control ?u)] ?u idlwave-shell-up)
2818 ([(control ?o)] ?o idlwave-shell-out)
2819 ([(control ?m)] ?m idlwave-shell-return)
2820 ([(control ?h)] ?h idlwave-shell-to-here)
2821 ([(control ?r)] ?r idlwave-shell-cont)
2822 ([(control ?y)] ?y idlwave-shell-execute-default-command-line)
2823 ([(control ?z)] ?z idlwave-shell-reset)
2824 ([(control ?q)] ?q idlwave-shell-quit)
2825 ([(control ?p)] ?p idlwave-shell-print)
2826 ([(??)] ?? idlwave-shell-help-expression)
2827 ([(control ?c)] ?c idlwave-shell-save-and-run)
2828 ([( ?@)] ?@ idlwave-shell-save-and-batch)
2829 ([(control ?x)] ?x idlwave-shell-goto-next-error)
2830 ([(control ?e)] ?e idlwave-shell-run-region)
2831 ([(control ?w)] ?w idlwave-shell-resync-dirs)
2832 ([(control ?l)] ?l idlwave-shell-redisplay)
2833 ([(control ?t)] ?t idlwave-shell-toggle-toolbar)
2834 ([(control up)] up idlwave-shell-stack-up)
2835 ([(control down)] down idlwave-shell-stack-down)
2836 ([(control ?f)] ?f idlwave-shell-window)))
2837 (mod (cond ((and idlwave-shell-debug-modifiers
2838 (listp idlwave-shell-debug-modifiers)
2839 (not (equal '() idlwave-shell-debug-modifiers)))
2840 idlwave-shell-debug-modifiers)
2841 (idlwave-shell-activate-alt-keybindings
2842 '(alt))))
2843 (shift (memq 'shift mod))
2844 (mod-noshift (delete 'shift (copy-sequence mod)))
2845 s k1 c2 k2 cmd)
2846 (while (setq s (pop specs))
2847 (setq k1 (nth 0 s)
2848 c2 (nth 1 s)
2849 cmd (nth 2 s))
2850 (when idlwave-shell-activate-prefix-keybindings
2851 (and k1 (define-key idlwave-shell-mode-prefix-map k1 cmd)))
2852 (when (and mod window-system)
2853 (if (char-or-string-p c2)
2854 (setq k2 (vector (append mod-noshift
2855 (list (if shift (upcase c2) c2)))))
2856 (setq k2 (vector (append mod (list c2)))))
2857 (define-key idlwave-mode-map k2 cmd)
2858 (define-key idlwave-shell-mode-map k2 cmd))))
2859
2860 ;; Enter the prefix map at the two places.
2861 (fset 'idlwave-debug-map idlwave-shell-mode-prefix-map)
2862 (fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map)
2863
2864 ;; The Menus --------------------------------------------------------------
2865
2866 (defvar idlwave-shell-menu-def
2867 '("Debug"
2868 ["Save and .RUN" idlwave-shell-save-and-run
2869 (or (eq major-mode 'idlwave-mode)
2870 idlwave-shell-last-save-and-action-file)]
2871 ["Save and .COMPILE" idlwave-shell-save-and-compile
2872 (or (eq major-mode 'idlwave-mode)
2873 idlwave-shell-last-save-and-action-file)]
2874 ["Save and @Batch" idlwave-shell-save-and-batch
2875 (or (eq major-mode 'idlwave-mode)
2876 idlwave-shell-last-save-and-action-file)]
2877 ["Goto Next Error" idlwave-shell-goto-next-error t]
2878 "--"
2879 ["Execute Default Cmd" idlwave-shell-execute-default-command-line t]
2880 ["Edit Default Cmd" idlwave-shell-edit-default-command-line t]
2881 "--"
2882 ["Set Breakpoint" idlwave-shell-break-here
2883 (eq major-mode 'idlwave-mode)]
2884 ["Break in Module" idlwave-shell-break-in t]
2885 ["Clear Breakpoint" idlwave-shell-clear-current-bp t]
2886 ["Clear All Breakpoints" idlwave-shell-clear-all-bp t]
2887 ["List All Breakpoints" idlwave-shell-list-all-bp t]
2888 "--"
2889 ["Step (into)" idlwave-shell-step t]
2890 ["Step (over)" idlwave-shell-stepover t]
2891 ["Skip One Statement" idlwave-shell-skip t]
2892 ["Continue" idlwave-shell-cont t]
2893 ("Continue to"
2894 ["End of Block" idlwave-shell-up t]
2895 ["End of Subprog" idlwave-shell-return t]
2896 ["End of Subprog+1" idlwave-shell-out t]
2897 ["Here (Cursor Line)" idlwave-shell-to-here
2898 (eq major-mode 'idlwave-mode)])
2899 "--"
2900 ["Print expression" idlwave-shell-print t]
2901 ["Help on expression" idlwave-shell-help-expression t]
2902 ["Evaluate Region" idlwave-shell-evaluate-region
2903 (eq major-mode 'idlwave-mode)]
2904 ["Run Region" idlwave-shell-run-region (eq major-mode 'idlwave-mode)]
2905 "--"
2906 ["Redisplay" idlwave-shell-redisplay t]
2907 ["Stack Up" idlwave-shell-stack-up t]
2908 ["Stack Down" idlwave-shell-stack-down t]
2909 "--"
2910 ["Update Working Dir" idlwave-shell-resync-dirs t]
2911 ["Reset IDL" idlwave-shell-reset t]
2912 "--"
2913 ["Toggle Toolbar" idlwave-shell-toggle-toolbar t]
2914 ["Exit IDL" idlwave-shell-quit t]))
2915
2916 (setq idlwave-shell-menu-def
2917 '("Debug"
2918 ("Compile & Run"
2919 ["Save and .RUN" idlwave-shell-save-and-run
2920 (or (eq major-mode 'idlwave-mode)
2921 idlwave-shell-last-save-and-action-file)]
2922 ["Save and .COMPILE" idlwave-shell-save-and-compile
2923 (or (eq major-mode 'idlwave-mode)
2924 idlwave-shell-last-save-and-action-file)]
2925 ["Save and @Batch" idlwave-shell-save-and-batch
2926 (or (eq major-mode 'idlwave-mode)
2927 idlwave-shell-last-save-and-action-file)]
2928 ["Goto Next Error" idlwave-shell-goto-next-error t]
2929 "--"
2930 ["Run Region" idlwave-shell-run-region (eq major-mode 'idlwave-mode)]
2931 "--"
2932 ["Execute Default Cmd" idlwave-shell-execute-default-command-line t]
2933 ["Edit Default Cmd" idlwave-shell-edit-default-command-line t])
2934 ("Breakpoints"
2935 ["Set Breakpoint" idlwave-shell-break-here
2936 (eq major-mode 'idlwave-mode)]
2937 ["Break in Module" idlwave-shell-break-in t]
2938 ["Clear Breakpoint" idlwave-shell-clear-current-bp t]
2939 ["Clear All Breakpoints" idlwave-shell-clear-all-bp t]
2940 ["List All Breakpoints" idlwave-shell-list-all-bp t])
2941 ("Continue/Step"
2942 ["Step (into)" idlwave-shell-step t]
2943 ["Step (over)" idlwave-shell-stepover t]
2944 ["Skip One Statement" idlwave-shell-skip t]
2945 ["Continue" idlwave-shell-cont t]
2946 ["... to End of Block" idlwave-shell-up t]
2947 ["... to End of Subprog" idlwave-shell-return t]
2948 ["... to End of Subprog+1" idlwave-shell-out t]
2949 ["... to Here (Cursor Line)" idlwave-shell-to-here
2950 (eq major-mode 'idlwave-mode)])
2951 ("Print Expression"
2952 ["Print expression" idlwave-shell-print t]
2953 ["Help on expression" idlwave-shell-help-expression t]
2954 ["Evaluate Region" idlwave-shell-evaluate-region
2955 (eq major-mode 'idlwave-mode)]
2956 "--"
2957 ["Redisplay" idlwave-shell-redisplay t]
2958 ["Stack Up" idlwave-shell-stack-up t]
2959 ["Stack Down" idlwave-shell-stack-down t])
2960 ("Input Mode"
2961 ["Send one char" idlwave-shell-send-char t]
2962 ["Temporary Character Mode" idlwave-shell-char-mode-loop t]
2963 "--"
2964 ["Use Input Mode Magic"
2965 (setq idlwave-shell-use-input-mode-magic
2966 (not idlwave-shell-use-input-mode-magic))
2967 :style toggle :selected idlwave-shell-use-input-mode-magic])
2968 "--"
2969 ["Update Working Dir" idlwave-shell-resync-dirs t]
2970 ["Reset IDL" idlwave-shell-reset t]
2971 "--"
2972 ["Toggle Toolbar" idlwave-shell-toggle-toolbar t]
2973 ["Exit IDL" idlwave-shell-quit t]))
2974
2975 (if (or (featurep 'easymenu) (load "easymenu" t))
2976 (progn
2977 (easy-menu-define
2978 idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"
2979 idlwave-shell-menu-def)
2980 (easy-menu-define
2981 idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"
2982 idlwave-shell-menu-def)
2983 (save-excursion
2984 (mapcar (lambda (buf)
2985 (set-buffer buf)
2986 (if (eq major-mode 'idlwave-mode)
2987 (progn
2988 (easy-menu-remove idlwave-mode-debug-menu)
2989 (easy-menu-add idlwave-mode-debug-menu))))
2990 (buffer-list)))))
2991
2992 ;; The Breakpoint Glyph -------------------------------------------------------
2993
2994 (defvar idlwave-shell-bp-glyph nil
2995 "The glyph to mark breakpoint lines in the source code.")
2996
2997 (let ((image-string "/* XPM */
2998 static char * file[] = {
2999 \"14 12 3 1\",
3000 \" c #FFFFFFFFFFFF s backgroundColor\",
3001 \". c #4B4B4B4B4B4B\",
3002 \"R c #FFFF00000000\",
3003 \" \",
3004 \" \",
3005 \" RRRR \",
3006 \" RRRRRR \",
3007 \" RRRRRRRR \",
3008 \" RRRRRRRR \",
3009 \" RRRRRRRR \",
3010 \" RRRRRRRR \",
3011 \" RRRRRR \",
3012 \" RRRR \",
3013 \" \",
3014 \" \"};"))
3015
3016 (setq idlwave-shell-bp-glyph
3017 (cond ((and (featurep 'xemacs)
3018 (featurep 'xpm))
3019 (make-glyph image-string))
3020 ((and (not (featurep 'xemacs))
3021 (fboundp 'image-type-available-p)
3022 (image-type-available-p 'xpm))
3023 (list 'image :type 'xpm :data image-string))
3024 (t nil))))
3025
3026 (provide 'idlw-shell)
3027 (provide 'idlwave-shell)
3028
3029 ;;; Load the toolbar when wanted by the user.
3030
3031 (autoload 'idlwave-toolbar-toggle "idlw-toolbar"
3032 "Toggle the IDLWAVE toolbar")
3033 (autoload 'idlwave-toolbar-add-everywhere "idlw-toolbar"
3034 "Add IDLWAVE toolbar")
3035 (defun idlwave-shell-toggle-toolbar ()
3036 "Toggle the display of the debugging toolbar."
3037 (interactive)
3038 (idlwave-toolbar-toggle))
3039
3040 (if idlwave-shell-use-toolbar
3041 (add-hook 'idlwave-shell-mode-hook 'idlwave-toolbar-add-everywhere))
3042
3043 ;;; idlw-shell.el ends here