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