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