Fix typo.
[bpt/emacs.git] / 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: John-David Smith <jdsmith@astro.cornell.edu>
6 ;; Version: 4.7
7 ;; Date: $Date: 2002/02/16 12:50:25 $
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 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 (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm
727 nil 'local)
728 (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local)
729 (add-hook 'kill-emacs-hook 'idlwave-shell-delete-temp-files)
730 (use-local-map idlwave-shell-mode-map)
731 (easy-menu-add idlwave-shell-mode-menu idlwave-shell-mode-map)
732
733 (set (make-local-variable 'comint-scroll-to-bottom-on-input) t)
734 (set (make-local-variable 'comint-scroll-show-maximum-output) t)
735
736 ;; IDLWAVE syntax, and turn on abbreviations
737 (setq local-abbrev-table idlwave-mode-abbrev-table)
738 (set-syntax-table idlwave-mode-syntax-table)
739 (set (make-local-variable 'comment-start) ";")
740 (setq abbrev-mode t)
741 (add-hook 'post-command-hook 'idlwave-command-hook nil t)
742
743 ;; Run the hooks.
744 (run-hooks 'idlwave-shell-mode-hook)
745 (idlwave-shell-send-command idlwave-shell-initial-commands nil 'hide)
746 ;; Define a system variable which knows the version of IDLWAVE
747 (idlwave-shell-send-command
748 (format "defsysv,'!idlwave_version','%s',1" idlwave-mode-version)
749 nil 'hide)
750 (if (and (not idlwave-path-alist)
751 (not idlwave-sys-dir))
752 (idlwave-shell-send-command idlwave-shell-path-query
753 'idlwave-shell-get-path-info
754 'hide)))
755
756 (defun idlwave-shell-get-path-info ()
757 (let* ((rpl (idlwave-shell-path-filter))
758 (sysdir (car rpl))
759 (dirs (cdr rpl)))
760 (setq idlwave-sys-dir sysdir)
761 (setq idlwave-path-alist (mapcar (lambda(x) (cons x nil))
762 dirs))))
763
764 (if (not (fboundp 'idl-shell))
765 (fset 'idl-shell 'idlwave-shell))
766
767 (defvar idlwave-shell-idl-wframe nil
768 "Frame for displaying the idl shell window.")
769 (defvar idlwave-shell-display-wframe nil
770 "Frame for displaying the idl source files.")
771
772 (defvar idlwave-shell-calling-stack-index 0)
773 (defvar idlwave-shell-calling-stack-routine nil)
774
775 (defun idlwave-shell-source-frame ()
776 "Return the frame to be used for source display."
777 (if idlwave-shell-use-dedicated-frame
778 ;; We want separate frames for source and shell
779 (if (frame-live-p idlwave-shell-display-wframe)
780 ;; The frame exists, so we use it.
781 idlwave-shell-display-wframe
782 ;; The frame does not exist. We use the current frame.
783 ;; However, if the current is the shell frame, we make a new frame.
784 (setq idlwave-shell-display-wframe
785 (if (eq (selected-frame) idlwave-shell-idl-wframe)
786 (make-frame)
787 (selected-frame))))))
788
789 (defun idlwave-shell-shell-frame ()
790 "Return the frame to be used for the shell buffer."
791 (if idlwave-shell-use-dedicated-frame
792 ;; We want a dedicated frame
793 (if (frame-live-p idlwave-shell-idl-wframe)
794 ;; It does exist, so we use it.
795 idlwave-shell-idl-wframe
796 ;; It does not exist. Check if we have a source frame.
797 (if (not (frame-live-p idlwave-shell-display-wframe))
798 ;; We do not have a source frame, so we use this one.
799 (setq idlwave-shell-display-wframe (selected-frame)))
800 ;; Return a new frame
801 (setq idlwave-shell-idl-wframe
802 (make-frame idlwave-shell-frame-parameters)))))
803
804 ;;;###autoload
805 (defun idlwave-shell (&optional arg)
806 "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'.
807 If buffer exists but shell process is not running, start new IDL.
808 If buffer exists and shell process is running, just switch to the buffer.
809
810 When called with a prefix ARG, or when `idlwave-shell-use-dedicated-frame'
811 is non-nil, the shell buffer and the source buffers will be in
812 separate frames.
813
814 The command to run comes from variable `idlwave-shell-explicit-file-name'.
815
816 The buffer is put in `idlwave-shell-mode', providing commands for sending
817 input and controlling the IDL job. See help on `idlwave-shell-mode'.
818 See also the variable `idlwave-shell-prompt-pattern'.
819
820 \(Type \\[describe-mode] in the shell buffer for a list of commands.)"
821 (interactive "P")
822
823 ;; A non-nil arg means, we want a dedicated frame. This will last
824 ;; for the current editing session.
825 (if arg (setq idlwave-shell-use-dedicated-frame t))
826 (if (equal arg '(16)) (setq idlwave-shell-use-dedicated-frame nil))
827
828 ;; Check if the process still exists. If not, create it.
829 (unless (comint-check-proc (idlwave-shell-buffer))
830 (let* ((prg (or idlwave-shell-explicit-file-name "idl"))
831 (buf (apply 'make-comint
832 idlwave-shell-process-name prg nil
833 idlwave-shell-command-line-options))
834 (process (get-buffer-process buf)))
835 (setq idlwave-idlwave_routine_info-compiled nil)
836 (set-process-filter process 'idlwave-shell-filter)
837 (set-process-sentinel process 'idlwave-shell-sentinel)
838 (set-buffer buf)
839 (idlwave-shell-mode)))
840 (let ((window (idlwave-display-buffer (idlwave-shell-buffer) nil
841 (idlwave-shell-shell-frame)))
842 (current-window (selected-window)))
843 (select-window window)
844 (goto-char (point-max))
845 (select-window current-window)
846 (raise-frame (window-frame window))
847 (if (eq (selected-frame) (window-frame window))
848 (select-window window))
849 ))
850
851 (defun idlwave-shell-recenter-shell-window (&optional arg)
852 "Run `idlwave-shell', but make sure the current window stays selected."
853 (interactive "P")
854 (let ((window (selected-window)))
855 (idlwave-shell arg)
856 (select-window window)))
857
858 (defun idlwave-shell-send-command (&optional cmd pcmd hide preempt)
859 "Send a command to IDL process.
860
861 \(CMD PCMD HIDE\) are placed at the end of `idlwave-shell-pending-commands'.
862 If IDL is ready the first command, CMD, in
863 `idlwave-shell-pending-commands' is sent to the IDL process. If optional
864 second argument PCMD is non-nil it will be placed on
865 `idlwave-shell-post-command-hook' when CMD is executed. If the optional
866 third argument HIDE is non-nil, then hide output from CMD.
867 If optional fourth argument PREEMPT is non-nil CMD is put at front of
868 `idlwave-shell-pending-commands'.
869
870 IDL is considered ready if the prompt is present
871 and if `idlwave-shell-ready' is non-nil."
872
873 ;(setq hide nil) ; FIXME: turn this on for debugging only
874 (let (buf proc)
875 ;; Get or make the buffer and its process
876 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
877 (not (setq proc (get-buffer-process buf))))
878 (if (not idlwave-shell-automatic-start)
879 (error
880 (substitute-command-keys
881 "You need to first start an IDL shell with \\[idlwave-shell]"))
882 (idlwave-shell-recenter-shell-window)
883 (setq buf (get-buffer (idlwave-shell-buffer)))
884 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
885 (not (setq proc (get-buffer-process buf))))
886 ;; Still nothing
887 (error "Problem with autostarting IDL shell"))))
888
889 (save-excursion
890 (set-buffer buf)
891 (goto-char (process-mark proc))
892 ;; To make this easy, always push CMD onto pending commands
893 (if cmd
894 (setq idlwave-shell-pending-commands
895 (if preempt
896 ;; Put at front.
897 (append (list (list cmd pcmd hide))
898 idlwave-shell-pending-commands)
899 ;; Put at end.
900 (append idlwave-shell-pending-commands
901 (list (list cmd pcmd hide))))))
902 ;; Check if IDL ready
903 (if (and idlwave-shell-ready
904 ;; Check for IDL prompt
905 (save-excursion
906 (forward-line 0)
907 ;; (beginning-of-line) ; Changed for Emacs 21
908 (looking-at idlwave-shell-prompt-pattern)))
909 ;; IDL ready for command
910 (if idlwave-shell-pending-commands
911 ;; execute command
912 (let* ((lcmd (car idlwave-shell-pending-commands))
913 (cmd (car lcmd))
914 (pcmd (nth 1 lcmd))
915 (hide (nth 2 lcmd)))
916 ;; If this is an executive command, reset the stack pointer
917 (if (eq (string-to-char cmd) ?.)
918 (setq idlwave-shell-calling-stack-index 0))
919 ;; Set post-command
920 (setq idlwave-shell-post-command-hook pcmd)
921 ;; Output hiding
922 ;;; Debug code
923 ;;; (setq idlwave-shell-hide-output nil)
924 (setq idlwave-shell-hide-output hide)
925 ;; Pop command
926 (setq idlwave-shell-pending-commands
927 (cdr idlwave-shell-pending-commands))
928 ;; Send command for execution
929 (set-marker comint-last-input-start (point))
930 (set-marker comint-last-input-end (point))
931 (comint-simple-send proc cmd)
932 (setq idlwave-shell-ready nil)))))))
933
934 (defun idlwave-shell-send-char (c &optional no-error)
935 "Send one character to the shell, without a newline."
936 (interactive "cChar to send to IDL: ")
937 (let ((errf (if (interactive-p) 'error 'message))
938 buf proc)
939 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
940 (not (setq proc (get-buffer-process buf))))
941 (funcall errf "Shell is not running"))
942 (if (equal c ?\C-g)
943 (funcall errf "Abort")
944 (comint-send-string proc (char-to-string c)))))
945
946 (defvar idlwave-shell-char-mode-active)
947 (defun idlwave-shell-input-mode-magic (string)
948 "Check STRING for magic words and toggle character input mode.
949 See also the variable `idlwave-shell-input-mode-spells'."
950 (cond
951 ((string-match (car idlwave-shell-input-mode-spells) string)
952 (call-interactively 'idlwave-shell-send-char))
953 ((and (boundp 'idlwave-shell-char-mode-active)
954 (string-match (nth 2 idlwave-shell-input-mode-spells) string))
955 (setq idlwave-shell-char-mode-active 'exit))
956 ((string-match (nth 1 idlwave-shell-input-mode-spells) string)
957 ;; Set a timer which will soon start the character loop
958 (if (fboundp 'start-itimer)
959 (start-itimer "IDLWAVE Char Mode" 'idlwave-shell-char-mode-loop 0.5
960 nil nil t 'no-error)
961 (run-at-time 0.5 nil 'idlwave-shell-char-mode-loop 'no-error)))))
962
963 (defvar keyboard-quit)
964 (defun idlwave-shell-char-mode-loop (&optional no-error)
965 "Enter a loop which accepts single characters and sends them to IDL.
966 Characters are sent one by one, without newlines. The loop is blocking
967 and intercepts all input events to Emacs. You can use this command
968 to interact with the IDL command GET_KBRD.
969 The loop can be aborted by typing `C-g'. The loop also exits automatically
970 when the IDL prompt gets displayed again after the current IDL command."
971 (interactive)
972
973 ;; First check if there is a shell waiting for input
974 (let ((idlwave-shell-char-mode-active t)
975 (errf (if no-error 'message 'error))
976 buf proc c)
977 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
978 (not (setq proc (get-buffer-process buf))))
979 (funcall errf "Shell is not running"))
980 (if idlwave-shell-ready
981 (funcall errf "No IDL program seems to be waiting for input"))
982
983 ;; OK, start the loop
984 (message "Character mode on: Sending single chars (`C-g' to exit)")
985 (message
986 (catch 'exit
987 (while t
988 ;; Wait for input
989 ;; FIXME: Is it too dangerous to inhibit quit here?
990 (let ((inhibit-quit t))
991 ;; We wait and check frequently if we should abort
992 (while (sit-for 0.3)
993 (and idlwave-shell-ready
994 (throw 'exit "Character mode off (prompt displayed)"))
995 (and (eq idlwave-shell-char-mode-active 'exit)
996 (throw 'exit "Character mode off (closing spell incantation)")))
997 ;; Interpret input as a character - ignore non-char input
998 (condition-case nil
999 (setq c (read-char))
1000 (error (ding) (throw 'exit "Character mode off")))
1001 (cond
1002 ((null c) ; Non-char event: ignore
1003 (ding))
1004 ((equal c ?\C-g) ; Abort the loop
1005 (setq keyboard-quit nil)
1006 (ding)
1007 (throw 'exit "Character mode off (keyboard quit)"))
1008 (t ; Send the character and continue the loop
1009 (comint-send-string proc (char-to-string c))))
1010 (and (eq idlwave-shell-char-mode-active 'exit)
1011 (throw 'exit "Single char loop exited"))))))))
1012
1013 (defun idlwave-shell-up-or-history (&optional arg)
1014 "When in last line of process buffer, do `comint-previous-input'.
1015 Otherwise just do `previous-line'."
1016 (interactive "p")
1017 (if (eq t idlwave-shell-arrows-do-history) (goto-char (point-max)))
1018 (if (and idlwave-shell-arrows-do-history
1019 (>= (1+ (save-excursion (end-of-line) (point)))
1020 (marker-position
1021 (process-mark (get-buffer-process (current-buffer))))))
1022 (progn
1023 (and (not (eolp)) (kill-line nil))
1024 (comint-previous-input arg))
1025 (previous-line arg)))
1026
1027 (defun idlwave-shell-down-or-history (&optional arg)
1028 "When in last line of process buffer, do `comint-next-input'.
1029 Otherwise just do `next-line'."
1030 (interactive "p")
1031 (if (eq t idlwave-shell-arrows-do-history) (goto-char (point-max)))
1032 (if (and idlwave-shell-arrows-do-history
1033 (>= (1+ (save-excursion (end-of-line) (point)))
1034 (marker-position
1035 (process-mark (get-buffer-process (current-buffer))))))
1036 (progn
1037 (and (not (eolp)) (kill-line nil))
1038 (comint-next-input arg))
1039 (next-line arg)))
1040
1041 ;; There was a report that a newer version of comint.el changed the
1042 ;; name of comint-filter to comint-output-filter. Unfortunately, we
1043 ;; have yet to upgrade.
1044
1045 (defun idlwave-shell-comint-filter (process string) nil)
1046 (if (fboundp 'comint-output-filter)
1047 (fset 'idlwave-shell-comint-filter (symbol-function 'comint-output-filter))
1048 (fset 'idlwave-shell-comint-filter (symbol-function 'comint-filter)))
1049
1050 (defun idlwave-shell-is-running ()
1051 "Return t if the shell process is running."
1052 (eq (process-status idlwave-shell-process-name) 'run))
1053
1054 (defvar idlwave-shell-hidden-output-buffer " *idlwave-shell-hidden-output*"
1055 "Buffer containing hidden output from IDL commands.")
1056
1057 (defun idlwave-shell-filter (proc string)
1058 "Replace Carriage returns in output. Watch for prompt.
1059 When the IDL prompt is received executes `idlwave-shell-post-command-hook'
1060 and then calls `idlwave-shell-send-command' for any pending commands."
1061 ;; We no longer do the cleanup here - this is done by the process sentinel
1062 (when (eq (process-status idlwave-shell-process-name) 'run)
1063 ;; OK, process is still running, so we can use it.
1064 (let ((data (match-data)))
1065 (unwind-protect
1066 (progn
1067 ;; May change the original match data.
1068 (let (p)
1069 (while (setq p (string-match "\C-M" string))
1070 (aset string p ? )))
1071 ;;; Test/Debug code
1072 ;; (save-excursion (set-buffer (get-buffer-create "*test*"))
1073 ;; (goto-char (point-max))
1074 ;; (insert "%%%" string))
1075 ;;
1076 ;; Keep output
1077
1078 ; Should not keep output because the concat is costly. If hidden put
1079 ; the output in a hide-buffer. Then when the output is needed in post
1080 ; processing can access either the hide buffer or the idlwave-shell
1081 ; buffer. Then watching for the prompt is easier. Furthermore, if it
1082 ; is hidden and there is no post command, could throw away output.
1083 ; (setq idlwave-shell-command-output
1084 ; (concat idlwave-shell-command-output string))
1085 ;; Insert the string. Do this before getting the
1086 ;; state.
1087 (if idlwave-shell-hide-output
1088 (save-excursion
1089 (set-buffer
1090 (get-buffer-create idlwave-shell-hidden-output-buffer))
1091 (goto-char (point-max))
1092 (insert string))
1093 (idlwave-shell-comint-filter proc string))
1094 ;; Watch for prompt - need to accumulate the current line
1095 ;; since it may not be sent all at once.
1096 (if (string-match "\n" string)
1097 (progn
1098 (if idlwave-shell-use-input-mode-magic
1099 (idlwave-shell-input-mode-magic
1100 (concat idlwave-shell-accumulation string)))
1101 (setq idlwave-shell-accumulation
1102 (substring string
1103 (progn (string-match "\\(.*\n\\)*" string)
1104 (match-end 0)))))
1105 (setq idlwave-shell-accumulation
1106 (concat idlwave-shell-accumulation string)))
1107
1108
1109 ;; Check for prompt in current line
1110 (if (setq idlwave-shell-ready
1111 (string-match idlwave-shell-prompt-pattern
1112 idlwave-shell-accumulation))
1113 (progn
1114 (if idlwave-shell-hide-output
1115 (save-excursion
1116 (set-buffer idlwave-shell-hidden-output-buffer)
1117 (goto-char (point-min))
1118 (re-search-forward idlwave-shell-prompt-pattern nil t)
1119 (setq idlwave-shell-command-output
1120 (buffer-substring (point-min) (point)))
1121 (delete-region (point-min) (point)))
1122 (setq idlwave-shell-command-output
1123 (save-excursion
1124 (set-buffer
1125 (process-buffer proc))
1126 (buffer-substring
1127 (progn
1128 (goto-char (process-mark proc))
1129 (beginning-of-line nil)
1130 (point))
1131 comint-last-input-end))))
1132 ;;; Test/Debug code
1133 ;; (save-excursion (set-buffer
1134 ;; (get-buffer-create "*idlwave-shell-output*"))
1135 ;; (goto-char (point-max))
1136 ;; (insert "%%%" string))
1137 ;; Scan for state and do post command - bracket them
1138 ;; with idlwave-shell-ready=nil since they
1139 ;; may call idlwave-shell-send-command.
1140 (let ((idlwave-shell-ready nil))
1141 (idlwave-shell-scan-for-state)
1142 ;; Unset idlwave-shell-ready to prevent sending
1143 ;; commands to IDL while running hook.
1144 (if (listp idlwave-shell-post-command-hook)
1145 (eval idlwave-shell-post-command-hook)
1146 (funcall idlwave-shell-post-command-hook))
1147 ;; Reset to default state for next command.
1148 ;; Also we do not want to find this prompt again.
1149 (setq idlwave-shell-accumulation nil
1150 idlwave-shell-command-output nil
1151 idlwave-shell-post-command-hook nil
1152 idlwave-shell-hide-output nil))
1153 ;; Done with post command. Do pending command if
1154 ;; any.
1155 (idlwave-shell-send-command))))
1156 (store-match-data data)))))
1157
1158 (defun idlwave-shell-sentinel (process event)
1159 "The sentinel function for the IDLWAVE shell process."
1160 (let* ((buf (idlwave-shell-buffer))
1161 (win (get-buffer-window buf)))
1162 (when (get-buffer buf)
1163 (save-excursion
1164 (set-buffer (idlwave-shell-buffer))
1165 (goto-char (point-max))
1166 (insert (format "\n\n Process %s %s" process event))))
1167 (when (and (> (length (frame-list)) 1)
1168 (frame-live-p idlwave-shell-idl-wframe))
1169 (delete-frame idlwave-shell-idl-wframe)
1170 (setq idlwave-shell-idl-wframe nil
1171 idlwave-shell-display-wframe nil))
1172 (when (window-live-p win)
1173 (delete-window win))
1174 (idlwave-shell-cleanup)))
1175
1176 (defun idlwave-shell-scan-for-state ()
1177 "Scan for state info.
1178 Looks for messages in output from last IDL command indicating where
1179 IDL has stopped. The types of messages we are interested in are
1180 execution halted, stepped, breakpoint, interrupted at and trace
1181 messages. We ignore error messages otherwise.
1182 For breakpoint messages process any attached count or command
1183 parameters.
1184 Update the windows if a message is found."
1185 (let (update)
1186 (cond
1187 ;; Make sure we have output
1188 ((not idlwave-shell-command-output))
1189
1190 ;; Various types of HALT messages.
1191 ((string-match idlwave-shell-halt-messages-re
1192 idlwave-shell-command-output)
1193 ;; Grab the file and line state info.
1194 (setq idlwave-shell-calling-stack-index 0)
1195 (setq idlwave-shell-halt-frame
1196 (idlwave-shell-parse-line
1197 (substring idlwave-shell-command-output (match-end 0)))
1198 update t))
1199
1200 ;; Handle breakpoints separately
1201 ((string-match idlwave-shell-break-message
1202 idlwave-shell-command-output)
1203 (setq idlwave-shell-calling-stack-index 0)
1204 (setq idlwave-shell-halt-frame
1205 (idlwave-shell-parse-line
1206 (substring idlwave-shell-command-output (match-end 0)))
1207 update t)
1208 ;; We used to to counting hits on breakpoints
1209 ;; this is no longer supported since IDL breakpoints
1210 ;; have learned counting.
1211 ;; Do breakpoint command processing
1212 (let ((bp (assoc
1213 (list
1214 (nth 0 idlwave-shell-halt-frame)
1215 (nth 1 idlwave-shell-halt-frame))
1216 idlwave-shell-bp-alist)))
1217 (if bp
1218 (let ((cmd (idlwave-shell-bp-get bp 'cmd)))
1219 (if cmd
1220 ;; Execute command
1221 (if (listp cmd)
1222 (eval cmd)
1223 (funcall cmd))))
1224 ;; A breakpoint that we did not know about - perhaps it was
1225 ;; set by the user or IDL isn't reporting breakpoints like
1226 ;; we expect. Lets update our list.
1227 (idlwave-shell-bp-query)))))
1228
1229 ;; Handle compilation errors in addition to the above
1230 (if (and idlwave-shell-command-output
1231 (or (string-match
1232 idlwave-shell-syntax-error idlwave-shell-command-output)
1233 (string-match
1234 idlwave-shell-other-error idlwave-shell-command-output)))
1235 (progn
1236 (save-excursion
1237 (set-buffer
1238 (get-buffer-create idlwave-shell-error-buffer))
1239 (erase-buffer)
1240 (insert idlwave-shell-command-output)
1241 (goto-char (point-min))
1242 (setq idlwave-shell-error-last (point)))
1243 (idlwave-shell-goto-next-error)))
1244
1245 ;; Do update
1246 (when update
1247 (idlwave-shell-display-line (idlwave-shell-pc-frame)))))
1248
1249
1250 (defvar idlwave-shell-error-buffer " *idlwave-shell-errors*"
1251 "Buffer containing syntax errors from IDL compilations.")
1252
1253
1254 ;; FIXME: the following two variables do not currently allow line breaks
1255 ;; in module and file names. I am not sure if it will be necessary to
1256 ;; change this. Currently it seems to work the way it is.
1257 (defvar idlwave-shell-syntax-error
1258 "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"
1259 "A regular expression to match an IDL syntax error.
1260 The first \(..\) pair should match the file name. The second pair
1261 should match the line number.")
1262
1263 (defvar idlwave-shell-other-error
1264 "^% .*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"
1265 "A regular expression to match any IDL error.
1266 The first \(..\) pair should match the file name. The second pair
1267 should match the line number.")
1268
1269 (defvar idlwave-shell-file-line-message
1270 (concat
1271 "\\(" ; program name group (1)
1272 "\\<[a-zA-Z][a-zA-Z0-9_$:]*" ; start with a letter, followed by [..]
1273 "\\([ \t]*\n[ \t]*[a-zA-Z0-9_$:]+\\)*"; continuation lines program name (2)
1274 "\\)" ; end program name group (1)
1275 "[ \t\n]+" ; white space
1276 "\\(" ; line number group (3)
1277 "[0-9]+" ; the line number (the fix point)
1278 "\\([ \t]*\n[ \t]*[0-9]+\\)*" ; continuation lines number (4)
1279 "\\)" ; end line number group (3)
1280 "[ \t\n]+" ; white space
1281 "\\(" ; file name group (5)
1282 "[^ \t\n]+" ; file names can contain any non-white
1283 "\\([ \t]*\n[ \t]*[^ \t\n]+\\)*" ; continuation lines file name (6)
1284 "\\)" ; end line number group (5)
1285 )
1286 "*A regular expression to parse out the file name and line number.
1287 The 1st group should match the subroutine name.
1288 The 3rd group is the line number.
1289 The 5th group is the file name.
1290 All parts may contain linebreaks surrounded by spaces. This is important
1291 in IDL5 which inserts random linebreaks in long module and file names.")
1292
1293 (defun idlwave-shell-parse-line (string)
1294 "Parse IDL message for the subroutine, file name and line number.
1295 We need to work hard here to remove the stupid line breaks inserted by
1296 IDL5. These line breaks can be right in the middle of procedure
1297 or file names.
1298 It is very difficult to come up with a robust solution. This one seems
1299 to be pretty good though.
1300
1301 Here is in what ways it improves over the previous solution:
1302
1303 1. The procedure name can be split and will be restored.
1304 2. The number can be split. I have never seen this, but who knows.
1305 3. We do not require the `.pro' extension for files.
1306
1307 This function can still break when the file name ends on a end line
1308 and the message line contains an additional line with garbage. Then
1309 the first part of that garbage will be added to the file name.
1310 However, the function checks the existence of the files with and
1311 without this last part - thus the function only breaks if file name
1312 plus garbage match an existing regular file. This is hopefully very
1313 unlikely."
1314
1315 (let (number procedure file)
1316 (when (string-match idlwave-shell-file-line-message string)
1317 (setq procedure (match-string 1 string)
1318 number (match-string 3 string)
1319 file (match-string 5 string))
1320
1321 ;; Repair the strings
1322 (setq procedure (idlwave-shell-repair-string procedure))
1323 (setq number (idlwave-shell-repair-string number))
1324 (setq file (idlwave-shell-repair-file-name file))
1325
1326 ;; If we have a file, return the frame list
1327 (if file
1328 (list (idlwave-shell-file-name file)
1329 (string-to-int number)
1330 procedure)
1331 ;; No success finding a file
1332 nil))))
1333
1334 (defun idlwave-shell-repair-string (string)
1335 "Repair a string by taking out all linebreaks. This is destructive!"
1336 (while (string-match "[ \t]*\n[ \t]*" string)
1337 (setq string (replace-match "" t t string)))
1338 string)
1339
1340 (defun idlwave-shell-repair-file-name (file)
1341 "Repair a file name string by taking out all linebreaks.
1342 The last line of STRING may be garbage - we check which one makes a valid
1343 file name."
1344 (let ((file1 "") (file2 "") (start 0))
1345 ;; We scan no further than to the next "^%" line
1346 (if (string-match "^%" file)
1347 (setq file (substring file 0 (match-beginning 0))))
1348 ;; Take out the line breaks
1349 (while (string-match "[ \t]*\n[ \t]*" file start)
1350 (setq file1 (concat file1 (substring file start (match-beginning 0)))
1351 start (match-end 0)))
1352 (setq file2 (concat file1 (substring file start)))
1353 (cond
1354 ((file-regular-p file2) file2)
1355 ((file-regular-p file1) file1)
1356 ;; If we cannot veryfy the existence of the file, we return the shorter
1357 ;; name. The idea behind this is that this may be a relative file name
1358 ;; and our idea about the current working directory may be wrong.
1359 ;; If it is a relative file name, it hopefully is short.
1360 ((not (string= "" file1)) file1)
1361 ((not (string= "" file2)) file2)
1362 (t nil))))
1363
1364 (defun idlwave-shell-cleanup ()
1365 "Do necessary cleanup for a terminated IDL process."
1366 (setq idlwave-shell-step-frame nil
1367 idlwave-shell-halt-frame nil
1368 idlwave-shell-pending-commands nil
1369 idlwave-shell-command-line-to-execute nil
1370 idlwave-shell-bp-alist nil
1371 idlwave-shell-calling-stack-index 0
1372 idlwave-idlwave_routine_info-compiled nil)
1373 (idlwave-shell-delete-temp-files)
1374 (idlwave-shell-display-line nil)
1375 (idlwave-shell-update-bp-overlays) ; kill old overlays
1376 (idlwave-shell-kill-buffer idlwave-shell-hidden-output-buffer)
1377 (idlwave-shell-kill-buffer idlwave-shell-bp-buffer)
1378 (idlwave-shell-kill-buffer idlwave-shell-error-buffer)
1379 ;; (idlwave-shell-kill-buffer (idlwave-shell-buffer))
1380 (and (get-buffer (idlwave-shell-buffer))
1381 (bury-buffer (get-buffer (idlwave-shell-buffer))))
1382 (run-hooks 'idlwave-shell-cleanup-hook))
1383
1384 (defun idlwave-shell-kill-buffer (buf)
1385 "Kill buffer BUF if it exists."
1386 (if (setq buf (get-buffer buf))
1387 (kill-buffer buf)))
1388
1389 (defun idlwave-shell-kill-shell-buffer-confirm ()
1390 (when (idlwave-shell-is-running)
1391 (ding)
1392 (unless (y-or-n-p "IDL shell is running. Are you sure you want to kill the buffer? ")
1393 (error "Abort"))
1394 (message "Killing buffer *idl* and the associated process")))
1395
1396 (defun idlwave-shell-window (n)
1397 "Issue a `window,N' command to IDL, with special window size.
1398 The size is given by `idlwave-shell-graphics-window-size'."
1399 (interactive "P")
1400 (let ((n (if n (prefix-numeric-value n) 0)))
1401 (idlwave-shell-send-command
1402 (apply 'format "window,%d,xs=%d,ys=%d"
1403 n idlwave-shell-graphics-window-size))))
1404
1405 (defun idlwave-shell-resync-dirs ()
1406 "Resync the buffer's idea of the current directory stack.
1407 This command queries IDL with the command bound to
1408 `idlwave-shell-dirstack-query' (default \"printd\"), reads the
1409 output for the new directory stack."
1410 (interactive)
1411 (idlwave-shell-send-command idlwave-shell-dirstack-query
1412 'idlwave-shell-filter-directory
1413 'hide))
1414
1415 (defun idlwave-shell-retall (&optional arg)
1416 "Return from the entire calling stack."
1417 (interactive "P")
1418 (idlwave-shell-send-command "retall"))
1419
1420 (defun idlwave-shell-closeall (&optional arg)
1421 "Close all open files."
1422 (interactive "P")
1423 (idlwave-shell-send-command "close,/all"))
1424
1425 (defun idlwave-shell-quit (&optional arg)
1426 "Exit the idl process after confirmation.
1427 With prefix ARG, exit without confirmation."
1428 (interactive "P")
1429 (if (not (idlwave-shell-is-running))
1430 (error "Shell is not running")
1431 (if (or arg (y-or-n-p "Exit the IDLWAVE Shell? "))
1432 (condition-case nil
1433 (idlwave-shell-send-command "exit")
1434 (error nil)))))
1435
1436 (defun idlwave-shell-reset (&optional hidden)
1437 "Reset IDL. Return to main level and destroy the leaftover variables.
1438 This issues the following commands:
1439 RETALL
1440 WIDGET_CONTROL,/RESET
1441 CLOSE, /ALL
1442 HEAP_GC, /VERBOSE"
1443 ;; OBJ_DESTROY, OBJ_VALID() FIXME: should this be added?
1444 (interactive "P")
1445 (message "Resetting IDL")
1446 (setq idlwave-shell-calling-stack-index 0)
1447 (idlwave-shell-send-command "retall" nil hidden)
1448 (idlwave-shell-send-command "widget_control,/reset" nil hidden)
1449 (idlwave-shell-send-command "close,/all" nil hidden)
1450 ;; (idlwave-shell-send-command "obj_destroy, obj_valid()" nil hidden)
1451 (idlwave-shell-send-command "heap_gc,/verbose" nil hidden)
1452 (idlwave-shell-display-line nil))
1453
1454 (defun idlwave-shell-path-filter ()
1455 ;; Convert the output of the path query into a list of directories
1456 (let ((path-string idlwave-shell-command-output)
1457 (case-fold-search t)
1458 (start 0)
1459 dirs sysdir)
1460 (while (string-match "^PATH:[ \t]*<\\(.*\\)>[ \t]*\n" path-string start)
1461 (push (match-string 1 path-string) dirs)
1462 (setq start (match-end 0)))
1463 (setq dirs (mapcar 'file-name-as-directory dirs))
1464 (if (string-match "^SYSDIR:[ \t]*<\\(.*\\)>[ \t]*\n" path-string)
1465 (setq sysdir (file-name-as-directory
1466 (match-string 1 path-string))))
1467 (cons sysdir (nreverse dirs))))
1468
1469 (defun idlwave-shell-routine-info-filter ()
1470 "Function which parses the special output from idlwave_routine_info.pro."
1471 (let ((text idlwave-shell-command-output)
1472 (start 0)
1473 sep sep-re file type spec specs name cs key keys class entry)
1474 ;; Initialize variables
1475 (setq idlwave-compiled-routines nil
1476 idlwave-unresolved-routines nil)
1477 ;; Cut out the correct part of the output.
1478 (if (string-match
1479 "^>>>BEGIN OF IDLWAVE ROUTINE INFO (\"\\(.+\\)\" IS THE SEPARATOR.*"
1480 text)
1481 (setq sep (match-string 1 text)
1482 sep-re (concat (regexp-quote sep) " *")
1483 text (substring text (match-end 0)))
1484 ;; Set dummy values and kill the text
1485 (setq sep "@" sep-re "@ *" text "")
1486 (message "Routine Info warning: No match for BEGIN line"))
1487 (if (string-match "^>>>END OF IDLWAVE ROUTINE INFO.*" text)
1488 (setq text (substring text 0 (match-beginning 0)))
1489 (message "Routine Info warning: No match for END line"))
1490 (if (string-match "\\S-" text)
1491 ;; Obviously, the pro worked. Make a note that we have it now.
1492 (setq idlwave-idlwave_routine_info-compiled t))
1493 ;; Match the output lines
1494 (while (string-match "^IDLWAVE-\\(PRO\\|FUN\\): \\(.*\\)" text start)
1495 (setq start (match-end 0))
1496 (setq type (match-string 1 text)
1497 spec (match-string 2 text)
1498 specs (idlwave-split-string spec sep-re)
1499 name (nth 0 specs)
1500 class (if (equal (nth 1 specs) "") nil (nth 1 specs))
1501 file (nth 2 specs)
1502 cs (nth 3 specs)
1503 key (nth 4 specs)
1504 keys (if (and (stringp key)
1505 (not (string-match "\\` *\\'" key)))
1506 (mapcar 'list
1507 (delete "" (idlwave-split-string key " +")))))
1508 (setq name (idlwave-sintern-routine-or-method name class t)
1509 class (idlwave-sintern-class class t)
1510 file (if (equal file "") nil file)
1511 keys (mapcar (lambda (x)
1512 (list (idlwave-sintern-keyword (car x) t))) keys))
1513 ;; Make sure we use the same string object for the same file
1514 (setq file (idlwave-sintern-file file t))
1515 ;; FIXME: What should I do with routines from the temp file???
1516 ;; Maybe just leave it in - there is a chance that the
1517 ;; routine is still in there.
1518 ;; (if (equal file idlwave-shell-temp-pro-file)
1519 ;; (setq file nil))
1520
1521 ;; In the following ignore routines already defined in buffers,
1522 ;; assuming that if the buffer stuff differs, it is a "new"
1523 ;; version.
1524 ;; We could do the same for the library to avoid duplicates -
1525 ;; but I think frequently a user might have several versions of
1526 ;; the same function in different programs, and in this case the
1527 ;; compiled one will be the best guess of all version.
1528 ;; Therefore, we leave duplicates of library routines in.
1529
1530 (cond ((string= name "$MAIN$")) ; ignore this one
1531 ((and (string= type "PRO")
1532 ;; FIXME: is it OK to make the buffer routines dominate?
1533 (or t (null file)
1534 (not (idlwave-rinfo-assq name 'pro class
1535 idlwave-buffer-routines)))
1536 ;; FIXME: is it OK to make the library routines dominate?
1537 ;;(not (idlwave-rinfo-assq name 'pro class
1538 ;; idlwave-library-routines))
1539 )
1540 (setq entry (list name 'pro class (cons 'compiled file) cs keys))
1541 (if file
1542 (push entry idlwave-compiled-routines)
1543 (push entry idlwave-unresolved-routines)))
1544
1545 ((and (string= type "FUN")
1546 ;; FIXME: is it OK to make the buffer routines dominate?
1547 (or t (not file)
1548 (not (idlwave-rinfo-assq name 'fun class
1549 idlwave-buffer-routines)))
1550 ;; FIXME: is it OK to make the library routines dominate?
1551 ;; (not (idlwave-rinfo-assq name 'fun class
1552 ;; idlwave-library-routines))
1553 )
1554 (setq entry (list name 'fun class (cons 'compiled file) cs keys))
1555 (if file
1556 (push entry idlwave-compiled-routines)
1557 (push entry idlwave-unresolved-routines))))))
1558 ;; Reverse the definitions so that they are alphabetically sorted.
1559 (setq idlwave-compiled-routines (nreverse idlwave-compiled-routines)
1560 idlwave-unresolved-routines (nreverse idlwave-unresolved-routines)))
1561
1562 (defun idlwave-shell-filter-directory ()
1563 "Get the current directory from `idlwave-shell-command-output'.
1564 Change the default directory for the process buffer to concur."
1565 (save-excursion
1566 (set-buffer (idlwave-shell-buffer))
1567 (if (string-match "Current Directory: *\\(\\S-*\\) *$"
1568 idlwave-shell-command-output)
1569 (let ((dir (substring idlwave-shell-command-output
1570 (match-beginning 1) (match-end 1))))
1571 (message "Setting Emacs wd to %s" dir)
1572 (setq idlwave-shell-default-directory dir)
1573 (setq default-directory (file-name-as-directory dir))))))
1574
1575 (defun idlwave-shell-complete (&optional arg)
1576 "Do completion in the idlwave-shell buffer.
1577 Calls `idlwave-shell-complete-filename' after some executive commands or
1578 in strings. Otherwise, calls `idlwave-complete' to complete modules and
1579 keywords."
1580 ;;FIXME: batch files?
1581 (interactive "P")
1582 (let (cmd)
1583 (cond
1584 ((setq cmd (idlwave-shell-executive-command))
1585 ;; We are in a command line with an executive command
1586 (if (member (upcase cmd)
1587 '(".R" ".RU" ".RUN" ".RN" ".RNE" ".RNEW"
1588 ".COM" ".COMP" ".COMPI" ".COMPIL" ".COMPILE"))
1589 ;; This command expects file names
1590 (idlwave-shell-complete-filename)))
1591 ((and (idlwave-shell-filename-string)
1592 (save-excursion
1593 (beginning-of-line)
1594 (let ((case-fold-search t))
1595 (not (looking-at ".*obj_new"))))
1596 ;; In a string, could be a file name to here
1597 (idlwave-shell-complete-filename)))
1598 (t
1599 ;; Default completion of modules and keywords
1600 (idlwave-complete arg)))))
1601
1602 (defun idlwave-shell-complete-filename (&optional arg)
1603 "Complete a file name at point if after a file name.
1604 We assume that we are after a file name when completing one of the
1605 args of an executive .run, .rnew or .compile. Also, in a string
1606 constant we complete file names. Otherwise return nil, so that
1607 other completion functions can do thier work."
1608 (let* ((comint-file-name-chars idlwave-shell-file-name-chars)
1609 (completion-ignore-case (default-value 'completion-ignore-case)))
1610 (comint-dynamic-complete-filename)))
1611
1612 (defun idlwave-shell-executive-command ()
1613 "Return the name of the current executive command, if any."
1614 (save-excursion
1615 (idlwave-beginning-of-statement)
1616 (if (looking-at "[ \t]*\\([.][^ \t\n\r]*\\)")
1617 (match-string 1))))
1618
1619 (defun idlwave-shell-filename-string ()
1620 "Return t if in a string and after what could be a file name."
1621 (let ((limit (save-excursion (beginning-of-line) (point))))
1622 (save-excursion
1623 ;; Skip backwards over file name chars
1624 (skip-chars-backward idlwave-shell-file-name-chars limit)
1625 ;; Check of the next char is a string delimiter
1626 (memq (preceding-char) '(?\' ?\")))))
1627
1628 ;;;
1629 ;;; This section contains code for debugging IDL programs. --------------------
1630 ;;;
1631
1632 (defun idlwave-shell-redisplay (&optional hide)
1633 "Tries to resync the display with where execution has stopped.
1634 Issues a \"help,/trace\" command followed by a call to
1635 `idlwave-shell-display-line'. Also updates the breakpoint
1636 overlays."
1637 (interactive)
1638 (setq idlwave-shell-calling-stack-index 0)
1639 (idlwave-shell-send-command
1640 "help,/trace"
1641 '(idlwave-shell-display-line
1642 (idlwave-shell-pc-frame))
1643 hide)
1644 (idlwave-shell-bp-query))
1645
1646 (defun idlwave-shell-display-level-in-calling-stack (&optional hide)
1647 (idlwave-shell-send-command
1648 "help,/trace"
1649 `(progn
1650 ;; scanning for the state will reset the stack level - restore it
1651 (setq idlwave-shell-calling-stack-index
1652 ,idlwave-shell-calling-stack-index)
1653 ;; parse the stack and visit the selected frame
1654 (idlwave-shell-parse-stack-and-display))
1655 hide))
1656
1657 (defun idlwave-shell-parse-stack-and-display ()
1658 (let* ((lines (delete "" (idlwave-split-string
1659 idlwave-shell-command-output "^%")))
1660 (stack (delq nil (mapcar 'idlwave-shell-parse-line lines)))
1661 (nmax (1- (length stack)))
1662 (nmin 0) message)
1663 (cond
1664 ((< nmax nmin)
1665 (setq idlwave-shell-calling-stack-index 0)
1666 (ding)
1667 (message "Problem with calling stack"))
1668 ((> idlwave-shell-calling-stack-index nmax)
1669 (ding)
1670 (setq idlwave-shell-calling-stack-index nmax
1671 message (format "%d is the highest calling stack level - can't go further up"
1672 (- nmax))))
1673 ((< idlwave-shell-calling-stack-index nmin)
1674 (ding)
1675 (setq idlwave-shell-calling-stack-index nmin
1676 message (format "%d is the current calling stack level - can't go further down"
1677 (- nmin)))))
1678 (setq idlwave-shell-calling-stack-routine
1679 (nth 2 (nth idlwave-shell-calling-stack-index stack)))
1680 (idlwave-shell-display-line
1681 (nth idlwave-shell-calling-stack-index stack))
1682 (message (or message
1683 (format "In routine %s (stack level %d)"
1684 idlwave-shell-calling-stack-routine
1685 (- idlwave-shell-calling-stack-index))))))
1686
1687 (defun idlwave-shell-stack-up ()
1688 "Display the source code one step up the calling stack."
1689 (interactive)
1690 (incf idlwave-shell-calling-stack-index)
1691 (idlwave-shell-display-level-in-calling-stack 'hide))
1692 (defun idlwave-shell-stack-down ()
1693 "Display the source code one step down the calling stack."
1694 (interactive)
1695 (decf idlwave-shell-calling-stack-index)
1696 (idlwave-shell-display-level-in-calling-stack 'hide))
1697
1698 (defun idlwave-shell-goto-frame (&optional frame)
1699 "Set buffer to FRAME with point at the frame line.
1700 If the optional argument FRAME is nil then idlwave-shell-pc-frame is
1701 used. Does nothing if the resulting frame is nil."
1702 (if frame ()
1703 (setq frame (idlwave-shell-pc-frame)))
1704 (cond
1705 (frame
1706 (set-buffer (idlwave-find-file-noselect (car frame) 'shell))
1707 (widen)
1708 (goto-line (nth 1 frame)))))
1709
1710 (defun idlwave-shell-pc-frame ()
1711 "Returns the frame for IDL execution."
1712 (and idlwave-shell-halt-frame
1713 (list (nth 0 idlwave-shell-halt-frame)
1714 (nth 1 idlwave-shell-halt-frame)
1715 (nth 2 idlwave-shell-halt-frame))))
1716
1717 (defun idlwave-shell-valid-frame (frame)
1718 "Check that frame is for an existing file."
1719 (file-readable-p (car frame)))
1720
1721 (defun idlwave-shell-display-line (frame &optional col)
1722 "Display FRAME file in other window with overlay arrow.
1723
1724 FRAME is a list of file name, line number, and subroutine name.
1725 If FRAME is nil then remove overlay."
1726 (if (not frame)
1727 ;; Remove stop-line overlay from old position
1728 (progn
1729 (setq overlay-arrow-string nil)
1730 (setq idlwave-shell-mode-line-info nil)
1731 (setq idlwave-shell-is-stopped nil)
1732 (if idlwave-shell-stop-line-overlay
1733 (delete-overlay idlwave-shell-stop-line-overlay)))
1734 (if (not (idlwave-shell-valid-frame frame))
1735 ;; FIXME: errors are dangerous in shell filters. But I think I
1736 ;; have never encountered this one.
1737 (error (concat "Invalid frame - unable to access file: " (car frame)))
1738 ;;;
1739 ;;; buffer : the buffer to display a line in.
1740 ;;; select-shell: current buffer is the shell.
1741 ;;;
1742 (setq idlwave-shell-mode-line-info
1743 (if (nth 2 frame)
1744 (format "[%d:%s]"
1745 (- idlwave-shell-calling-stack-index)
1746 (nth 2 frame))))
1747 (let* ((buffer (idlwave-find-file-noselect (car frame) 'shell))
1748 (select-shell (equal (buffer-name) (idlwave-shell-buffer)))
1749 window pos)
1750
1751 ;; First make sure the shell window is visible
1752 (idlwave-display-buffer (idlwave-shell-buffer)
1753 nil (idlwave-shell-shell-frame))
1754
1755 ;; Now display the buffer and remember which window it is.
1756 (setq window (idlwave-display-buffer buffer
1757 nil (idlwave-shell-source-frame)))
1758
1759 ;; Enter the buffer and mark the line
1760 (save-excursion
1761 (set-buffer buffer)
1762 (save-restriction
1763 (widen)
1764 (goto-line (nth 1 frame))
1765 (setq pos (point))
1766 (setq idlwave-shell-is-stopped t)
1767 (if idlwave-shell-stop-line-overlay
1768 ;; Move overlay
1769 (move-overlay idlwave-shell-stop-line-overlay
1770 (point) (save-excursion (end-of-line) (point))
1771 (current-buffer))
1772 ;; Use the arrow instead, but only if marking is wanted.
1773 (if idlwave-shell-mark-stop-line
1774 (setq overlay-arrow-string idlwave-shell-overlay-arrow))
1775 (or overlay-arrow-position ; create the marker if necessary
1776 (setq overlay-arrow-position (make-marker)))
1777 (set-marker overlay-arrow-position (point) buffer)))
1778
1779 ;; If the point is outside the restriction, widen the buffer.
1780 (if (or (< pos (point-min)) (> pos (point-max)))
1781 (progn
1782 (widen)
1783 (goto-char pos)))
1784
1785 ;; If we have the column of the error, move the cursor there.
1786 (if col (move-to-column col))
1787 (setq pos (point)))
1788
1789 ;; Make sure pos is really displayed in the window.
1790 (set-window-point window pos)
1791
1792 ;; If we came from the shell, go back there. Otherwise select
1793 ;; the window where the error is displayed.
1794 (if (and (equal (buffer-name) (idlwave-shell-buffer))
1795 (not select-shell))
1796 (select-window window))))))
1797
1798
1799 (defun idlwave-shell-step (arg)
1800 "Step one source line. If given prefix argument ARG, step ARG source lines."
1801 (interactive "p")
1802 (or (not arg) (< arg 1)
1803 (setq arg 1))
1804 (idlwave-shell-send-command
1805 (concat ".s " (if (integerp arg) (int-to-string arg) arg))))
1806
1807 (defun idlwave-shell-stepover (arg)
1808 "Stepover one source line.
1809 If given prefix argument ARG, step ARG source lines.
1810 Uses IDL's stepover executive command which does not enter called functions."
1811 (interactive "p")
1812 (or (not arg) (< arg 1)
1813 (setq arg 1))
1814 (idlwave-shell-send-command
1815 (concat ".so " (if (integerp arg) (int-to-string arg) arg))))
1816
1817 (defun idlwave-shell-break-here (&optional count cmd)
1818 "Set breakpoint at current line.
1819
1820 If Count is nil then an ordinary breakpoint is set. We treat a count
1821 of 1 as a temporary breakpoint using the ONCE keyword. Counts greater
1822 than 1 use the IDL AFTER=count keyword to break only after reaching
1823 the statement count times.
1824
1825 Optional argument CMD is a list or function to evaluate upon reaching
1826 the breakpoint."
1827
1828 (interactive "P")
1829 (if (listp count)
1830 (setq count nil))
1831 (idlwave-shell-set-bp
1832 ;; Create breakpoint
1833 (idlwave-shell-bp (idlwave-shell-current-frame)
1834 (list count cmd)
1835 (idlwave-shell-current-module))))
1836
1837 (defun idlwave-shell-set-bp-check (bp)
1838 "Check for failure to set breakpoint.
1839 This is run on `idlwave-shell-post-command-hook'.
1840 Offers to recompile the procedure if we failed. This usually fixes
1841 the problem with not being able to set the breakpoint."
1842 ;; Scan for message
1843 (if (and idlwave-shell-command-output
1844 (string-match "% BREAKPOINT: *Unable to find code"
1845 idlwave-shell-command-output))
1846 ;; Offer to recompile
1847 (progn
1848 (if (progn
1849 (beep)
1850 (y-or-n-p
1851 (concat "Okay to recompile file "
1852 (idlwave-shell-bp-get bp 'file) " ")))
1853 ;; Recompile
1854 (progn
1855 ;; Clean up before retrying
1856 (idlwave-shell-command-failure)
1857 (idlwave-shell-send-command
1858 (concat ".run " (idlwave-shell-bp-get bp 'file)) nil nil)
1859 ;; Try setting breakpoint again
1860 (idlwave-shell-set-bp bp))
1861 (beep)
1862 (message "Unable to set breakpoint.")
1863 (idlwave-shell-command-failure)
1864 )
1865 ;; return non-nil if no error found
1866 nil)
1867 'okay))
1868
1869 (defun idlwave-shell-command-failure ()
1870 "Do any necessary clean up when an IDL command fails.
1871 Call this from a function attached to `idlwave-shell-post-command-hook'
1872 that detects the failure of a command.
1873 For example, this is called from `idlwave-shell-set-bp-check' when a
1874 breakpoint can not be set."
1875 ;; Clear pending commands
1876 (setq idlwave-shell-pending-commands nil))
1877
1878 (defun idlwave-shell-cont ()
1879 "Continue executing."
1880 (interactive)
1881 (idlwave-shell-send-command ".c" '(idlwave-shell-redisplay 'hide)))
1882
1883 (defun idlwave-shell-go ()
1884 "Run .GO. This starts the main program of the last compiled file."
1885 (interactive)
1886 (idlwave-shell-send-command ".go" '(idlwave-shell-redisplay 'hide)))
1887
1888 (defun idlwave-shell-return ()
1889 "Run .RETURN (continue to next return, but stay in subprogram)."
1890 (interactive)
1891 (idlwave-shell-send-command ".return" '(idlwave-shell-redisplay 'hide)))
1892
1893 (defun idlwave-shell-skip ()
1894 "Run .SKIP (skip one line, then step)."
1895 (interactive)
1896 (idlwave-shell-send-command ".skip" '(idlwave-shell-redisplay 'hide)))
1897
1898 (defun idlwave-shell-clear-bp (bp)
1899 "Clear breakpoint BP.
1900 Clears in IDL and in `idlwave-shell-bp-alist'."
1901 (let ((index (idlwave-shell-bp-get bp)))
1902 (if index
1903 (progn
1904 (idlwave-shell-send-command
1905 (concat "breakpoint,/clear,"
1906 (if (integerp index) (int-to-string index) index)))
1907 (idlwave-shell-bp-query)))))
1908
1909 (defun idlwave-shell-current-frame ()
1910 "Return a list containing the current file name and line point is in.
1911 If in the IDL shell buffer, returns `idlwave-shell-pc-frame'."
1912 (if (eq (current-buffer) (get-buffer (idlwave-shell-buffer)))
1913 ;; In IDL shell
1914 (idlwave-shell-pc-frame)
1915 ;; In source
1916 (list (idlwave-shell-file-name (buffer-file-name))
1917 (save-restriction
1918 (widen)
1919 (save-excursion
1920 (beginning-of-line)
1921 (1+ (count-lines 1 (point))))))))
1922
1923 (defun idlwave-shell-current-module ()
1924 "Return the name of the module for the current file.
1925 Returns nil if unable to obtain a module name."
1926 (if (eq (current-buffer) (get-buffer (idlwave-shell-buffer)))
1927 ;; In IDL shell
1928 (nth 2 idlwave-shell-halt-frame)
1929 ;; In pro file
1930 (save-restriction
1931 (widen)
1932 (save-excursion
1933 (if (idlwave-prev-index-position)
1934 (upcase (idlwave-unit-name)))))))
1935
1936 (defun idlwave-shell-clear-current-bp ()
1937 "Remove breakpoint at current line.
1938 This command can be called from the shell buffer if IDL is currently stopped
1939 at a breakpoint."
1940 (interactive)
1941 (let ((bp (idlwave-shell-find-bp (idlwave-shell-current-frame))))
1942 (if bp (idlwave-shell-clear-bp bp)
1943 ;; Try moving to beginning of statement
1944 (save-excursion
1945 (idlwave-shell-goto-frame)
1946 (idlwave-beginning-of-statement)
1947 (setq bp (idlwave-shell-find-bp (idlwave-shell-current-frame)))
1948 (if bp (idlwave-shell-clear-bp bp)
1949 (beep)
1950 (message "Cannot identify breakpoint for this line"))))))
1951
1952 (defun idlwave-shell-to-here ()
1953 "Set a breakpoint with count 1 then continue."
1954 (interactive)
1955 (idlwave-shell-break-here 1)
1956 (idlwave-shell-cont))
1957
1958 (defun idlwave-shell-break-in (&optional module)
1959 "Look for a module name near point and set a break point for it.
1960 The command looks for an identifier near point and sets a breakpoint
1961 for the first line of the corresponding module."
1962 (interactive)
1963 ;; get the identifier
1964 (let (module)
1965 (save-excursion
1966 (skip-chars-backward "a-zA-Z0-9_$")
1967 (if (looking-at idlwave-identifier)
1968 (setq module (match-string 0))
1969 (error "No identifier at point")))
1970 (idlwave-shell-send-command
1971 idlwave-shell-sources-query
1972 `(progn
1973 (idlwave-shell-sources-filter)
1974 (idlwave-shell-set-bp-in-module ,module))
1975 'hide)))
1976
1977 (defun idlwave-shell-set-bp-in-module (module)
1978 "Set breakpoint in module. Assumes that `idlwave-shell-sources-alist'
1979 contains an entry for that module."
1980 (let ((source-file (car-safe
1981 (cdr-safe
1982 (assoc (upcase module)
1983 idlwave-shell-sources-alist))))
1984 buf)
1985 (if (or (not source-file)
1986 (not (file-regular-p source-file))
1987 (not (setq buf
1988 (or (idlwave-get-buffer-visiting source-file)
1989 (find-file-noselect source-file)))))
1990 (progn
1991 (message "The source file for module %s is probably not compiled"
1992 module)
1993 (beep))
1994 (save-excursion
1995 (set-buffer buf)
1996 (save-excursion
1997 (goto-char (point-min))
1998 (let ((case-fold-search t))
1999 (if (re-search-forward
2000 (concat "^[ \t]*\\(pro\\|function\\)[ \t]+"
2001 (downcase module)
2002 "[ \t\n,]") nil t)
2003 (progn
2004 (goto-char (match-beginning 1))
2005 (message "Setting breakpoint for module %s" module)
2006 (idlwave-shell-break-here))
2007 (message "Cannot find module %s in file %s" module source-file)
2008 (beep))))))))
2009
2010 (defun idlwave-shell-up ()
2011 "Run to end of current block.
2012 Sets a breakpoint with count 1 at end of block, then continues."
2013 (interactive)
2014 (if (idlwave-shell-pc-frame)
2015 (save-excursion
2016 (idlwave-shell-goto-frame)
2017 ;; find end of subprogram
2018 (let ((eos (save-excursion
2019 (idlwave-beginning-of-subprogram)
2020 (idlwave-forward-block)
2021 (point))))
2022 (idlwave-backward-up-block -1)
2023 ;; move beyond end block line - IDL will not break there.
2024 ;; That is, you can put a breakpoint there but when IDL does
2025 ;; break it will report that it is at the next line.
2026 (idlwave-next-statement)
2027 (idlwave-end-of-statement)
2028 ;; Make sure we are not beyond subprogram
2029 (if (< (point) eos)
2030 ;; okay
2031 ()
2032 ;; Move back inside subprogram
2033 (goto-char eos)
2034 (idlwave-previous-statement))
2035 (idlwave-shell-to-here)))))
2036
2037 (defun idlwave-shell-out ()
2038 "Attempt to run until this procedure exits.
2039 Runs to the last statement and then steps 1 statement. Use the .out command."
2040 (interactive)
2041 (idlwave-shell-send-command (concat ".o")))
2042
2043 (defun idlwave-shell-help-expression (arg)
2044 "Print help on current expression. See `idlwave-shell-print'."
2045 (interactive "P")
2046 (idlwave-shell-print arg 'help))
2047
2048 (defun idlwave-shell-mouse-print (event)
2049 "Call `idlwave-shell-print' at the mouse position."
2050 (interactive "e")
2051 (mouse-set-point event)
2052 (idlwave-shell-print nil nil 'mouse))
2053
2054 (defun idlwave-shell-mouse-help (event)
2055 "Call `idlwave-shell-print' at the mouse position."
2056 (interactive "e")
2057 (mouse-set-point event)
2058 (idlwave-shell-print nil 'help 'mouse))
2059
2060 (defun idlwave-shell-print (arg &optional help mouse)
2061 "Print current expression. With HELP, show help on expression.
2062 An expression is an identifier plus 1 pair of matched parentheses
2063 directly following the identifier - an array or function
2064 call. Alternatively, an expression is the contents of any matched
2065 parentheses when the open parentheses is not directly preceded by an
2066 identifier. If point is at the beginning or within an expression
2067 return the inner-most containing expression, otherwise, return the
2068 preceding expression.
2069
2070 With prefix arg ARG, or when called from the shell buffer, prompt
2071 for an expression."
2072 (interactive "P")
2073 (save-excursion
2074 (let (expr beg end cmd)
2075 (if (and (not mouse)
2076 (or arg (eq major-mode 'idlwave-shell-mode)))
2077 (setq expr (read-string "Expression: "))
2078 (idlwave-with-special-syntax1
2079 ;; Move to beginning of current or previous expression
2080 (if (looking-at "\\<\\|(")
2081 ;; At beginning of expression, don't move backwards unless
2082 ;; this is at the end of an indentifier.
2083 (if (looking-at "\\>")
2084 (backward-sexp))
2085 (backward-sexp))
2086 (if (looking-at "\\>")
2087 ;; Move to beginning of identifier - must be an array or
2088 ;; function expression.
2089 (backward-sexp))
2090 ;; Move to end of expression
2091 (setq beg (point))
2092 (forward-sexp)
2093 (while (looking-at "\\>[[(]\\|\\.")
2094 ;; an array
2095 (forward-sexp))
2096 (setq end (point))
2097 (setq expr (buffer-substring beg end))))
2098 (when (and beg end idlwave-shell-expression-overlay)
2099 (move-overlay idlwave-shell-expression-overlay beg end
2100 (current-buffer))
2101 (add-hook 'pre-command-hook 'idlwave-shell-delete-expression-overlay))
2102 (if (and (integerp idlwave-shell-calling-stack-index)
2103 (> idlwave-shell-calling-stack-index 0))
2104 (setq cmd (idlwave-retrieve-expression-from-level
2105 expr
2106 idlwave-shell-calling-stack-index
2107 idlwave-shell-calling-stack-routine
2108 help))
2109 (setq cmd (concat (if help "help," "print,") expr)))
2110 (if idlwave-shell-print-expression-function
2111 (idlwave-shell-send-command
2112 cmd
2113 (list idlwave-shell-print-expression-function expr)
2114 'hide)
2115 (idlwave-shell-recenter-shell-window)
2116 (idlwave-shell-send-command cmd)))))
2117
2118 (defun idlwave-retrieve-expression-from-level (expr level routine help)
2119 "Return IDL command to print the expression EXPR from stack level LEVEL.
2120
2121 It does not seem possible to evaluate an expression on a differnt
2122 level than the current. Therefore, this function retrieves *copies* of
2123 the variables involved in the expression from the desired level in the
2124 calling stack. The copies are given some unlikely names on the
2125 *current* level, and the expression is then evaluated on the *current*
2126 level.
2127
2128 Since this function depends upon the undocumented IDL routine routine_names,
2129 there is no guarantie that this will work with future versions of IDL."
2130 (let ((prefix "___") ;; No real variables should starts with this.
2131 (fetch (- 0 level))
2132 (start 0)
2133 var tvar fetch-vars pre post)
2134
2135 ;; FIXME: In the following we try to find the variables in expression
2136 ;; This is quite empirical - I don't know in what situations this will
2137 ;; break. We will look for identifiers and exclude cases where we
2138 ;; know it is not a variable. To distinguish array references from
2139 ;; function calls, we require that arrays use [] instead of ()
2140
2141 (while (string-match
2142 "\\(\\`\\|[^a-zA-Z0-9$_]\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)\\([^a-zA-Z0-9$_]\\|\\'\\)" expr start)
2143 (setq var (match-string 2 expr)
2144 tvar (concat prefix var)
2145 start (match-beginning 2)
2146 pre (substring expr 0 (match-beginning 2))
2147 post (substring expr (match-end 2)))
2148 (cond
2149 ;; Exclude identifiers which are not variables
2150 ((string-match ",[ \t]*/\\'" pre)) ;; a `/' KEYWORD
2151 ((and (string-match "[,(][ \t]*\\'" pre)
2152 (string-match "\\`[ \t]*=" post))) ;; a `=' KEYWORD
2153 ((string-match "\\`(" post)) ;; a function
2154 ((string-match "->[ \t]*\\'" pre)) ;; a method
2155 ((string-match "\\.\\'" pre)) ;; structure member
2156 (t ;; seems to be a variable - arrange to get it and replace
2157 ;; its name in the expression with the temproary name.
2158 (push (cons var tvar) fetch-vars)
2159 (setq expr (concat pre tvar post)))))
2160 ;; Make a command line that first copies the relevant variables
2161 ;; and then prints the expression.
2162 (concat
2163 (mapconcat
2164 (lambda (x)
2165 (format "%s = routine_names('%s',fetch=%d)" (cdr x) (car x) fetch))
2166 (nreverse fetch-vars)
2167 " & ")
2168 (if idlwave-shell-print-expression-function " & " "\n")
2169 (if help "help, " "print, ")
2170 expr
2171 (format " ; [-%d:%s]" level routine))))
2172
2173 (defun idlwave-shell-delete-expression-overlay ()
2174 (condition-case nil
2175 (if idlwave-shell-expression-overlay
2176 (delete-overlay idlwave-shell-expression-overlay))
2177 (error nil))
2178 (remove-hook 'pre-command-hook 'idlwave-shell-delete-expression-overlay))
2179
2180 (defvar idlwave-shell-bp-alist nil
2181 "Alist of breakpoints.
2182 A breakpoint is a cons cell \(\(file line\) . \(\(index module\) data\)\)
2183
2184 The car is the frame for the breakpoint:
2185 file - full path file name.
2186 line - line number of breakpoint - integer.
2187
2188 The first element of the cdr is a list of internal IDL data:
2189 index - the index number of the breakpoint internal to IDL.
2190 module - the module for breakpoint internal to IDL.
2191
2192 Remaining elements of the cdr:
2193 data - Data associated with the breakpoint by idlwave-shell currently
2194 contains two items:
2195
2196 count - number of times to execute breakpoint. When count reaches 0
2197 the breakpoint is cleared and removed from the alist.
2198 command - command to execute when breakpoint is reached, either a
2199 lisp function to be called with `funcall' with no arguments or a
2200 list to be evaluated with `eval'.")
2201
2202 (defun idlwave-shell-run-region (beg end &optional n)
2203 "Compile and run the region using the IDL process.
2204 Copies the region to a temporary file `idlwave-shell-temp-pro-file'
2205 and issues the IDL .run command for the file. Because the
2206 region is compiled and run as a main program there is no
2207 problem with begin-end blocks extending over multiple
2208 lines - which would be a problem if `idlwave-shell-evaluate-region'
2209 was used. An END statement is appended to the region if necessary.
2210
2211 If there is a prefix argument, display IDL process."
2212 (interactive "r\nP")
2213 (let ((oldbuf (current-buffer)))
2214 (save-excursion
2215 (set-buffer (idlwave-find-file-noselect
2216 idlwave-shell-temp-pro-file 'tmp))
2217 (erase-buffer)
2218 (insert-buffer-substring oldbuf beg end)
2219 (if (not (save-excursion
2220 (idlwave-previous-statement)
2221 (idlwave-look-at "\\<end\\>")))
2222 (insert "\nend\n"))
2223 (save-buffer 0)))
2224 (idlwave-shell-send-command (concat ".run " idlwave-shell-temp-pro-file))
2225 (if n
2226 (idlwave-display-buffer (idlwave-shell-buffer)
2227 nil (idlwave-shell-shell-frame))))
2228
2229 (defun idlwave-shell-evaluate-region (beg end &optional n)
2230 "Send region to the IDL process.
2231 If there is a prefix argument, display IDL process.
2232 Does not work for a region with multiline blocks - use
2233 `idlwave-shell-run-region' for this."
2234 (interactive "r\nP")
2235 (idlwave-shell-send-command (buffer-substring beg end))
2236 (if n
2237 (idlwave-display-buffer (idlwave-shell-buffer)
2238 nil (idlwave-shell-shell-frame))))
2239
2240 (defun idlwave-shell-delete-temp-files ()
2241 "Delete the temporary files and kill associated buffers."
2242 (if (stringp idlwave-shell-temp-pro-file)
2243 (condition-case nil
2244 (let ((buf (idlwave-get-buffer-visiting
2245 idlwave-shell-temp-pro-file)))
2246 (if (buffer-live-p buf)
2247 (kill-buffer buf))
2248 (delete-file idlwave-shell-temp-pro-file))
2249 (error nil)))
2250 (if (stringp idlwave-shell-temp-rinfo-save-file)
2251 (condition-case nil
2252 (delete-file idlwave-shell-temp-rinfo-save-file)
2253 (error nil))))
2254
2255 (defun idlwave-display-buffer (buf not-this-window-p &optional frame)
2256 (if (or (< emacs-major-version 20)
2257 (and (= emacs-major-version 20)
2258 (< emacs-minor-version 3)))
2259 ;; Only two args.
2260 (display-buffer buf not-this-window-p)
2261 ;; Three ares possible.
2262 (display-buffer buf not-this-window-p frame)))
2263
2264 (defvar idlwave-shell-bp-buffer " *idlwave-shell-bp*"
2265 "Scratch buffer for parsing IDL breakpoint lists and other stuff.")
2266
2267 (defun idlwave-shell-bp-query ()
2268 "Reconcile idlwave-shell's breakpoint list with IDL's.
2269 Queries IDL using the string in `idlwave-shell-bp-query'."
2270 (interactive)
2271 (idlwave-shell-send-command idlwave-shell-bp-query
2272 'idlwave-shell-filter-bp
2273 'hide))
2274
2275 (defun idlwave-shell-bp-get (bp &optional item)
2276 "Get a value for a breakpoint.
2277 BP has the form of elements in idlwave-shell-bp-alist.
2278 Optional second arg ITEM is the particular value to retrieve.
2279 ITEM can be 'file, 'line, 'index, 'module, 'count, 'cmd, or 'data.
2280 'data returns a list of 'count and 'cmd.
2281 Defaults to 'index."
2282 (cond
2283 ;; Frame
2284 ((eq item 'line) (nth 1 (car bp)))
2285 ((eq item 'file) (nth 0 (car bp)))
2286 ;; idlwave-shell breakpoint data
2287 ((eq item 'data) (cdr (cdr bp)))
2288 ((eq item 'count) (nth 0 (cdr (cdr bp))))
2289 ((eq item 'cmd) (nth 1 (cdr (cdr bp))))
2290 ;; IDL breakpoint info
2291 ((eq item 'module) (nth 1 (car (cdr bp))))
2292 ;; index - default
2293 (t (nth 0 (car (cdr bp))))))
2294
2295 (defun idlwave-shell-filter-bp ()
2296 "Get the breakpoints from `idlwave-shell-command-output'.
2297 Create `idlwave-shell-bp-alist' updating breakpoint count and command data
2298 from previous breakpoint list."
2299 (save-excursion
2300 (set-buffer (get-buffer-create idlwave-shell-bp-buffer))
2301 (erase-buffer)
2302 (insert idlwave-shell-command-output)
2303 (goto-char (point-min))
2304 (let ((old-bp-alist idlwave-shell-bp-alist)
2305 file line index module)
2306 (setq idlwave-shell-bp-alist (list nil))
2307 (when (re-search-forward "^\\s-*Index.*\n\\s-*-" nil t)
2308 ;; There seems to be a breakpoint listing here.
2309 ;; Parse breakpoint lines.
2310 ;; Breakpoints have the form:
2311 ;; Index Module Line File
2312 ;; All seperated by whitespace.
2313 ;; Module may be missing if the file is not compiled.
2314 ;;
2315 (while (re-search-forward
2316 "^[ \t]*\\([0-9]+\\)[ \t]+\\(\\S-+\\)?[ \t]+\\([0-9]+\\)[ \t]+\\(\\S-+\\)" nil t)
2317 (setq index (match-string 1)
2318 module (match-string 2)
2319 line (string-to-int (match-string 3))
2320 file (idlwave-shell-file-name (match-string 4)))
2321 ;; Add the breakpoint info to the list
2322 (nconc idlwave-shell-bp-alist
2323 (list (cons (list file line)
2324 (list
2325 (list index module)
2326 ;; idlwave-shell data: count, command
2327 nil nil))))))
2328 (setq idlwave-shell-bp-alist (cdr idlwave-shell-bp-alist))
2329 ;; Update count, commands of breakpoints
2330 (mapcar 'idlwave-shell-update-bp old-bp-alist)))
2331 ;; Update the breakpoint overlays
2332 (idlwave-shell-update-bp-overlays)
2333 ;; Return the new list
2334 idlwave-shell-bp-alist)
2335
2336 (defun idlwave-shell-update-bp (bp)
2337 "Update BP data in breakpoint list.
2338 If BP frame is in `idlwave-shell-bp-alist' updates the breakpoint data."
2339 (let ((match (assoc (car bp) idlwave-shell-bp-alist)))
2340 (if match (setcdr (cdr match) (cdr (cdr bp))))))
2341
2342 (defun idlwave-shell-set-bp-data (bp data)
2343 "Set the data of BP to DATA."
2344 (setcdr (cdr bp) data))
2345
2346 (defun idlwave-shell-bp (frame &optional data module)
2347 "Create a breakpoint structure containing FRAME and DATA. Second
2348 and third args, DATA and MODULE, are optional. Returns a breakpoint
2349 of the format used in `idlwave-shell-bp-alist'. Can be used in commands
2350 attempting match a breakpoint in `idlwave-shell-bp-alist'."
2351 (cons frame (cons (list nil module) data)))
2352
2353 (defvar idlwave-shell-old-bp nil
2354 "List of breakpoints previous to setting a new breakpoint.")
2355
2356 (defun idlwave-shell-sources-bp (bp)
2357 "Check `idlwave-shell-sources-alist' for source of breakpoint using BP.
2358 If an equivalency is found, return the IDL internal source name.
2359 Otherwise return the filename in bp."
2360 (let*
2361 ((bp-file (idlwave-shell-bp-get bp 'file))
2362 (bp-module (idlwave-shell-bp-get bp 'module))
2363 (internal-file-list (cdr (assoc bp-module idlwave-shell-sources-alist))))
2364 (if (and internal-file-list
2365 (equal bp-file (nth 0 internal-file-list)))
2366 (nth 1 internal-file-list)
2367 bp-file)))
2368
2369 (defun idlwave-shell-set-bp (bp)
2370 "Try to set a breakpoint BP.
2371
2372 The breakpoint will be placed at the beginning of the statement on the
2373 line specified by BP or at the next IDL statement if that line is not
2374 a statement.
2375 Determines IDL's internal representation for the breakpoint which may
2376 have occured at a different line then used with the breakpoint
2377 command."
2378
2379 ;; Get and save the old breakpoints
2380 (idlwave-shell-send-command
2381 idlwave-shell-bp-query
2382 '(progn
2383 (idlwave-shell-filter-bp)
2384 (setq idlwave-shell-old-bp idlwave-shell-bp-alist))
2385 'hide)
2386 ;; Get sources for IDL compiled procedures followed by setting
2387 ;; breakpoint.
2388 (idlwave-shell-send-command
2389 idlwave-shell-sources-query
2390 `(progn
2391 (idlwave-shell-sources-filter)
2392 (idlwave-shell-set-bp2 (quote ,bp)))
2393 'hide))
2394
2395 (defun idlwave-shell-set-bp2 (bp)
2396 "Use results of breakpoint and sources query to set bp.
2397 Use the count argument with IDLs breakpoint command.
2398 We treat a count of 1 as a temporary breakpoint.
2399 Counts greater than 1 use the IDL AFTER=count keyword to break
2400 only after reaching the statement count times."
2401 (let*
2402 ((arg (idlwave-shell-bp-get bp 'count))
2403 (key (cond
2404 ((not (and arg (numberp arg))) "")
2405 ((= arg 1)
2406 ",/once")
2407 ((> arg 1)
2408 (format ",after=%d" arg))))
2409 (line (idlwave-shell-bp-get bp 'line)))
2410 (idlwave-shell-send-command
2411 (concat "breakpoint,'"
2412 (idlwave-shell-sources-bp bp) "',"
2413 (if (integerp line) (setq line (int-to-string line)))
2414 key)
2415 ;; Check for failure and look for breakpoint in IDL's list
2416 `(progn
2417 (if (idlwave-shell-set-bp-check (quote ,bp))
2418 (idlwave-shell-set-bp3 (quote ,bp))))
2419 ;; do not hide output
2420 nil
2421 'preempt)))
2422
2423 (defun idlwave-shell-set-bp3 (bp)
2424 "Find the breakpoint in IDL's internal list of breakpoints."
2425 (idlwave-shell-send-command idlwave-shell-bp-query
2426 `(progn
2427 (idlwave-shell-filter-bp)
2428 (idlwave-shell-new-bp (quote ,bp)))
2429 'hide
2430 'preempt))
2431
2432 (defun idlwave-shell-find-bp (frame)
2433 "Return breakpoint from `idlwave-shell-bp-alist' for frame.
2434 Returns nil if frame not found."
2435 (assoc frame idlwave-shell-bp-alist))
2436
2437 (defun idlwave-shell-new-bp (bp)
2438 "Find the new breakpoint in IDL's list and update with DATA.
2439 The actual line number for a breakpoint in IDL may be different than
2440 the line number used with the IDL breakpoint command.
2441 Looks for a new breakpoint index number in the list. This is
2442 considered the new breakpoint if the file name of frame matches."
2443 (let ((obp-index (mapcar 'idlwave-shell-bp-get idlwave-shell-old-bp))
2444 (bpl idlwave-shell-bp-alist))
2445 (while (and (member (idlwave-shell-bp-get (car bpl)) obp-index)
2446 (setq bpl (cdr bpl))))
2447 (if (and
2448 (not bpl)
2449 ;; No additional breakpoint.
2450 ;; Need to check if we are just replacing a breakpoint.
2451 (setq bpl (assoc (car bp) idlwave-shell-bp-alist)))
2452 (setq bpl (list bpl)))
2453 (if (and bpl
2454 (equal (idlwave-shell-bp-get (setq bpl (car bpl)) 'file)
2455 (idlwave-shell-bp-get bp 'file)))
2456 ;; Got the breakpoint - add count, command to it.
2457 ;; This updates `idlwave-shell-bp-alist' because a deep copy was
2458 ;; not done for bpl.
2459 (idlwave-shell-set-bp-data bpl (idlwave-shell-bp-get bp 'data))
2460 (beep)
2461 (message "Failed to identify breakpoint in IDL"))))
2462
2463 (defvar idlwave-shell-bp-overlays nil
2464 "List of overlays marking breakpoints")
2465
2466 (defun idlwave-shell-update-bp-overlays ()
2467 "Update the overlays which mark breakpoints in the source code.
2468 Existing overlays are recycled, in order to minimize consumption."
2469 (when idlwave-shell-mark-breakpoints
2470 (let ((bp-list idlwave-shell-bp-alist)
2471 (ov-list idlwave-shell-bp-overlays)
2472 ov bp)
2473 ;; Delete the old overlays from their buffers
2474 (while (setq ov (pop ov-list))
2475 (delete-overlay ov))
2476 (setq ov-list idlwave-shell-bp-overlays
2477 idlwave-shell-bp-overlays nil)
2478 (while (setq bp (pop bp-list))
2479 (save-excursion
2480 (idlwave-shell-goto-frame (car bp))
2481 (let* ((end (progn (end-of-line 1) (point)))
2482 (beg (progn (beginning-of-line 1) (point)))
2483 (ov (or (pop ov-list)
2484 (idlwave-shell-make-new-bp-overlay))))
2485 (move-overlay ov beg end)
2486 (push ov idlwave-shell-bp-overlays)))))))
2487
2488 (defvar idlwave-shell-bp-glyph)
2489 (defun idlwave-shell-make-new-bp-overlay ()
2490 "Make a new overlay for highlighting breakpoints.
2491 This stuff is stringly dependant upon the version of Emacs."
2492 (let ((ov (make-overlay 1 1)))
2493 (if (featurep 'xemacs)
2494 ;; This is XEmacs
2495 (progn
2496 (cond
2497 ((eq (console-type) 'tty)
2498 ;; tty's cannot display glyphs
2499 (set-extent-property ov 'face idlwave-shell-breakpoint-face))
2500 ((and (memq idlwave-shell-mark-breakpoints '(t glyph))
2501 idlwave-shell-bp-glyph)
2502 ;; use the glyph
2503 (set-extent-property ov 'begin-glyph idlwave-shell-bp-glyph))
2504 (idlwave-shell-mark-breakpoints
2505 ;; use the face
2506 (set-extent-property ov 'face idlwave-shell-breakpoint-face))
2507 (t
2508 ;; no marking
2509 nil))
2510 (set-extent-priority ov -1)) ; make stop line face prevail
2511 ;; This is Emacs
2512 (cond
2513 (window-system
2514 (if (and (memq idlwave-shell-mark-breakpoints '(t glyph))
2515 idlwave-shell-bp-glyph) ; this var knows if glyph's possible
2516 ;; use a glyph
2517 (let ((string "@"))
2518 (put-text-property 0 1
2519 'display idlwave-shell-bp-glyph
2520 string)
2521 (overlay-put ov 'before-string string))
2522 (overlay-put ov 'face idlwave-shell-breakpoint-face)))
2523 (idlwave-shell-mark-breakpoints
2524 ;; use a face
2525 (overlay-put ov 'face idlwave-shell-breakpoint-face))
2526 (t
2527 ;; No marking
2528 nil)))
2529 ov))
2530
2531 (defun idlwave-shell-edit-default-command-line (arg)
2532 "Edit the current execute command."
2533 (interactive "P")
2534 (setq idlwave-shell-command-line-to-execute
2535 (read-string "IDL> " idlwave-shell-command-line-to-execute)))
2536
2537 (defun idlwave-shell-execute-default-command-line (arg)
2538 "Execute a command line. On first use, ask for the command.
2539 Also with prefix arg, ask for the command. You can also uase the command
2540 `idlwave-shell-edit-default-command-line' to edit the line."
2541 (interactive "P")
2542 (if (or (not idlwave-shell-command-line-to-execute)
2543 arg)
2544 (setq idlwave-shell-command-line-to-execute
2545 (read-string "IDL> " idlwave-shell-command-line-to-execute)))
2546 (idlwave-shell-reset 'hidden)
2547 (idlwave-shell-send-command idlwave-shell-command-line-to-execute
2548 '(idlwave-shell-redisplay 'hide)))
2549
2550 (defun idlwave-shell-save-and-run ()
2551 "Save file and run it in IDL.
2552 Runs `save-buffer' and sends a '.RUN' command for the associated file to IDL.
2553 When called from the shell buffer, re-run the file which was last handled by
2554 one of the save-and-.. commands."
2555 (interactive)
2556 (idlwave-shell-save-and-action 'run))
2557
2558 (defun idlwave-shell-save-and-compile ()
2559 "Save file and run it in IDL.
2560 Runs `save-buffer' and sends '.COMPILE' command for the associated file to IDL.
2561 When called from the shell buffer, re-compile the file which was last handled by
2562 one of the save-and-.. commands."
2563 (interactive)
2564 (idlwave-shell-save-and-action 'compile))
2565
2566 (defun idlwave-shell-save-and-batch ()
2567 "Save file and batch it in IDL.
2568 Runs `save-buffer' and sends a '@file' command for the associated file to IDL.
2569 When called from the shell buffer, re-batch the file which was last handled by
2570 one of the save-and-.. commands."
2571 (interactive)
2572 (idlwave-shell-save-and-action 'batch))
2573
2574 (defun idlwave-shell-save-and-action (action)
2575 "Save file and compile it in IDL.
2576 Runs `save-buffer' and sends a '.RUN' command for the associated file to IDL.
2577 When called from the shell buffer, re-compile the file which was last
2578 handled by this command."
2579 ;; Remove the stop overlay.
2580 (if idlwave-shell-stop-line-overlay
2581 (delete-overlay idlwave-shell-stop-line-overlay))
2582 (setq idlwave-shell-is-stopped nil)
2583 (setq overlay-arrow-string nil)
2584 (let (buf)
2585 (cond
2586 ((eq major-mode 'idlwave-mode)
2587 (save-buffer)
2588 (setq idlwave-shell-last-save-and-action-file (buffer-file-name)))
2589 (idlwave-shell-last-save-and-action-file
2590 (if (setq buf (idlwave-get-buffer-visiting
2591 idlwave-shell-last-save-and-action-file))
2592 (save-excursion
2593 (set-buffer buf)
2594 (save-buffer))))
2595 (t (setq idlwave-shell-last-save-and-action-file
2596 (read-file-name "File: ")))))
2597 (if (file-regular-p idlwave-shell-last-save-and-action-file)
2598 (progn
2599 (idlwave-shell-send-command
2600 (concat (cond ((eq action 'run) ".run ")
2601 ((eq action 'compile) ".compile ")
2602 ((eq action 'batch) "@")
2603 (t (error "Unknown action %s" action)))
2604 idlwave-shell-last-save-and-action-file)
2605 'idlwave-shell-maybe-update-routine-info
2606 nil)
2607 (idlwave-shell-bp-query))
2608 (let ((msg (format "No such file %s"
2609 idlwave-shell-last-save-and-action-file)))
2610 (setq idlwave-shell-last-save-and-action-file nil)
2611 (error msg))))
2612
2613 (defun idlwave-shell-maybe-update-routine-info ()
2614 "Update the routine info if the shell is not stopped at an error."
2615 (if (and (not idlwave-shell-is-stopped)
2616 (or (eq t idlwave-auto-routine-info-updates)
2617 (memq 'compile-buffer idlwave-auto-routine-info-updates))
2618 idlwave-query-shell-for-routine-info
2619 idlwave-routines)
2620 (idlwave-shell-update-routine-info t)))
2621
2622 (defvar idlwave-shell-sources-query "help,/source"
2623 "IDL command to obtain source files for compiled procedures.")
2624
2625 (defvar idlwave-shell-sources-alist nil
2626 "Alist of IDL procedure names and compiled source files.
2627 Elements of the alist have the form:
2628
2629 (module name . (source-file-truename idlwave-internal-filename)).")
2630
2631 (defun idlwave-shell-sources-query ()
2632 "Determine source files for IDL compiled procedures.
2633 Queries IDL using the string in `idlwave-shell-sources-query'."
2634 (interactive)
2635 (idlwave-shell-send-command idlwave-shell-sources-query
2636 'idlwave-shell-sources-filter
2637 'hide))
2638
2639 (defun idlwave-shell-sources-filter ()
2640 "Get source files from `idlwave-shell-sources-query' output.
2641 Create `idlwave-shell-sources-alist' consisting of
2642 list elements of the form:
2643 (module name . (source-file-truename idlwave-internal-filename))."
2644 (save-excursion
2645 (set-buffer (get-buffer-create idlwave-shell-bp-buffer))
2646 (erase-buffer)
2647 (insert idlwave-shell-command-output)
2648 (goto-char (point-min))
2649 (let (cpro cfun)
2650 (if (re-search-forward "Compiled Procedures:" nil t)
2651 (progn
2652 (forward-line) ; Skip $MAIN$
2653 (setq cpro (point))))
2654 (if (re-search-forward "Compiled Functions:" nil t)
2655 (progn
2656 (setq cfun (point))
2657 (setq idlwave-shell-sources-alist
2658 (append
2659 ;; compiled procedures
2660 (progn
2661 (beginning-of-line)
2662 (narrow-to-region cpro (point))
2663 (goto-char (point-min))
2664 (idlwave-shell-sources-grep))
2665 ;; compiled functions
2666 (progn
2667 (widen)
2668 (goto-char cfun)
2669 (idlwave-shell-sources-grep)))))))))
2670
2671 (defun idlwave-shell-sources-grep ()
2672 (save-excursion
2673 (let ((al (list nil)))
2674 (while (and
2675 (not (progn (forward-line) (eobp)))
2676 (re-search-forward
2677 "\\s-*\\(\\S-+\\)\\s-+\\(\\S-+\\)" nil t))
2678 (nconc al
2679 (list
2680 (cons
2681 (buffer-substring ; name
2682 (match-beginning 1) (match-end 1))
2683 (let ((internal-filename
2684 (buffer-substring ; source
2685 (match-beginning 2) (match-end 2))))
2686 (list
2687 (idlwave-shell-file-name internal-filename)
2688 internal-filename))
2689 ))))
2690 (cdr al))))
2691
2692
2693 (defun idlwave-shell-clear-all-bp ()
2694 "Remove all breakpoints in IDL."
2695 (interactive)
2696 (idlwave-shell-send-command
2697 idlwave-shell-bp-query
2698 '(progn
2699 (idlwave-shell-filter-bp)
2700 (mapcar 'idlwave-shell-clear-bp idlwave-shell-bp-alist))
2701 'hide))
2702
2703 (defun idlwave-shell-list-all-bp ()
2704 "List all breakpoints in IDL."
2705 (interactive)
2706 (idlwave-shell-send-command
2707 idlwave-shell-bp-query))
2708
2709 (defvar idlwave-shell-error-last 0
2710 "Position of last syntax error in `idlwave-shell-error-buffer'.")
2711
2712 (defun idlwave-shell-goto-next-error ()
2713 "Move point to next IDL syntax error."
2714 (interactive)
2715 (let (frame col)
2716 (save-excursion
2717 (set-buffer idlwave-shell-error-buffer)
2718 (goto-char idlwave-shell-error-last)
2719 (if (or (re-search-forward idlwave-shell-syntax-error nil t)
2720 (re-search-forward idlwave-shell-other-error nil t))
2721 (progn
2722 (setq frame
2723 (list
2724 (save-match-data
2725 (idlwave-shell-file-name
2726 (buffer-substring (match-beginning 1) (match-end 1))))
2727 (string-to-int
2728 (buffer-substring (match-beginning 2)
2729 (match-end 2)))))
2730 ;; Try to find the column of the error
2731 (save-excursion
2732 (setq col
2733 (if (re-search-backward "\\^" nil t)
2734 (current-column)
2735 0)))))
2736 (setq idlwave-shell-error-last (point)))
2737 (if frame
2738 (progn
2739 (idlwave-shell-display-line frame col))
2740 (beep)
2741 (message "No more errors."))))
2742
2743 (defun idlwave-shell-file-name (name)
2744 "If `idlwave-shell-use-truename' is non-nil, convert file name to true name.
2745 Otherwise, just expand the file name."
2746 (let ((def-dir (if (eq major-mode 'idlwave-shell-mode)
2747 default-directory
2748 idlwave-shell-default-directory)))
2749 (if idlwave-shell-use-truename
2750 (file-truename name def-dir)
2751 (expand-file-name name def-dir))))
2752
2753
2754 ;; Keybindings --------------------------------------------------------------
2755
2756 (defvar idlwave-shell-mode-map (copy-keymap comint-mode-map)
2757 "Keymap for idlwave-mode.")
2758 (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap))
2759 (fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map)
2760
2761 ;(define-key idlwave-shell-mode-map "\M-?" 'comint-dynamic-list-completions)
2762 ;(define-key idlwave-shell-mode-map "\t" 'comint-dynamic-complete)
2763 (define-key idlwave-shell-mode-map "\t" 'idlwave-shell-complete)
2764 (define-key idlwave-shell-mode-map "\M-\t" 'idlwave-shell-complete)
2765 (define-key idlwave-shell-mode-map "\C-c\C-s" 'idlwave-shell)
2766 (define-key idlwave-shell-mode-map "\C-c?" 'idlwave-routine-info)
2767 (define-key idlwave-shell-mode-map "\M-?" 'idlwave-context-help)
2768 (define-key idlwave-shell-mode-map "\C-c\C-i" 'idlwave-update-routine-info)
2769 (define-key idlwave-shell-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop)
2770 (define-key idlwave-shell-mode-map "\C-c\C-x" 'idlwave-shell-send-char)
2771 (define-key idlwave-shell-mode-map "\C-c=" 'idlwave-resolve)
2772 (define-key idlwave-shell-mode-map "\C-c\C-v" 'idlwave-find-module)
2773 (define-key idlwave-shell-mode-map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers)
2774 (define-key idlwave-shell-mode-map idlwave-shell-prefix-key
2775 'idlwave-shell-debug-map)
2776 (define-key idlwave-shell-mode-map [(up)] 'idlwave-shell-up-or-history)
2777 (define-key idlwave-shell-mode-map [(down)] 'idlwave-shell-down-or-history)
2778 (define-key idlwave-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop)
2779 (define-key idlwave-mode-map "\C-c\C-x" 'idlwave-shell-send-char)
2780 (define-key idlwave-mode-map
2781 (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
2782 'idlwave-shell-mouse-print)
2783 (define-key idlwave-mode-map
2784 (if (featurep 'xemacs) [(shift control button2)] [(shift control mouse-2)])
2785 'idlwave-shell-mouse-help)
2786 (define-key idlwave-shell-mode-map
2787 (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
2788 'idlwave-shell-mouse-print)
2789 (define-key idlwave-shell-mode-map
2790 (if (featurep 'xemacs) [(shift control button2)] [(shift control mouse-2)])
2791 'idlwave-shell-mouse-help)
2792 (define-key idlwave-shell-mode-map
2793 (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])
2794 'idlwave-mouse-context-help)
2795
2796
2797 ;; The following set of bindings is used to bind the debugging keys.
2798 ;; If `idlwave-shell-activate-prefix-keybindings' is non-nil, the first key
2799 ;; in the list gets bound the C-c C-d prefix map.
2800 ;; If `idlwave-shell-debug-modifiers' is non-nil, the second key
2801 ;; in the list gets bound with the specified modifiers in both
2802 ;; `idlwave-mode-map' and `idlwave-shell-mode-map'.
2803
2804 ;; Used keys: abcdef hi klmnopqrs u wxyz
2805 ;; Unused keys: g j t v
2806 (let* ((specs
2807 '(([(control ?b)] ?b idlwave-shell-break-here)
2808 ([(control ?i)] ?i idlwave-shell-break-in)
2809 ([(control ?d)] ?d idlwave-shell-clear-current-bp)
2810 ([(control ?a)] ?a idlwave-shell-clear-all-bp)
2811 ([(control ?s)] ?s idlwave-shell-step)
2812 ([(control ?n)] ?n idlwave-shell-stepover)
2813 ([(control ?k)] ?k idlwave-shell-skip)
2814 ([(control ?u)] ?u idlwave-shell-up)
2815 ([(control ?o)] ?o idlwave-shell-out)
2816 ([(control ?m)] ?m idlwave-shell-return)
2817 ([(control ?h)] ?h idlwave-shell-to-here)
2818 ([(control ?r)] ?r idlwave-shell-cont)
2819 ([(control ?y)] ?y idlwave-shell-execute-default-command-line)
2820 ([(control ?z)] ?z idlwave-shell-reset)
2821 ([(control ?q)] ?q idlwave-shell-quit)
2822 ([(control ?p)] ?p idlwave-shell-print)
2823 ([(??)] ?? idlwave-shell-help-expression)
2824 ([(control ?c)] ?c idlwave-shell-save-and-run)
2825 ([( ?@)] ?@ idlwave-shell-save-and-batch)
2826 ([(control ?x)] ?x idlwave-shell-goto-next-error)
2827 ([(control ?e)] ?e idlwave-shell-run-region)
2828 ([(control ?w)] ?w idlwave-shell-resync-dirs)
2829 ([(control ?l)] ?l idlwave-shell-redisplay)
2830 ([(control ?t)] ?t idlwave-shell-toggle-toolbar)
2831 ([(control up)] up idlwave-shell-stack-up)
2832 ([(control down)] down idlwave-shell-stack-down)
2833 ([(control ?f)] ?f idlwave-shell-window)))
2834 (mod (cond ((and idlwave-shell-debug-modifiers
2835 (listp idlwave-shell-debug-modifiers)
2836 (not (equal '() idlwave-shell-debug-modifiers)))
2837 idlwave-shell-debug-modifiers)
2838 (idlwave-shell-activate-alt-keybindings
2839 '(alt))))
2840 (shift (memq 'shift mod))
2841 (mod-noshift (delete 'shift (copy-sequence mod)))
2842 s k1 c2 k2 cmd)
2843 (while (setq s (pop specs))
2844 (setq k1 (nth 0 s)
2845 c2 (nth 1 s)
2846 cmd (nth 2 s))
2847 (when idlwave-shell-activate-prefix-keybindings
2848 (and k1 (define-key idlwave-shell-mode-prefix-map k1 cmd)))
2849 (when (and mod window-system)
2850 (if (char-or-string-p c2)
2851 (setq k2 (vector (append mod-noshift
2852 (list (if shift (upcase c2) c2)))))
2853 (setq k2 (vector (append mod (list c2)))))
2854 (define-key idlwave-mode-map k2 cmd)
2855 (define-key idlwave-shell-mode-map k2 cmd))))
2856
2857 ;; Enter the prefix map at the two places.
2858 (fset 'idlwave-debug-map idlwave-shell-mode-prefix-map)
2859 (fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map)
2860
2861 ;; The Menus --------------------------------------------------------------
2862
2863 (defvar idlwave-shell-menu-def
2864 '("Debug"
2865 ["Save and .RUN" idlwave-shell-save-and-run
2866 (or (eq major-mode 'idlwave-mode)
2867 idlwave-shell-last-save-and-action-file)]
2868 ["Save and .COMPILE" idlwave-shell-save-and-compile
2869 (or (eq major-mode 'idlwave-mode)
2870 idlwave-shell-last-save-and-action-file)]
2871 ["Save and @Batch" idlwave-shell-save-and-batch
2872 (or (eq major-mode 'idlwave-mode)
2873 idlwave-shell-last-save-and-action-file)]
2874 ["Goto Next Error" idlwave-shell-goto-next-error t]
2875 "--"
2876 ["Execute Default Cmd" idlwave-shell-execute-default-command-line t]
2877 ["Edit Default Cmd" idlwave-shell-edit-default-command-line t]
2878 "--"
2879 ["Set Breakpoint" idlwave-shell-break-here
2880 (eq major-mode 'idlwave-mode)]
2881 ["Break in Module" idlwave-shell-break-in t]
2882 ["Clear Breakpoint" idlwave-shell-clear-current-bp t]
2883 ["Clear All Breakpoints" idlwave-shell-clear-all-bp t]
2884 ["List All Breakpoints" idlwave-shell-list-all-bp t]
2885 "--"
2886 ["Step (into)" idlwave-shell-step t]
2887 ["Step (over)" idlwave-shell-stepover t]
2888 ["Skip One Statement" idlwave-shell-skip t]
2889 ["Continue" idlwave-shell-cont t]
2890 ("Continue to"
2891 ["End of Block" idlwave-shell-up t]
2892 ["End of Subprog" idlwave-shell-return t]
2893 ["End of Subprog+1" idlwave-shell-out t]
2894 ["Here (Cursor Line)" idlwave-shell-to-here
2895 (eq major-mode 'idlwave-mode)])
2896 "--"
2897 ["Print expression" idlwave-shell-print t]
2898 ["Help on expression" idlwave-shell-help-expression t]
2899 ["Evaluate Region" idlwave-shell-evaluate-region
2900 (eq major-mode 'idlwave-mode)]
2901 ["Run Region" idlwave-shell-run-region (eq major-mode 'idlwave-mode)]
2902 "--"
2903 ["Redisplay" idlwave-shell-redisplay t]
2904 ["Stack Up" idlwave-shell-stack-up t]
2905 ["Stack Down" idlwave-shell-stack-down t]
2906 "--"
2907 ["Update Working Dir" idlwave-shell-resync-dirs t]
2908 ["Reset IDL" idlwave-shell-reset t]
2909 "--"
2910 ["Toggle Toolbar" idlwave-shell-toggle-toolbar t]
2911 ["Exit IDL" idlwave-shell-quit t]))
2912
2913 (setq idlwave-shell-menu-def
2914 '("Debug"
2915 ("Compile & Run"
2916 ["Save and .RUN" idlwave-shell-save-and-run
2917 (or (eq major-mode 'idlwave-mode)
2918 idlwave-shell-last-save-and-action-file)]
2919 ["Save and .COMPILE" idlwave-shell-save-and-compile
2920 (or (eq major-mode 'idlwave-mode)
2921 idlwave-shell-last-save-and-action-file)]
2922 ["Save and @Batch" idlwave-shell-save-and-batch
2923 (or (eq major-mode 'idlwave-mode)
2924 idlwave-shell-last-save-and-action-file)]
2925 ["Goto Next Error" idlwave-shell-goto-next-error t]
2926 "--"
2927 ["Run Region" idlwave-shell-run-region (eq major-mode 'idlwave-mode)]
2928 "--"
2929 ["Execute Default Cmd" idlwave-shell-execute-default-command-line t]
2930 ["Edit Default Cmd" idlwave-shell-edit-default-command-line t])
2931 ("Breakpoints"
2932 ["Set Breakpoint" idlwave-shell-break-here
2933 (eq major-mode 'idlwave-mode)]
2934 ["Break in Module" idlwave-shell-break-in t]
2935 ["Clear Breakpoint" idlwave-shell-clear-current-bp t]
2936 ["Clear All Breakpoints" idlwave-shell-clear-all-bp t]
2937 ["List All Breakpoints" idlwave-shell-list-all-bp t])
2938 ("Continue/Step"
2939 ["Step (into)" idlwave-shell-step t]
2940 ["Step (over)" idlwave-shell-stepover t]
2941 ["Skip One Statement" idlwave-shell-skip t]
2942 ["Continue" idlwave-shell-cont t]
2943 ["... to End of Block" idlwave-shell-up t]
2944 ["... to End of Subprog" idlwave-shell-return t]
2945 ["... to End of Subprog+1" idlwave-shell-out t]
2946 ["... to Here (Cursor Line)" idlwave-shell-to-here
2947 (eq major-mode 'idlwave-mode)])
2948 ("Print Expression"
2949 ["Print expression" idlwave-shell-print t]
2950 ["Help on expression" idlwave-shell-help-expression t]
2951 ["Evaluate Region" idlwave-shell-evaluate-region
2952 (eq major-mode 'idlwave-mode)]
2953 "--"
2954 ["Redisplay" idlwave-shell-redisplay t]
2955 ["Stack Up" idlwave-shell-stack-up t]
2956 ["Stack Down" idlwave-shell-stack-down t])
2957 ("Input Mode"
2958 ["Send one char" idlwave-shell-send-char t]
2959 ["Temporary Character Mode" idlwave-shell-char-mode-loop t]
2960 "--"
2961 ["Use Input Mode Magic"
2962 (setq idlwave-shell-use-input-mode-magic
2963 (not idlwave-shell-use-input-mode-magic))
2964 :style toggle :selected idlwave-shell-use-input-mode-magic])
2965 "--"
2966 ["Update Working Dir" idlwave-shell-resync-dirs t]
2967 ["Reset IDL" idlwave-shell-reset t]
2968 "--"
2969 ["Toggle Toolbar" idlwave-shell-toggle-toolbar t]
2970 ["Exit IDL" idlwave-shell-quit t]))
2971
2972 (if (or (featurep 'easymenu) (load "easymenu" t))
2973 (progn
2974 (easy-menu-define
2975 idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"
2976 idlwave-shell-menu-def)
2977 (easy-menu-define
2978 idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"
2979 idlwave-shell-menu-def)
2980 (save-excursion
2981 (mapcar (lambda (buf)
2982 (set-buffer buf)
2983 (if (eq major-mode 'idlwave-mode)
2984 (progn
2985 (easy-menu-remove idlwave-mode-debug-menu)
2986 (easy-menu-add idlwave-mode-debug-menu))))
2987 (buffer-list)))))
2988
2989 ;; The Breakpoint Glyph -------------------------------------------------------
2990
2991 (defvar idlwave-shell-bp-glyph nil
2992 "The glyph to mark breakpoint lines in the source code.")
2993
2994 (let ((image-string "/* XPM */
2995 static char * file[] = {
2996 \"14 12 3 1\",
2997 \" c #FFFFFFFFFFFF s backgroundColor\",
2998 \". c #4B4B4B4B4B4B\",
2999 \"R c #FFFF00000000\",
3000 \" \",
3001 \" \",
3002 \" RRRR \",
3003 \" RRRRRR \",
3004 \" RRRRRRRR \",
3005 \" RRRRRRRR \",
3006 \" RRRRRRRR \",
3007 \" RRRRRRRR \",
3008 \" RRRRRR \",
3009 \" RRRR \",
3010 \" \",
3011 \" \"};"))
3012
3013 (setq idlwave-shell-bp-glyph
3014 (cond ((and (featurep 'xemacs)
3015 (featurep 'xpm))
3016 (make-glyph image-string))
3017 ((and (not (featurep 'xemacs))
3018 (fboundp 'image-type-available-p)
3019 (image-type-available-p 'xpm))
3020 (list 'image :type 'xpm :data image-string))
3021 (t nil))))
3022
3023 (provide 'idlw-shell)
3024 (provide 'idlwave-shell)
3025
3026 ;;; Load the toolbar when wanted by the user.
3027
3028 (autoload 'idlwave-toolbar-toggle "idlw-toolbar"
3029 "Toggle the IDLWAVE toolbar")
3030 (autoload 'idlwave-toolbar-add-everywhere "idlw-toolbar"
3031 "Add IDLWAVE toolbar")
3032 (defun idlwave-shell-toggle-toolbar ()
3033 "Toggle the display of the debugging toolbar."
3034 (interactive)
3035 (idlwave-toolbar-toggle))
3036
3037 (if idlwave-shell-use-toolbar
3038 (add-hook 'idlwave-shell-mode-hook 'idlwave-toolbar-add-everywhere))
3039
3040 ;;; idlw-shell.el ends here