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