Fix bug #15155 with ignoring face remapping for strings from prefix properties.
[emacs.git] / lisp / progmodes / idlw-shell.el
blob5aad4aaa15f55eb692be5e0b880439197cc46fd8
1 ;; idlw-shell.el --- run IDL as an inferior process of Emacs.
3 ;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
5 ;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
6 ;; Carsten Dominik <dominik@astro.uva.nl>
7 ;; Chris Chase <chase@att.com>
8 ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>
9 ;; Keywords: processes
10 ;; Package: idlwave
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;;; Commentary:
29 ;; This mode is for IDL version 5 or later. It should work on
30 ;; Emacs>20.3 or XEmacs>20.4.
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.
39 ;; Documentation should be available online with `M-x idlwave-info'.
41 ;; New versions of IDLWAVE, documentation, and more information
42 ;; available from:
43 ;; http://idlwave.org
45 ;; INSTALLATION:
46 ;; =============
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 init file:
52 ;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t)
55 ;; SOURCE
56 ;; ======
58 ;; The newest version of this file can be found on the maintainers
59 ;; web site.
61 ;; http://idlwave.org
63 ;; DOCUMENTATION
64 ;; =============
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)
71 ;; KNOWN PROBLEMS
72 ;; ==============
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.
80 ;; CUSTOMIZATION VARIABLES
81 ;; =======================
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'.
87 ;;--------------------------------------------------------------------------
90 ;;; Code:
92 (require 'comint)
93 (require 'idlwave)
95 (eval-when-compile (require 'cl))
97 (defvar idlwave-shell-have-new-custom nil)
99 ;;; Customizations: idlwave-shell group
101 ;; General/Misc. customizations
102 (defgroup idlwave-shell-general-setup nil
103 "General setup of the Shell interaction for IDLWAVE/Shell."
104 :prefix "idlwave-shell"
105 :group 'idlwave)
107 (defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> "
108 "Regexp to match IDL prompt at beginning of a line.
109 For example, \"^\r?IDL> \" or \"^\r?WAVE> \".
110 The \"^\r?\" is needed, to indicate the beginning of the line, with
111 optional return character (which IDL seems to output randomly).
112 This variable is used to initialize `comint-prompt-regexp' in the
113 process buffer."
114 :group 'idlwave-shell-general-setup
115 :type 'regexp)
117 (defcustom idlwave-shell-process-name "idl"
118 "Name to be associated with the IDL process. The buffer for the
119 process output is made by surrounding this name with `*'s."
120 :group 'idlwave-shell-general-setup
121 :type 'string)
123 ;; (defcustom idlwave-shell-automatic-start...) See idlwave.el
125 (defcustom idlwave-shell-use-dedicated-window nil
126 "Non-nil means, never replace the shell frame with another buffer."
127 :group 'idlwave-shell-general-setup
128 :type 'boolean)
130 (defcustom idlwave-shell-use-dedicated-frame nil
131 "Non-nil means, IDLWAVE should use a special frame to display shell buffer."
132 :group 'idlwave-shell-general-setup
133 :type 'boolean)
135 (defcustom idlwave-shell-frame-parameters
136 '((height . 30) (unsplittable . nil))
137 "The frame parameters for a dedicated idlwave-shell frame.
138 See also `idlwave-shell-use-dedicated-frame'.
139 The default makes the frame splittable, so that completion works correctly."
140 :group 'idlwave-shell-general-setup
141 :type '(repeat
142 (cons symbol sexp)))
144 (defcustom idlwave-shell-raise-frame t
145 "Non-nil means, `idlwave-shell' raises the frame showing the shell window."
146 :group 'idlwave-shell-general-setup
147 :type 'boolean)
149 (defcustom idlwave-shell-arrows-do-history t
150 "Non-nil means UP and DOWN arrows move through command history.
151 This variable can have 3 values:
152 nil Arrows just move the cursor
153 t Arrows force the cursor back to the current command line and
154 walk the history
155 'cmdline When the cursor is in the current command line, arrows walk the
156 history. Everywhere else in the buffer, arrows move the cursor."
157 :group 'idlwave-shell-general-setup
158 :type '(choice
159 (const :tag "never" nil)
160 (const :tag "everywhere" t)
161 (const :tag "in command line only" cmdline)))
163 ;; FIXME: add comint-input-ring-size?
165 (defcustom idlwave-shell-use-toolbar t
166 "Non-nil means, use the debugging toolbar in all IDL related buffers.
167 Starting the shell will then add the toolbar to all idlwave-mode buffers.
168 Exiting the shell will removed everywhere.
169 Available on XEmacs and on Emacs 21.x or later.
170 At any time you can toggle the display of the toolbar with
171 `C-c C-d C-t' (`idlwave-shell-toggle-toolbar')."
172 :group 'idlwave-shell-general-setup
173 :type 'boolean)
175 (defcustom idlwave-shell-temp-pro-prefix "/tmp/idltemp"
176 "The prefix for temporary IDL files used when compiling regions.
177 It should be an absolute pathname.
178 The full temporary file name is obtained by using `make-temp-file'
179 so that the name will be unique among multiple Emacs processes."
180 :group 'idlwave-shell-general-setup
181 :type 'string)
183 (defcustom idlwave-shell-prefix-key "\C-c\C-d"
184 "The prefix key for the debugging map `idlwave-shell-mode-prefix-map'.
185 This variable must already be set when idlwave-shell.el is loaded.
186 Setting it in the mode-hook is too late."
187 :group 'idlwave-shell-general-setup
188 :type 'string)
190 (defcustom idlwave-shell-activate-prefix-keybindings t
191 "Non-nil means, the debug commands will be bound to the prefix key.
192 The prefix key itself is given in the option `idlwave-shell-prefix-key'.
193 So by default setting a breakpoint will be on C-c C-d C-b."
194 :group 'idlwave-shell-general-setup
195 :type 'boolean)
197 (defcustom idlwave-shell-automatic-electric-debug 'breakpoint
198 "Enter the electric-debug minor mode automatically.
199 This occurs at a breakpoint or any other halt. The mode is exited
200 upon return to the main level. Can be set to 'breakpoint to enter
201 electric debug mode only when breakpoints are tripped."
202 :group 'idlwave-shell-general-setup
203 :type '(choice
204 (const :tag "never" nil)
205 (const :tag "always" t)
206 (const :tag "for breakpoints only" breakpoint)))
208 (defcustom idlwave-shell-electric-zap-to-file t
209 "When entering electric debug mode, select the window displaying the
210 file at which point is stopped. This takes point away from the shell
211 window, but is useful for stepping, etc."
212 :group 'idlwave-shell-general-setup
213 :type 'boolean)
215 ;; (defcustom idlwave-shell-debug-modifiers... See idlwave.el
217 (defcustom idlwave-shell-use-truename nil
218 "Non-nil means, use `file-truename' when looking for buffers.
219 If this variable is non-nil, Emacs will use the function `file-truename' to
220 resolve symbolic links in the file paths printed by e.g., STOP commands.
221 This means, unvisited files will be loaded under their truename.
222 However, when a file is already visited under a different name, IDLWAVE will
223 reuse that buffer.
224 This option was once introduced in order to avoid multiple buffers visiting
225 the same file. However, IDLWAVE no longer makes this mistake, so it is safe
226 to set this option to nil."
227 :group 'idlwave-shell-general-setup
228 :type 'boolean)
230 (defcustom idlwave-shell-file-name-chars "~/A-Za-z0-9+:_.$#%={}\\- "
231 "The characters allowed in file names, as a string.
232 Used for file name completion. Must not contain `'', `,' and `\"'
233 because these are used as separators by IDL."
234 :group 'idlwave-shell-general-setup
235 :type 'string)
237 (defcustom idlwave-shell-mode-hook '()
238 "Hook for customizing `idlwave-shell-mode'."
239 :group 'idlwave-shell-general-setup
240 :type 'hook)
242 (defcustom idlwave-shell-graphics-window-size '(500 400)
243 "Size of IDL graphics windows popped up by special IDLWAVE command.
244 The command is `C-c C-d C-f' and accepts as a prefix the window nr.
245 A command like `WINDOW,N,xsize=XX,ysize=YY' is sent to IDL."
246 :group 'idlwave-shell-general-setup
247 :type '(list
248 (integer :tag "x size")
249 (integer :tag "y size")))
252 ;; Commands Sent to Shell... etc.
253 (defgroup idlwave-shell-command-setup nil
254 "Setup for command parameters of the Shell interaction for IDLWAVE."
255 :prefix "idlwave-shell"
256 :group 'idlwave)
258 (defcustom idlwave-shell-initial-commands "!more=0 & defsysv,'!ERROR_STATE',EXISTS=__e & if __e then begin & !ERROR_STATE.MSG_PREFIX=\"% \" & delvar,__e & endif"
259 "Initial commands, separated by newlines, to send to IDL.
260 This string is sent to the IDL process by `idlwave-shell-mode' which is
261 invoked by `idlwave-shell'."
262 :group 'idlwave-shell-command-setup
263 :type 'string)
265 (defcustom idlwave-shell-save-command-history t
266 "Non-nil means preserve command history between sessions.
267 The file `idlwave-shell-command-history-file' is used to save and restore
268 the history."
269 :group 'idlwave-shell-command-setup
270 :type 'boolean)
272 (defcustom idlwave-shell-command-history-file "idlwhist"
273 "The file in which the command history of the idlwave shell is saved.
274 In order to change the size of the history, see the variable
275 `comint-input-ring-size'.
276 The history is only saved if the variable `idlwave-shell-save-command-history'
277 is non-nil."
278 :group 'idlwave-shell-command-setup
279 :type 'file)
281 (defcustom idlwave-shell-show-commands
282 '(run misc breakpoint)
283 "A list of command types to show output from in the shell.
284 Possibilities are 'run, 'debug, 'breakpoint, and 'misc. Unselected
285 types are not displayed in the shell. The type 'everything causes all
286 the copious shell traffic to be displayed."
287 :group 'idlwave-shell-command-setup
288 :type '(choice
289 (const everything)
290 (set :tag "Checklist" :greedy t
291 (const :tag "All .run and .compile commands" run)
292 (const :tag "All breakpoint commands" breakpoint)
293 (const :tag "All debug and stepping commands" debug)
294 (const :tag "Close, window, retall, etc. commands" misc))))
296 (defcustom idlwave-shell-max-print-length 200
297 "Maximum number of array elements to print when examining."
298 :group 'idlwave-shell-command-setup
299 :type 'integer)
301 (defcustom idlwave-shell-examine-alist
302 `(("Print" . ,(concat "idlwave_print_safe,___,"
303 (number-to-string
304 idlwave-shell-max-print-length)))
305 ("Help" . "help,___")
306 ("Structure Help" . "help,___,/STRUCTURE")
307 ("Dimensions" . "print,size(___,/DIMENSIONS)")
308 ("Type" . "print,size(___,/TNAME)")
309 ("N_Elements" . "print,n_elements(___)")
310 ("All Size Info" . "help,(__IWsz__=size(___,/STRUCTURE)),/STRUCTURE & print,__IWsz__.DIMENSIONS")
311 ("Ptr Valid" . "print,ptr_valid(___)")
312 ("Arg Present" . "print,arg_present(___)")
313 ("Widget Valid" . "print,widget_info(___,/VALID)")
314 ("Widget Geometry" . "help,widget_info(___,/GEOMETRY)"))
315 "Alist of special examine commands for popup selection.
316 The keys are used in the selection popup created by
317 `idlwave-shell-examine-select', and the corresponding value is sent as
318 a command to the shell, with special sequence `___' replaced by the
319 expression being examined."
320 :group 'idlwave-shell-command-setup
321 :type '(repeat
322 (cons
323 (string :tag "Label ")
324 (string :tag "Command"))))
326 (defcustom idlwave-shell-separate-examine-output t
327 "Non-nil means, put output of examine commands in their own buffer."
328 :group 'idlwave-shell-command-setup
329 :type 'boolean)
331 (defcustom idlwave-shell-comint-settings
332 '((comint-scroll-to-bottom-on-input . t)
333 (comint-scroll-to-bottom-on-output . t)
334 (comint-scroll-show-maximum-output . nil)
335 (comint-prompt-read-only . t))
337 "Alist of special settings for the comint variables in the IDLWAVE Shell.
338 Each entry is a cons cell with the name of a variable and a value.
339 The function `idlwave-shell-mode' will make local variables out of each entry.
340 Changes to this variable will only be active when the shell buffer is
341 newly created."
342 :group 'idlwave-shell-command-setup
343 :type '(repeat
344 (cons variable sexp)))
346 (defcustom idlwave-shell-query-for-class t
347 "Non-nil means query the shell for object class on object completions."
348 :group 'idlwave-shell-command-setup
349 :type 'boolean)
351 (defcustom idlwave-shell-use-input-mode-magic nil
352 "Non-nil means, IDLWAVE should check for input mode spells in output.
353 The spells are strings printed by your IDL program and matched
354 by the regular expressions in `idlwave-shell-input-mode-spells'.
355 When these expressions match, IDLWAVE switches to character input mode and
356 back, respectively. See `idlwave-shell-input-mode-spells' for details."
357 :group 'idlwave-shell-command-setup
358 :type 'boolean)
360 (defcustom idlwave-shell-input-mode-spells
361 '("^<onechar>$" "^<chars>$" "^</chars>$")
362 "The three regular expressions which match the magic spells for input modes.
364 When the first regexp matches in the output stream of IDL, IDLWAVE
365 prompts for a single character and sends it immediately to IDL, similar
366 to the command \\[idlwave-shell-send-char].
368 When the second regexp matches, IDLWAVE switches to a blocking
369 single-character input mode. This is the same mode which can be entered
370 manually with \\[idlwave-shell-char-mode-loop].
371 This input mode exits when the third regexp matches in the output,
372 or when the IDL prompt is encountered.
374 The variable `idlwave-shell-use-input-mode-magic' must be non-nil to enable
375 scanning for these expressions. If the IDL program produces lots of
376 output, shell operation may be slowed down.
378 This mechanism is useful for correct interaction with the IDL function
379 GET_KBRD, because in normal operation IDLWAVE only sends \\n terminated
380 strings. Here is some example code which makes use of the default spells.
382 print,'<chars>' ; Make IDLWAVE switch to character mode
383 REPEAT BEGIN
384 A = GET_KBRD(1)
385 PRINT, BYTE(A)
386 ENDREP UNTIL A EQ 'q'
387 print,'</chars>' ; Make IDLWAVE switch back to line mode
389 print,'Quit the program, y or n?'
390 print,'<onechar>' ; Ask IDLWAVE to send one character
391 answer = GET_KBRD(1)
393 Since the IDLWAVE shell defines the system variable `!IDLWAVE_VERSION',
394 you could actually check if you are running under Emacs before printing
395 the magic strings. Here is a procedure which uses this.
397 Usage:
398 ======
399 idlwave_char_input ; Make IDLWAVE send one character
400 idlwave_char_input,/on ; Start the loop to send characters
401 idlwave_char_input,/off ; End the loop to send characters
404 pro idlwave_char_input,on=on,off=off
405 ;; Test if we are running under Emacs
406 defsysv,'!idlwave_version',exists=running_emacs
407 if running_emacs then begin
408 if keyword_set(on) then print,'<chars>' $
409 else if keyword_set(off) then print,'</chars>' $
410 else print,'<onechar>'
411 endif
412 end"
413 :group 'idlwave-shell-command-setup
414 :type '(list
415 (regexp :tag "One-char regexp")
416 (regexp :tag "Char-mode regexp")
417 (regexp :tag "Line-mode regexp")))
419 (defcustom idlwave-shell-breakpoint-popup-menu t
420 "If non-nil, provide a menu on mouse-3 on breakpoint lines, and
421 popup help text on the line."
422 :group 'idlwave-shell-command-setup
423 :type 'boolean)
425 (defcustom idlwave-shell-reset-no-prompt nil
426 "If non-nil, skip the yes/no prompt when resetting the IDL session."
427 :group 'idlwave-shell-command-setup
428 :type 'boolean)
430 ;; Breakpoint Overlays etc
431 (defgroup idlwave-shell-highlighting-and-faces nil
432 "Highlighting and faces used by the IDLWAVE Shell mode."
433 :prefix "idlwave-shell"
434 :group 'idlwave)
436 (defcustom idlwave-shell-mark-stop-line t
437 "Non-nil means, mark the source code line where IDL is currently stopped.
438 Value decides about the method which is used to mark the line. Valid values
439 are:
441 nil Do not mark the line
442 'arrow Use the overlay arrow
443 'face Use `idlwave-shell-stop-line-face' to highlight the line.
444 t Use what IDLWAVE thinks is best. Will be a face where possible,
445 otherwise the overlay arrow.
446 The overlay-arrow has the disadvantage to hide the first chars of a line.
447 Since many people do not have the main block of IDL programs indented,
448 a face highlighting may be better.
449 In Emacs 21, the overlay arrow is displayed in a special area and never
450 hides any code, so setting this to 'arrow on Emacs 21 sounds like a good idea."
451 :group 'idlwave-shell-highlighting-and-faces
452 :type '(choice
453 (const :tag "No marking" nil)
454 (const :tag "Use overlay arrow" arrow)
455 (const :tag "Highlight with face" face)
456 (const :tag "Face or arrow." t)))
458 (defcustom idlwave-shell-overlay-arrow ">"
459 "The overlay arrow to display at source lines where execution halts.
460 We use a single character by default, since the main block of IDL procedures
461 often has no indentation. Where possible, IDLWAVE will use overlays to
462 display the stop-lines. The arrow is only used on character-based terminals.
463 See also `idlwave-shell-use-overlay-arrow'."
464 :group 'idlwave-shell-highlighting-and-faces
465 :type 'string)
467 (defcustom idlwave-shell-stop-line-face 'highlight
468 "The face for `idlwave-shell-stop-line-overlay'.
469 Allows you to choose the font, color and other properties for
470 line where IDL is stopped. See also `idlwave-shell-mark-stop-line'."
471 :group 'idlwave-shell-highlighting-and-faces
472 :type 'symbol)
474 (defcustom idlwave-shell-electric-stop-color "Violet"
475 "The color for the default face or overlay arrow when stopped."
476 :group 'idlwave-shell-highlighting-and-faces
477 :type 'string)
479 (defcustom idlwave-shell-electric-stop-line-face
480 (prog1
481 (copy-face 'mode-line 'idlwave-shell-electric-stop-line)
482 (set-face-background 'idlwave-shell-electric-stop-line
483 idlwave-shell-electric-stop-color)
484 (condition-case nil
485 (set-face-foreground 'idlwave-shell-electric-stop-line nil)
486 (error nil)))
487 "The face for `idlwave-shell-stop-line-overlay' when in electric debug mode.
488 Allows you to choose the font, color and other properties for the line
489 where IDL is stopped, when in Electric Debug Mode."
490 :group 'idlwave-shell-highlighting-and-faces
491 :type 'symbol)
493 (defcustom idlwave-shell-mark-breakpoints t
494 "Non-nil means, mark breakpoints in the source files.
495 Valid values are:
496 nil Do not mark breakpoints.
497 'face Highlight line with `idlwave-shell-breakpoint-face'.
498 'glyph Red dot at the beginning of line. If the display does not
499 support glyphs, will use 'face instead.
500 t Glyph when possible, otherwise face (same effect as 'glyph)."
501 :group 'idlwave-shell-highlighting-and-faces
502 :type '(choice
503 (const :tag "No marking" nil)
504 (const :tag "Highlight with face" face)
505 (const :tag "Display glyph (red dot)" glyph)
506 (const :tag "Glyph or face." t)))
508 (defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp
509 "The face for breakpoint lines in the source code.
510 Allows you to choose the font, color and other properties for
511 lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
512 :group 'idlwave-shell-highlighting-and-faces
513 :type 'symbol)
515 (if (not idlwave-shell-have-new-custom)
516 ;; Just copy the underline face to be on the safe side.
517 (copy-face 'underline 'idlwave-shell-bp)
518 ;; We have the new customize - use it to define a customizable face
519 (defface idlwave-shell-bp
520 '((((class color)) (:foreground "Black" :background "Pink"))
521 (t (:underline t)))
522 "Face for highlighting lines with breakpoints."
523 :group 'idlwave-shell-highlighting-and-faces))
525 (defcustom idlwave-shell-disabled-breakpoint-face
526 'idlwave-shell-disabled-bp
527 "The face for disabled breakpoint lines in the source code.
528 Allows you to choose the font, color and other properties for
529 lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
530 :group 'idlwave-shell-highlighting-and-faces
531 :type 'symbol)
533 (if (not idlwave-shell-have-new-custom)
534 ;; Just copy the underline face to be on the safe side.
535 (copy-face 'underline 'idlwave-shell-disabled-bp)
536 ;; We have the new customize - use it to define a customizable face
537 (defface idlwave-shell-disabled-bp
538 '((((class color)) (:foreground "Black" :background "gray"))
539 (t (:underline t)))
540 "Face for highlighting lines with breakpoints."
541 :group 'idlwave-shell-highlighting-and-faces))
544 (defcustom idlwave-shell-expression-face 'secondary-selection
545 "The face for `idlwave-shell-expression-overlay'.
546 Allows you to choose the font, color and other properties for
547 the expression printed by IDL."
548 :group 'idlwave-shell-highlighting-and-faces
549 :type 'symbol)
551 (defcustom idlwave-shell-output-face 'secondary-selection
552 "The face for `idlwave-shell-output-overlay'.
553 Allows you to choose the font, color and other properties for
554 the expression output by IDL."
555 :group 'idlwave-shell-highlighting-and-faces
556 :type 'symbol)
558 ;;; End user customization variables
560 ;;; External variables
561 (defvar comint-last-input-start)
562 (defvar comint-last-input-end)
564 ;; Other variables
565 (defvar idlwave-shell-temp-pro-file nil
566 "Absolute pathname for temporary IDL file for compiling regions")
568 (defvar idlwave-shell-temp-rinfo-save-file nil
569 "Absolute pathname for temporary IDL file save file for routine_info.
570 This is used to speed up the reloading of the routine info procedure
571 before use by the shell.")
573 (defun idlwave-shell-temp-file (type)
574 "Return a temp file, creating it if necessary.
576 TYPE is either 'pro' or 'rinfo', and `idlwave-shell-temp-pro-file' or
577 `idlwave-shell-temp-rinfo-save-file' is set (respectively)."
578 (cond
579 ((eq type 'rinfo)
580 (or idlwave-shell-temp-rinfo-save-file
581 (setq idlwave-shell-temp-rinfo-save-file
582 (idlwave-shell-make-temp-file idlwave-shell-temp-pro-prefix))))
583 ((eq type 'pro)
584 (or idlwave-shell-temp-pro-file
585 (setq idlwave-shell-temp-pro-file
586 (idlwave-shell-make-temp-file idlwave-shell-temp-pro-prefix))))
587 (t (error "Wrong argument (idlwave-shell-temp-file): %s"
588 (symbol-name type)))))
591 (defun idlwave-shell-make-temp-file (prefix)
592 "Create a temporary file."
593 ; Hard coded make-temp-file for Emacs<21
594 (if (fboundp 'make-temp-file)
595 (make-temp-file prefix)
596 (let (file
597 (temp-file-dir (if (boundp 'temporary-file-directory)
598 temporary-file-directory
599 "/tmp")))
600 (while (condition-case ()
601 (progn
602 (setq file
603 (make-temp-name
604 (expand-file-name prefix temp-file-dir)))
605 (if (featurep 'xemacs)
606 (write-region "" nil file nil 'silent nil)
607 (write-region "" nil file nil 'silent nil 'excl))
608 nil)
609 (file-already-exists t))
610 ;; the file was somehow created by someone else between
611 ;; `make-temp-name' and `write-region', let's try again.
612 nil)
613 file)))
616 (defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur"
617 "Command used by `idlwave-shell-resync-dirs' to query IDL for
618 the directory stack.")
620 (defvar idlwave-shell-path-query "print,'PATH:<'+transpose(expand_path(!PATH,/ARRAY))+'>' & print,'SYSDIR:<'+!dir+'>'"
622 "The command which gets !PATH and !DIR info from the shell.")
624 (defvar idlwave-shell-mode-line-info nil
625 "Additional info displayed in the mode line.")
627 (defvar idlwave-shell-default-directory nil
628 "The default directory in the idlwave-shell buffer, of outside use.")
630 (defvar idlwave-shell-last-save-and-action-file nil
631 "The last file which was compiled with `idlwave-shell-save-and-...'.")
633 ;; Highlighting uses overlays. When necessary, require the emulation.
634 (if (not (fboundp 'make-overlay))
635 (condition-case nil
636 (require 'overlay)
637 (error nil)))
639 (defvar idlwave-shell-stop-line-overlay nil
640 "The overlay for where IDL is currently stopped.")
641 (defvar idlwave-shell-is-stopped nil)
642 (defvar idlwave-shell-expression-overlay nil
643 "The overlay for the examined expression.")
644 (defvar idlwave-shell-output-overlay nil
645 "The overlay for the last IDL output.")
647 ;; If these were already overlays, delete them. This probably means that we
648 ;; are reloading this file.
649 (if (overlayp idlwave-shell-stop-line-overlay)
650 (delete-overlay idlwave-shell-stop-line-overlay))
651 (if (overlayp idlwave-shell-expression-overlay)
652 (delete-overlay idlwave-shell-expression-overlay))
653 (if (overlayp idlwave-shell-output-overlay)
654 (delete-overlay idlwave-shell-output-overlay))
656 ;; Set to nil initially
657 (setq idlwave-shell-stop-line-overlay nil
658 idlwave-shell-expression-overlay nil
659 idlwave-shell-output-overlay nil)
661 ;; Define the shell stop overlay. When left nil, the arrow will be used.
662 (cond
663 ((or (null idlwave-shell-mark-stop-line)
664 (eq idlwave-shell-mark-stop-line 'arrow))
665 ;; Leave the overlay nil
666 nil)
668 ((eq idlwave-shell-mark-stop-line 'face)
669 ;; Try to use a face. If not possible, arrow will be used anyway
670 ;; So who can display faces?
671 (when (or (featurep 'xemacs) ; XEmacs can do also ttys
672 (fboundp 'tty-defined-colors) ; Emacs 21 as well
673 window-system) ; Window systems always
674 (progn
675 (setq idlwave-shell-stop-line-overlay (make-overlay 1 1))
676 (overlay-put idlwave-shell-stop-line-overlay
677 'face idlwave-shell-stop-line-face))))
680 ;; IDLWAVE may decide. Will use a face on window systems, arrow elsewhere
681 (if window-system
682 (progn
683 (setq idlwave-shell-stop-line-overlay (make-overlay 1 1))
684 (overlay-put idlwave-shell-stop-line-overlay
685 'face idlwave-shell-stop-line-face)))))
687 ;; Now the expression and output overlays
688 (setq idlwave-shell-expression-overlay (make-overlay 1 1))
689 (overlay-put idlwave-shell-expression-overlay
690 'face idlwave-shell-expression-face)
691 (overlay-put idlwave-shell-expression-overlay
692 'priority 1)
693 (setq idlwave-shell-output-overlay (make-overlay 1 1))
694 (overlay-put idlwave-shell-output-overlay
695 'face idlwave-shell-output-face)
697 (copy-face idlwave-shell-stop-line-face
698 'idlwave-shell-pending-stop)
699 (copy-face idlwave-shell-electric-stop-line-face
700 'idlwave-shell-pending-electric-stop)
701 (set-face-background 'idlwave-shell-pending-stop "gray70")
702 (set-face-background 'idlwave-shell-pending-electric-stop "gray70")
706 (defvar idlwave-shell-bp-query "help,/breakpoints"
707 "Command to obtain list of breakpoints.")
709 (defvar idlwave-shell-command-output nil
710 "String for accumulating current command output.")
712 (defvar idlwave-shell-post-command-hook nil
713 "Lisp list expression or function to run when an IDL command is finished.
714 The current command is finished when the IDL prompt is displayed.
715 This is evaluated if it is a list or called with funcall.")
717 (defvar idlwave-shell-sentinel-hook nil
718 "Hook run when the IDL process exits.")
720 (defvar idlwave-shell-hide-output nil
721 "If non-nil the process output is not inserted into the output buffer.")
723 (defvar idlwave-shell-show-if-error nil
724 "If non-nil the process output is inserted into the output buffer if
725 it contains an error message, even if hide-output is non-nil.")
727 (defvar idlwave-shell-accumulation nil
728 "Accumulate last line of output.")
730 (defvar idlwave-shell-command-line-to-execute nil)
731 (defvar idlwave-shell-cleanup-hook nil
732 "List of functions to do cleanup when the shell exits.")
734 (defvar idlwave-shell-pending-commands nil
735 "List of commands to be sent to IDL.
736 Each element of the list is list of \(CMD PCMD HIDE\), where CMD is a
737 string to be sent to IDL and PCMD is a post-command to be placed on
738 `idlwave-shell-post-command-hook'. If HIDE is non-nil, hide the output
739 from command CMD. PCMD and HIDE are optional.")
741 (defun idlwave-shell-buffer ()
742 "Name of buffer associated with IDL process.
743 The name of the buffer is made by surrounding `idlwave-shell-process-name'
744 with `*'s."
745 (concat "*" idlwave-shell-process-name "*"))
747 (defvar idlwave-shell-ready nil
748 "If non-nil can send next command to IDL process.")
750 ;;; The following are the types of messages we attempt to catch to
751 ;;; resync our idea of where IDL execution currently is.
754 (defvar idlwave-shell-halt-frame nil
755 "The frame associated with halt/breakpoint messages.")
757 (defvar idlwave-shell-step-frame nil
758 "The frame associated with step messages.")
760 (defvar idlwave-shell-trace-frame nil
761 "The frame associated with trace messages.")
763 (defconst idlwave-shell-halt-messages
764 '("^% Interrupted at:"
765 "^% Stepped to:"
766 "^% Skipped to:"
767 "^% Stop encountered:"
769 "A list of regular expressions matching IDL messages.
770 These are the messages containing file and line information where
771 IDL is currently stopped.")
774 (defconst idlwave-shell-halt-messages-re
775 (mapconcat 'identity idlwave-shell-halt-messages "\\|")
776 "The regular expression computed from `idlwave-shell-halt-messages'.")
778 (defconst idlwave-shell-trace-message-re
779 "^% At " ;; First line of a trace message
780 "A regular expression matching IDL trace messages. These are the
781 messages containing file and line information of a current
782 traceback.")
784 (defconst idlwave-shell-step-messages
785 '("^% Stepped to:"
787 "A list of regular expressions matching stepped execution messages.
788 These are IDL messages containing file and line information where
789 IDL has currently stepped.")
791 (defvar idlwave-shell-break-message "^% Breakpoint at:"
792 "Regular expression matching an IDL breakpoint message line.")
794 (defconst idlwave-shell-electric-debug-help
795 " ==> IDLWAVE Electric Debug Mode Help <==
797 Break Point Setting and Clearing:
798 b Set breakpoint ([C-u b] for conditional, [C-n b] nth hit, etc.).
799 d Clear nearby breakpoint.
800 a Clear all breakpoints.
801 i Set breakpoint in routine named here.
802 j Set breakpoint at beginning of containing routine.
803 \\ Toggle breakpoint disable
804 ] Go to next breakpoint in file.
805 [ Go to previous breakpoint in file.
807 Stepping, Continuing, and the Stack:
808 s or SPACE Step, into function calls.
809 n Step, over function calls.
810 k Skip one statement.
811 m Continue to end of function.
812 o Continue past end of function.
813 u Continue to end of block.
814 h Continue to line at cursor position.
815 r Continue execution to next breakpoint, if any.
816 + or = Show higher level in calling stack.
817 - or _ Show lower level in calling stack.
819 Examining Expressions (with prefix for examining the region):
820 p Print expression near point or in region ([C-u p]).
821 ? Help on expression near point or in region ([C-u ?]).
822 x Examine expression near point or in region ([C-u x]) with
823 letter completion of the examine type.
824 e Prompt for an expression to print.
826 Miscellaneous:
827 q Quit - end debugging session and return to the Shell's main level.
828 v Turn Electric Debugging Mode off (C-c C-d C-v to return).
829 t Print a calling-level traceback in the shell.
830 z Reset IDL.
831 C-? Show this help menu.")
833 (defvar idlwave-shell-bp-alist)
834 ;(defvar idlwave-shell-post-command-output)
835 (defvar idlwave-shell-sources-alist)
836 (defvar idlwave-shell-menu-def)
837 (defvar idlwave-shell-mode-menu)
838 (defvar idlwave-shell-initial-commands)
839 (defvar idlwave-shell-syntax-error)
840 (defvar idlwave-shell-other-error)
841 (defvar idlwave-shell-error-buffer)
842 (defvar idlwave-shell-error-last)
843 (defvar idlwave-shell-bp-buffer)
844 (defvar idlwave-shell-sources-query)
845 (defvar idlwave-shell-mode-map)
846 (defvar idlwave-shell-calling-stack-index)
847 (defvar idlwave-shell-only-prompt-pattern nil)
848 (defvar tool-bar-map)
850 (define-derived-mode idlwave-shell-mode comint-mode "IDL-Shell"
851 "Major mode for interacting with an inferior IDL process.
853 1. Shell Interaction
854 -----------------
855 RET after the end of the process' output sends the text from the
856 end of process to the end of the current line. RET before end of
857 process output copies the current line (except for the prompt) to
858 the end of the buffer.
860 Command history, searching of previous commands, command line
861 editing are available via the comint-mode key bindings, by default
862 mostly on the key `C-c'. Command history is also available with
863 the arrow keys UP and DOWN.
865 2. Completion
866 ----------
867 TAB and M-TAB do completion of IDL routines, classes and keywords -
868 similar to M-TAB in `idlwave-mode'. In executive commands and
869 strings, it completes file names. Abbreviations are also expanded
870 like in `idlwave-mode'.
872 3. Routine Info
873 ------------
874 `\\[idlwave-routine-info]' displays information about an IDL routine near point,
875 just like in `idlwave-mode'. The module used is the one at point or
876 the one whose argument list is being edited.
877 To update IDLWAVE's knowledge about compiled or edited modules, use
878 \\[idlwave-update-routine-info].
879 \\[idlwave-find-module] find the source of a module.
880 \\[idlwave-resolve] tells IDL to compile an unresolved module.
881 \\[idlwave-context-help] shows the online help on the item at
882 point, if online help has been installed.
885 4. Debugging
886 ---------
887 A complete set of commands for compiling and debugging IDL programs
888 is available from the menu. Also keybindings starting with a
889 `C-c C-d' prefix are available for most commands in the *idl* buffer
890 and also in source buffers. The best place to learn about the
891 keybindings is again the menu.
893 On Emacs versions where this is possible, a debugging toolbar is
894 installed.
896 When IDL is halted in the middle of a procedure, the corresponding
897 line of that procedure file is displayed with an overlay in another
898 window. Breakpoints are also highlighted in the source.
900 \\[idlwave-shell-resync-dirs] queries IDL in order to change Emacs current directory
901 to correspond to the IDL process current directory.
903 5. Expression Examination
904 ----------------------
906 Expressions near point can be examined with print,
907 \\[idlwave-shell-print] or \\[idlwave-shell-mouse-print] with the
908 mouse, help, \\[idlwave-shell-help-expression] or
909 \\[idlwave-shell-mouse-help] with the mouse, or with a
910 configurable set of custom examine commands using
911 \\[idlwave-shell-examine-select]. The mouse examine commands can
912 also work by click and drag, to select an expression for
913 examination.
915 6. Hooks
916 -----
917 Turning on `idlwave-shell-mode' runs `comint-mode-hook' and
918 `idlwave-shell-mode-hook' (in that order).
920 7. Documentation and Customization
921 -------------------------------
922 Info documentation for this package is available. Use \\[idlwave-info]
923 to display (complain to your sysadmin if that does not work).
924 For PostScript and HTML versions of the documentation, check IDLWAVE's
925 homepage at URL `http://idlwave.org'.
926 IDLWAVE has customize support - see the group `idlwave'.
928 8. Keybindings
929 -----------
930 \\{idlwave-shell-mode-map}"
931 :abbrev-table idlwave-mode-abbrev-table
932 (idlwave-setup) ; Make sure config files and paths, etc. are available.
933 (unless (file-name-absolute-p idlwave-shell-command-history-file)
934 (setq idlwave-shell-command-history-file
935 (expand-file-name idlwave-shell-command-history-file
936 idlwave-config-directory)))
938 (setq comint-prompt-regexp idlwave-shell-prompt-pattern)
939 (setq comint-process-echoes t)
941 ;; Can not use history expansion because "!" is used for system variables.
942 (setq comint-input-autoexpand nil)
943 ;; (setq comint-input-ring-size 64)
945 (set (make-local-variable 'completion-ignore-case) t)
946 (set (make-local-variable 'comint-completion-addsuffix) '("/" . ""))
947 (setq comint-input-ignoredups t)
948 (setq idlwave-shell-mode-line-info nil)
949 (setq mode-line-format
950 '(""
951 mode-line-modified
952 mode-line-buffer-identification
954 global-mode-string
955 " %[("
956 mode-name
957 mode-line-process
958 minor-mode-alist
959 "%n"
960 ")%]-"
961 idlwave-shell-mode-line-info
962 "---"
963 (line-number-mode "L%l--")
964 (column-number-mode "C%c--")
965 (-3 . "%p")
966 "-%-"))
967 ;; (make-local-variable 'idlwave-shell-bp-alist)
968 (setq idlwave-shell-halt-frame nil
969 idlwave-shell-trace-frame nil
970 idlwave-shell-command-output nil
971 idlwave-shell-step-frame nil)
972 (idlwave-shell-display-line nil)
973 (setq idlwave-shell-calling-stack-index 0)
974 (setq idlwave-shell-only-prompt-pattern
975 (concat "\\`[ \t\n]*"
976 (substring idlwave-shell-prompt-pattern 1)
977 "[ \t\n]*\\'"))
979 (when idlwave-shell-query-for-class
980 (add-to-list (make-local-variable 'idlwave-determine-class-special)
981 'idlwave-shell-get-object-class)
982 (setq idlwave-store-inquired-class t))
984 ;; Make sure comint-last-input-end does not go to beginning of
985 ;; buffer (in case there were other processes already in this buffer).
986 (set-marker comint-last-input-end (point))
987 (setq idlwave-idlwave_routine_info-compiled nil)
988 (setq idlwave-shell-ready nil)
989 (setq idlwave-shell-bp-alist nil)
990 (idlwave-shell-update-bp-overlays) ; Throw away old overlays
991 (setq idlwave-shell-post-command-hook nil ;clean up any old stuff
992 idlwave-shell-sources-alist nil)
993 (setq idlwave-shell-default-directory default-directory)
994 (setq idlwave-shell-hide-output nil)
996 ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
997 ;; (make-local-hook 'kill-buffer-hook)
998 (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm
999 nil 'local)
1000 (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local)
1001 (add-hook 'kill-emacs-hook 'idlwave-shell-delete-temp-files)
1002 (easy-menu-add idlwave-shell-mode-menu idlwave-shell-mode-map)
1004 ;; Set the optional comint variables
1005 (when idlwave-shell-comint-settings
1006 (let ((list idlwave-shell-comint-settings) entry)
1007 (while (setq entry (pop list))
1008 (set (make-local-variable (car entry)) (cdr entry)))))
1011 (unless (memq 'comint-carriage-motion
1012 (default-value 'comint-output-filter-functions))
1013 ;; Strip those pesky ctrl-m's.
1014 (add-hook 'comint-output-filter-functions
1015 (lambda (string)
1016 (when (string-match "\r" string)
1017 (let ((pmark (process-mark (get-buffer-process
1018 (current-buffer)))))
1019 (save-excursion
1020 ;; bare CR -> delete preceding line
1021 (goto-char comint-last-output-start)
1022 (while (search-forward "\r" pmark t)
1023 (delete-region (point) (line-beginning-position)))))))
1024 'append 'local)
1025 (add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m nil 'local))
1027 ;; Python-mode, bundled with many Emacs installs, quite cavalierly
1028 ;; adds this function to the global default hook. It interferes
1029 ;; with overlay-arrows.
1030 (remove-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file)
1032 ;; IDLWAVE syntax, and turn on abbreviations
1033 (set (make-local-variable 'comment-start) ";")
1034 (setq abbrev-mode t)
1036 ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
1037 ;; make-local-hook 'post-command-hook)
1038 (add-hook 'post-command-hook 'idlwave-command-hook nil t)
1040 ;; Read the command history?
1041 (when (and idlwave-shell-save-command-history
1042 (stringp idlwave-shell-command-history-file))
1043 (set (make-local-variable 'comint-input-ring-file-name)
1044 idlwave-shell-command-history-file)
1045 (if (file-regular-p idlwave-shell-command-history-file)
1046 (comint-read-input-ring)))
1048 ;; Turn off the non-debug toolbar buttons (open,save,etc.)
1049 (set (make-local-variable 'tool-bar-map) nil)
1051 (idlwave-shell-send-command idlwave-shell-initial-commands nil 'hide)
1052 ;; Turn off IDL's ^d interpreting, and define a system
1053 ;; variable which knows the version of IDLWAVE
1054 (idlwave-shell-send-command
1055 (format "defsysv,'!idlwave_version','%s',1" idlwave-mode-version)
1056 nil 'hide)
1057 ;; Read the paths, and save if they changed
1058 (idlwave-shell-send-command idlwave-shell-path-query
1059 'idlwave-shell-get-path-info
1060 'hide))
1062 (defvar idlwave-system-directory)
1063 (defun idlwave-shell-get-path-info (&optional no-write)
1064 "Get the path lists, writing to file unless NO-WRITE is set."
1065 (let* ((rpl (idlwave-shell-path-filter))
1066 (sysdir (car rpl))
1067 (dirs (cdr rpl))
1068 (old-path-alist idlwave-path-alist)
1069 (old-sys-dir idlwave-system-directory)
1070 path-changed sysdir-changed)
1071 (when sysdir
1072 (setq idlwave-system-directory sysdir)
1073 (if (setq sysdir-changed
1074 (not (string= idlwave-system-directory old-sys-dir)))
1075 (put 'idlwave-system-directory 'from-shell t)))
1076 ;; Preserve any existing flags
1077 (setq idlwave-path-alist
1078 (mapcar (lambda (x)
1079 (let ((old-entry (assoc x old-path-alist)))
1080 (if old-entry
1081 (cons x (cdr old-entry))
1082 (list x))))
1083 dirs))
1084 (if (setq path-changed (not (equal idlwave-path-alist old-path-alist)))
1085 (put 'idlwave-path-alist 'from-shell t))
1086 (if idlwave-path-alist
1087 (if (and (not no-write)
1088 idlwave-auto-write-paths
1089 (or sysdir-changed path-changed)
1090 (not idlwave-library-path))
1091 (idlwave-write-paths))
1092 ;; Fall back
1093 (setq idlwave-path-alist old-path-alist))))
1095 (if (not (fboundp 'idl-shell))
1096 (fset 'idl-shell 'idlwave-shell))
1098 (defvar idlwave-shell-idl-wframe nil
1099 "Frame for displaying the IDL shell window.")
1100 (defvar idlwave-shell-display-wframe nil
1101 "Frame for displaying the IDL source files.")
1103 (defvar idlwave-shell-calling-stack-index 0)
1104 (defvar idlwave-shell-calling-stack-routine nil)
1106 (defun idlwave-shell-source-frame ()
1107 "Return the frame to be used for source display."
1108 (if idlwave-shell-use-dedicated-frame
1109 ;; We want separate frames for source and shell
1110 (if (frame-live-p idlwave-shell-display-wframe)
1111 ;; The frame exists, so we use it.
1112 idlwave-shell-display-wframe
1113 ;; The frame does not exist. We use the current frame.
1114 ;; However, if the current is the shell frame, we make a new frame,
1115 ;; or recycle the first existing visible frame
1116 (setq idlwave-shell-display-wframe
1117 (if (eq (selected-frame) idlwave-shell-idl-wframe)
1119 (let ((flist (visible-frame-list))
1120 (frame (selected-frame)))
1121 (catch 'exit
1122 (while flist
1123 (if (not (eq (car flist)
1124 idlwave-shell-idl-wframe))
1125 (throw 'exit (car flist))
1126 (setq flist (cdr flist))))))
1127 (make-frame))
1128 (selected-frame))))))
1130 (defun idlwave-shell-shell-frame ()
1131 "Return the frame to be used for the shell buffer."
1132 (if idlwave-shell-use-dedicated-frame
1133 ;; We want a dedicated frame
1134 (if (frame-live-p idlwave-shell-idl-wframe)
1135 ;; It does exist, so we use it.
1136 idlwave-shell-idl-wframe
1137 ;; It does not exist. Check if we have a source frame.
1138 (if (not (frame-live-p idlwave-shell-display-wframe))
1139 ;; We do not have a source frame, so we use this one.
1140 (setq idlwave-shell-display-wframe (selected-frame)))
1141 ;; Return a new frame
1142 (setq idlwave-shell-idl-wframe
1143 (make-frame idlwave-shell-frame-parameters)))))
1145 ;;;###autoload
1146 (defun idlwave-shell (&optional arg quick)
1147 "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'.
1148 If buffer exists but shell process is not running, start new IDL.
1149 If buffer exists and shell process is running, just switch to the buffer.
1151 When called with a prefix ARG, or when `idlwave-shell-use-dedicated-frame'
1152 is non-nil, the shell buffer and the source buffers will be in
1153 separate frames.
1155 The command to run comes from variable `idlwave-shell-explicit-file-name',
1156 with options taken from `idlwave-shell-command-line-options'.
1158 The buffer is put in `idlwave-shell-mode', providing commands for sending
1159 input and controlling the IDL job. See help on `idlwave-shell-mode'.
1160 See also the variable `idlwave-shell-prompt-pattern'.
1162 \(Type \\[describe-mode] in the shell buffer for a list of commands.)"
1163 (interactive "P")
1164 (if (eq arg 'quick)
1165 (progn
1166 (let ((idlwave-shell-use-dedicated-frame nil))
1167 (idlwave-shell nil)
1168 (delete-other-windows))
1169 (and idlwave-shell-use-dedicated-frame
1170 (setq idlwave-shell-idl-wframe (selected-frame)))
1171 (add-hook 'idlwave-shell-sentinel-hook
1172 'save-buffers-kill-emacs t))
1174 ;; A non-nil arg means, we want a dedicated frame. This will last
1175 ;; for the current editing session.
1176 (if arg (setq idlwave-shell-use-dedicated-frame t))
1177 (if (equal arg '(16)) (setq idlwave-shell-use-dedicated-frame nil))
1179 ;; Check if the process still exists. If not, create it.
1180 (unless (comint-check-proc (idlwave-shell-buffer))
1181 (let* ((prg (or idlwave-shell-explicit-file-name "idl"))
1182 (buf (apply 'make-comint
1183 idlwave-shell-process-name prg nil
1184 (if (stringp idlwave-shell-command-line-options)
1185 (idlwave-split-string
1186 idlwave-shell-command-line-options)
1187 idlwave-shell-command-line-options)))
1188 (process (get-buffer-process buf)))
1189 (setq idlwave-idlwave_routine_info-compiled nil)
1190 (set-process-filter process 'idlwave-shell-filter)
1191 (set-process-sentinel process 'idlwave-shell-sentinel)
1192 (set-buffer buf)
1193 (idlwave-shell-mode)))
1194 (let ((window (idlwave-display-buffer (idlwave-shell-buffer) nil
1195 (idlwave-shell-shell-frame)))
1196 (current-window (selected-window)))
1197 (select-window window)
1198 (goto-char (point-max))
1199 (if idlwave-shell-use-dedicated-window
1200 (set-window-dedicated-p window t))
1201 (select-window current-window)
1202 (if idlwave-shell-ready
1203 (raise-frame (window-frame window)))
1204 (if (eq (selected-frame) (window-frame window))
1205 (select-window window))))
1206 ;; Save the paths at the end, if they are from the Shell and new.
1207 (add-hook 'idlwave-shell-sentinel-hook
1208 (lambda ()
1209 (if (and
1210 idlwave-auto-write-paths
1211 idlwave-path-alist
1212 (not idlwave-library-path)
1213 (get 'idlwave-path-alist 'from-shell))
1214 (idlwave-write-paths)))))
1216 (defun idlwave-shell-recenter-shell-window (&optional arg)
1217 "Run `idlwave-shell', but make sure the current window stays selected."
1218 (interactive "P")
1219 (let ((window (selected-window)))
1220 (idlwave-shell arg)
1221 (select-window window)))
1223 (defun idlwave-shell-hide-p (type &optional list)
1224 "Whether to hide this type of command.
1225 Return either nil or 'hide."
1226 (let ((list (or list idlwave-shell-show-commands)))
1227 (if (listp list)
1228 (if (not (memq type list)) 'hide))))
1230 (defun idlwave-shell-add-or-remove-show (type)
1231 "Add or remove a show command from the list."
1232 (if (listp idlwave-shell-show-commands)
1233 (setq idlwave-shell-show-commands
1234 (if (memq type idlwave-shell-show-commands)
1235 (delq type idlwave-shell-show-commands)
1236 (add-to-list'idlwave-shell-show-commands type)))
1237 (setq idlwave-shell-show-commands (list type))))
1240 (defun idlwave-shell-send-command (&optional cmd pcmd hide preempt
1241 show-if-error)
1242 "Send a command to IDL process.
1244 \(CMD PCMD HIDE\) are placed at the end of `idlwave-shell-pending-commands'.
1245 If IDL is ready the first command in `idlwave-shell-pending-commands',
1246 CMD, is sent to the IDL process.
1248 If optional second argument PCMD is non-nil it will be placed on
1249 `idlwave-shell-post-command-hook' when CMD is executed.
1251 If the optional third argument HIDE is non-nil, then hide output from
1252 CMD, unless it is the symbol 'mostly, in which case only output
1253 beginning with \"%\" is hidden, and all other output (i.e., the
1254 results of a PRINT command), is shown. This helps with, e.g.,
1255 stepping through code with output.
1257 If optional fourth argument PREEMPT is non-nil CMD is put at front of
1258 `idlwave-shell-pending-commands'. If PREEMPT is 'wait, wait for all
1259 output to complete and the next prompt to arrive before returning
1260 \(useful if you need an answer now\). IDL is considered ready if the
1261 prompt is present and if `idlwave-shell-ready' is non-nil.
1263 If SHOW-IF-ERROR is non-nil, show the output if it contains an error
1264 message, independent of what HIDE is set to."
1266 ; (setq hide nil) ; FIXME: turn this on for debugging only
1267 ; (if (null cmd)
1268 ; (progn
1269 ; (message "SENDING Pending commands: %s"
1270 ; (prin1-to-string idlwave-shell-pending-commands)))
1271 ; (message "SENDING %s|||%s" cmd pcmd))
1272 (if (and (symbolp idlwave-shell-show-commands)
1273 (eq idlwave-shell-show-commands 'everything))
1274 (setq hide nil))
1275 (let ((save-buffer (current-buffer))
1276 buf proc)
1277 ;; Get or make the buffer and its process
1278 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
1279 (not (setq proc (get-buffer-process buf))))
1280 (if (not idlwave-shell-automatic-start)
1281 (error "%s"
1282 (substitute-command-keys
1283 "You need to first start an IDL shell with \\[idlwave-shell]"))
1284 (idlwave-shell-recenter-shell-window)
1285 (setq buf (get-buffer (idlwave-shell-buffer)))
1286 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
1287 (not (setq proc (get-buffer-process buf))))
1288 ;; Still nothing
1289 (error "Problem with autostarting IDL shell"))))
1290 (when (or cmd idlwave-shell-pending-commands)
1291 (set-buffer buf)
1292 ;; To make this easy, always push CMD onto pending commands
1293 (if cmd
1294 (setq idlwave-shell-pending-commands
1295 (if preempt
1296 ;; Put at front.
1297 (append (list (list cmd pcmd hide show-if-error))
1298 idlwave-shell-pending-commands)
1299 ;; Put at end.
1300 (append idlwave-shell-pending-commands
1301 (list (list cmd pcmd hide show-if-error))))))
1302 ;; Check if IDL ready
1303 (let ((save-point (point-marker)))
1304 (goto-char (process-mark proc))
1305 (if (and idlwave-shell-ready
1306 ;; Check for IDL prompt
1307 (prog2
1308 (forward-line 0)
1309 ;; (beginning-of-line) ; Changed for Emacs 21
1310 (looking-at idlwave-shell-prompt-pattern)
1311 (goto-char (process-mark proc))))
1312 ;; IDL ready for command, execute it
1313 (let* ((lcmd (car idlwave-shell-pending-commands))
1314 (cmd (car lcmd))
1315 (pcmd (nth 1 lcmd))
1316 (hide (nth 2 lcmd))
1317 (show-if-error (nth 3 lcmd)))
1318 ;; If this is an executive command, reset the stack pointer
1319 (if (eq (string-to-char cmd) ?.)
1320 (setq idlwave-shell-calling-stack-index 0))
1321 ;; Set post-command
1322 (setq idlwave-shell-post-command-hook pcmd)
1323 ;; Output hiding
1324 (setq idlwave-shell-hide-output hide)
1325 ;;Showing errors
1326 (setq idlwave-shell-show-if-error show-if-error)
1327 ;; Pop command
1328 (setq idlwave-shell-pending-commands
1329 (cdr idlwave-shell-pending-commands))
1330 ;; Send command for execution
1331 (set-marker comint-last-input-start (point))
1332 (set-marker comint-last-input-end (point))
1333 (comint-simple-send proc cmd)
1334 (setq idlwave-shell-ready nil)
1335 (if (equal preempt 'wait) ; Get all the output at once
1336 (while (not idlwave-shell-ready)
1337 (when (not (accept-process-output proc 6)) ; long wait
1338 (setq idlwave-shell-pending-commands nil)
1339 (error "Process timed out"))))))
1340 (goto-char save-point))
1341 (set-buffer save-buffer))))
1343 (defun idlwave-shell-send-char (c &optional error)
1344 "Send one character to the shell, without a newline."
1345 (interactive "cChar to send to IDL: \np")
1346 (let ((errf (if error 'error 'message))
1347 buf proc)
1348 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
1349 (not (setq proc (get-buffer-process buf))))
1350 (funcall errf "Shell is not running"))
1351 (if (equal c ?\C-g)
1352 (funcall errf "Abort")
1353 (comint-send-string proc (char-to-string c)))))
1355 (defvar idlwave-shell-char-mode-active)
1356 (defun idlwave-shell-input-mode-magic (string)
1357 "Check STRING for magic words and toggle character input mode.
1358 See also the variable `idlwave-shell-input-mode-spells'."
1359 (cond
1360 ((string-match (car idlwave-shell-input-mode-spells) string)
1361 (call-interactively 'idlwave-shell-send-char))
1362 ((and (boundp 'idlwave-shell-char-mode-active)
1363 (string-match (nth 2 idlwave-shell-input-mode-spells) string))
1364 (setq idlwave-shell-char-mode-active 'exit))
1365 ((string-match (nth 1 idlwave-shell-input-mode-spells) string)
1366 ;; Set a timer which will soon start the character loop
1367 (if (fboundp 'start-itimer)
1368 (start-itimer "IDLWAVE Char Mode" 'idlwave-shell-char-mode-loop 0.5
1369 nil nil t 'no-error)
1370 (run-at-time 0.5 nil 'idlwave-shell-char-mode-loop 'no-error)))))
1372 (defvar keyboard-quit)
1373 (defun idlwave-shell-char-mode-loop (&optional no-error)
1374 "Enter a loop which accepts single characters and sends them to IDL.
1375 Characters are sent one by one, without newlines. The loop is blocking
1376 and intercepts all input events to Emacs. You can use this command
1377 to interact with the IDL command GET_KBRD.
1378 The loop can be aborted by typing `C-g'. The loop also exits automatically
1379 when the IDL prompt gets displayed again after the current IDL command."
1380 (interactive)
1382 ;; First check if there is a shell waiting for input
1383 (let ((idlwave-shell-char-mode-active t)
1384 (errf (if no-error 'message 'error))
1385 buf proc c)
1386 (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
1387 (not (setq proc (get-buffer-process buf))))
1388 (funcall errf "Shell is not running"))
1389 (if idlwave-shell-ready
1390 (funcall errf "No IDL program seems to be waiting for input"))
1392 ;; OK, start the loop
1393 (message "Character mode on: Sending single chars (`C-g' to exit)")
1394 (message
1395 (catch 'exit
1396 (while t
1397 ;; Wait for input
1398 ;; FIXME: Is it too dangerous to inhibit quit here?
1399 (let ((inhibit-quit t))
1400 ;; We wait and check frequently if we should abort
1401 (while (sit-for 0.3)
1402 (and idlwave-shell-ready
1403 (throw 'exit "Character mode off (prompt displayed)"))
1404 (and (eq idlwave-shell-char-mode-active 'exit)
1405 (throw 'exit "Character mode off (closing spell incantation)")))
1406 ;; Interpret input as a character - ignore non-char input
1407 (condition-case nil
1408 (setq c (read-char))
1409 (error (ding) (throw 'exit "Character mode off")))
1410 (cond
1411 ((null c) ; Non-char event: ignore
1412 (ding))
1413 ((equal c ?\C-g) ; Abort the loop
1414 (setq keyboard-quit nil)
1415 (ding)
1416 (throw 'exit "Character mode off (keyboard quit)"))
1417 (t ; Send the character and continue the loop
1418 (comint-send-string proc (char-to-string c))))
1419 (and (eq idlwave-shell-char-mode-active 'exit)
1420 (throw 'exit "Single char loop exited"))))))))
1422 (defun idlwave-shell-move-or-history (up &optional arg)
1423 "When in last line of process buffer, do `comint-previous-input'.
1424 Otherwise just move the line. Move down unless UP is non-nil."
1425 (let* ((proc-pos (marker-position
1426 (process-mark (get-buffer-process (current-buffer)))))
1427 (arg (or arg 1))
1428 (arg (if up arg (- arg))))
1429 (if (eq t idlwave-shell-arrows-do-history) (goto-char proc-pos))
1430 (if (and idlwave-shell-arrows-do-history
1431 (>= (1+ (point-at-eol)) proc-pos))
1432 (comint-previous-input arg)
1433 (forward-line (- arg)))))
1435 (defun idlwave-shell-up-or-history (&optional arg)
1436 "When in last line of process buffer, move to previous input.
1437 Otherwise just go up one line."
1438 (interactive "p")
1439 (idlwave-shell-move-or-history t arg))
1441 (defun idlwave-shell-down-or-history (&optional arg)
1442 "When in last line of process buffer, move to next input.
1443 Otherwise just go down one line."
1444 (interactive "p")
1445 (idlwave-shell-move-or-history nil arg))
1447 ;; Newer versions of comint.el changed the name of comint-filter to
1448 ;; comint-output-filter.
1449 (defun idlwave-shell-comint-filter (process string) nil)
1450 (if (fboundp 'comint-output-filter)
1451 (fset 'idlwave-shell-comint-filter (symbol-function 'comint-output-filter))
1452 (fset 'idlwave-shell-comint-filter (symbol-function 'comint-filter)))
1454 (defun idlwave-shell-is-running ()
1455 "Return t if the shell process is running."
1456 (eq (process-status idlwave-shell-process-name) 'run))
1458 (defun idlwave-shell-filter-hidden-output (output)
1459 "Filter hidden output, leaving the good stuff.
1461 Remove everything to the first newline, and all lines with % in front
1462 of them, with optional follow-on lines starting with two spaces. This
1463 works well enough, since any print output typically arrives before
1464 error messages, etc."
1465 (setq output (substring output (string-match "\n" output)))
1466 (while (string-match "\\(\n\\|\\`\\)%.*\\(\n .*\\)*" output)
1467 (setq output (replace-match "" nil t output)))
1468 (unless
1469 (string-match idlwave-shell-only-prompt-pattern output)
1470 output))
1472 (defvar idlwave-shell-hidden-output-buffer " *idlwave-shell-hidden-output*"
1473 "Buffer containing hidden output from IDL commands.")
1474 (defvar idlwave-shell-current-state nil)
1476 (defun idlwave-shell-filter (proc string)
1477 "Watch for IDL prompt and filter incoming text.
1478 When the IDL prompt is received executes `idlwave-shell-post-command-hook'
1479 and then calls `idlwave-shell-send-command' for any pending commands."
1480 ;; We no longer do the cleanup here - this is done by the process sentinel
1481 (if (eq (process-status idlwave-shell-process-name) 'run)
1482 ;; OK, process is still running, so we can use it.
1483 (let ((data (match-data)) p full-output)
1484 (unwind-protect
1485 (progn
1486 ;; Ring the bell if necessary
1487 (while (setq p (string-match "\C-G" string))
1488 (ding)
1489 (aset string p ?\C-j ))
1490 (if idlwave-shell-hide-output
1491 (save-excursion
1492 (while (setq p (string-match "\C-M" string))
1493 (aset string p ?\ ))
1494 (set-buffer
1495 (get-buffer-create idlwave-shell-hidden-output-buffer))
1496 (goto-char (point-max))
1497 (insert string))
1498 (idlwave-shell-comint-filter proc string))
1499 ;; Watch for magic - need to accumulate the current line
1500 ;; since it may not be sent all at once.
1501 (if (string-match "\n" string)
1502 (progn
1503 (if idlwave-shell-use-input-mode-magic
1504 (idlwave-shell-input-mode-magic
1505 (concat idlwave-shell-accumulation string)))
1506 (setq idlwave-shell-accumulation
1507 (substring string
1508 (progn (string-match "\\(.*[\n\r]+\\)*"
1509 string)
1510 (match-end 0)))))
1511 (setq idlwave-shell-accumulation
1512 (concat idlwave-shell-accumulation string)))
1515 ;; ;; Test/Debug code
1516 ;;(with-current-buffer
1517 ;; (get-buffer-create "*idlwave-shell-output*")
1518 ;; (goto-char (point-max))
1519 ;; (insert "\nReceived STRING\n===>\n" string "\n<====\n"))
1521 ;; Check for prompt in current accumulating output
1522 (when (setq idlwave-shell-ready
1523 (string-match idlwave-shell-prompt-pattern
1524 idlwave-shell-accumulation))
1525 ;; Gather the command output
1526 (if idlwave-shell-hide-output
1527 (with-current-buffer idlwave-shell-hidden-output-buffer
1528 (setq full-output (buffer-string))
1529 (goto-char (point-max))
1530 (re-search-backward idlwave-shell-prompt-pattern nil t)
1531 (goto-char (match-end 0))
1532 (setq idlwave-shell-command-output
1533 (buffer-substring-no-properties
1534 (point-min) (point)))
1535 (delete-region (point-min) (point)))
1536 (setq idlwave-shell-command-output
1537 (with-current-buffer (process-buffer proc)
1538 (buffer-substring-no-properties
1539 (save-excursion
1540 (goto-char (process-mark proc))
1541 (forward-line 0) ; Emacs 21 (beginning-of-line nil)
1542 (point))
1543 comint-last-input-end))))
1545 ;; Scan for state and do post commands - bracket
1546 ;; them with idlwave-shell-ready=nil since they may
1547 ;; call idlwave-shell-send-command themselves.
1548 (let ((idlwave-shell-ready nil))
1549 (idlwave-shell-scan-for-state)
1550 ;; Show the output in the shell if it contains an error
1551 (if idlwave-shell-hide-output
1552 (if (and idlwave-shell-show-if-error
1553 (eq idlwave-shell-current-state 'error))
1554 (idlwave-shell-comint-filter proc full-output)
1555 ;; If it's only *mostly* hidden, filter % lines,
1556 ;; and show anything that remains
1557 (if (eq idlwave-shell-hide-output 'mostly)
1558 (let ((filtered
1559 (idlwave-shell-filter-hidden-output
1560 full-output)))
1561 (if filtered
1562 (idlwave-shell-comint-filter
1563 proc filtered))))))
1565 ;; Call the post-command hook
1566 (if (listp idlwave-shell-post-command-hook)
1567 (progn
1568 ;;(message "Calling list")
1569 ;;(prin1 idlwave-shell-post-command-hook)
1570 (eval idlwave-shell-post-command-hook))
1571 ;;(message "Calling command function")
1572 (funcall idlwave-shell-post-command-hook))
1574 ;; Reset to default state for next command.
1575 ;; Also we do not want to find this prompt again.
1576 (setq idlwave-shell-accumulation nil
1577 idlwave-shell-command-output nil
1578 idlwave-shell-post-command-hook nil
1579 idlwave-shell-hide-output nil
1580 idlwave-shell-show-if-error nil))
1581 ;; Done with post command. Do pending command if
1582 ;; any.
1583 (idlwave-shell-send-command)))
1584 (store-match-data data)))))
1586 (defun idlwave-shell-sentinel (process event)
1587 "The sentinel function for the IDLWAVE shell process."
1588 (let* ((buf (idlwave-shell-buffer))
1589 (win (get-buffer-window buf)))
1590 (when (get-buffer buf)
1591 (with-current-buffer (idlwave-shell-buffer)
1592 (goto-char (point-max))
1593 (insert (format "\n\n Process %s %s" process event))
1594 (if (and idlwave-shell-save-command-history
1595 (stringp idlwave-shell-command-history-file))
1596 (condition-case nil
1597 (comint-write-input-ring)
1598 (error nil)))))
1600 (when (and (> (length (frame-list)) 1)
1601 (frame-live-p idlwave-shell-idl-wframe))
1602 (delete-frame idlwave-shell-idl-wframe)
1603 (setq idlwave-shell-idl-wframe nil
1604 idlwave-shell-display-wframe nil))
1605 (when (and (window-live-p win)
1606 (not (one-window-p 'nomini)))
1607 (delete-window win))
1608 (idlwave-shell-cleanup)
1609 ;; Run the hook, if possible in the shell buffer.
1610 (if (get-buffer buf)
1611 (with-current-buffer buf
1612 (run-hooks 'idlwave-shell-sentinel-hook))
1613 (run-hooks 'idlwave-shell-sentinel-hook))))
1615 (defvar idlwave-shell-error-buffer " *idlwave-shell-errors*"
1616 "Buffer containing syntax errors from IDL compilations.")
1618 ;; FIXME: the following two variables do not currently allow line breaks
1619 ;; in module and file names. I am not sure if it will be necessary to
1620 ;; change this. Currently it seems to work the way it is.
1621 (defvar idlwave-shell-syntax-error
1622 "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"
1623 "A regular expression to match an IDL syntax error.
1624 The first pair matches the file name, the second pair matches the line
1625 number.")
1627 (defvar idlwave-shell-other-error
1628 "^% .*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"
1629 "A regular expression to match any IDL error.")
1631 (defvar idlwave-shell-halting-error
1632 "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+\\s-*.*\\)\n"
1633 "A regular expression to match errors which halt execution.")
1635 (defvar idlwave-shell-cant-continue-error
1636 "^% Can't continue from this point.\n"
1637 "A regular expression to match errors stepping errors.")
1639 (defvar idlwave-shell-file-line-message
1640 (concat
1641 "\\(" ; program name group (1)
1642 "\\$MAIN\\$\\|" ; main level routine
1643 "\\<[a-zA-Z][a-zA-Z0-9_$:]*" ; start with a letter followed by [..]
1644 "\\([ \t]*\n[ \t]*[a-zA-Z0-9_$:]+\\)*"; continuation lines program name (2)
1645 "\\)" ; end program name group (1)
1646 "[ \t\n]+" ; white space
1647 "\\(" ; line number group (3)
1648 "[0-9]+" ; the line number (the fix point)
1649 "\\([ \t]*\n[ \t]*[0-9]+\\)*" ; continuation lines number (4)
1650 "\\)" ; end line number group (3)
1651 "[ \t\n]+" ; white space
1652 "\\(" ; file name group (5)
1653 "[^ \t\n]+" ; file names can contain any non-white
1654 "\\([ \t]*\n[ \t]*[^ \t\n]+\\)*" ; continuation lines file name (6)
1655 "\\)" ; end line number group (5)
1657 "A regular expression to parse out the file name and line number.
1658 The 1st group should match the subroutine name.
1659 The 3rd group is the line number.
1660 The 5th group is the file name.
1661 All parts may contain linebreaks surrounded by spaces. This is important
1662 in IDL5 which inserts random linebreaks in long module and file names.")
1664 (defvar idlwave-shell-electric-debug-mode) ; defined by easy-mmode
1666 (defun idlwave-shell-scan-for-state ()
1667 "Scan for state info.
1668 Looks for messages in output from last IDL command indicating where
1669 IDL has stopped. The types of messages we are interested in are
1670 execution halted, stepped, breakpoint, interrupted at and trace
1671 messages. For breakpoint messages process any attached count or
1672 command parameters. Update the stop line if a message is found.
1673 The variable `idlwave-shell-current-state' is set to 'error, 'halt,
1674 or 'breakpoint, which describes the status, or nil for none of
1675 the above."
1676 (let (trace)
1677 (cond
1678 ;; Make sure we have output
1679 ((not idlwave-shell-command-output))
1681 ;; First Priority: Syntax and other errors
1682 ((or
1683 (string-match idlwave-shell-syntax-error
1684 idlwave-shell-command-output)
1685 (string-match idlwave-shell-other-error
1686 idlwave-shell-command-output))
1687 (with-current-buffer
1688 (get-buffer-create idlwave-shell-error-buffer)
1689 (erase-buffer)
1690 (insert idlwave-shell-command-output)
1691 (goto-char (point-min))
1692 (setq idlwave-shell-error-last (point)))
1693 (setq idlwave-shell-current-state 'error)
1694 (idlwave-shell-goto-next-error))
1696 ;; Second Priority: Halting errors
1697 ((string-match idlwave-shell-halting-error
1698 idlwave-shell-command-output)
1699 ;; Grab the file and line state info.
1700 (setq idlwave-shell-calling-stack-index 0)
1701 (setq idlwave-shell-halt-frame
1702 (idlwave-shell-parse-line
1703 (substring idlwave-shell-command-output
1704 (match-beginning 2)))
1705 idlwave-shell-current-state 'error)
1706 (idlwave-shell-display-line (idlwave-shell-pc-frame)))
1708 ;; Third Priority: Various types of innocuous HALT and
1709 ;; TRACEBACK messages.
1710 ((or (setq trace (string-match idlwave-shell-trace-message-re
1711 idlwave-shell-command-output))
1712 (string-match idlwave-shell-halt-messages-re
1713 idlwave-shell-command-output))
1714 ;; Grab the file and line state info.
1715 (setq idlwave-shell-calling-stack-index 0)
1716 (setq idlwave-shell-halt-frame
1717 (idlwave-shell-parse-line
1718 (substring idlwave-shell-command-output (match-end 0))))
1719 (setq idlwave-shell-current-state 'halt)
1720 ;; Don't debug trace messages
1721 (idlwave-shell-display-line
1722 (idlwave-shell-pc-frame) nil
1723 (if trace 'disable
1724 (if idlwave-shell-electric-debug-mode 'force))))
1726 ;; Fourth Priority: Breakpoints
1727 ((string-match idlwave-shell-break-message
1728 idlwave-shell-command-output)
1729 (setq idlwave-shell-calling-stack-index 0)
1730 (setq idlwave-shell-halt-frame
1731 (idlwave-shell-parse-line
1732 (substring idlwave-shell-command-output (match-end 0))))
1733 ;; We used to count hits on breakpoints
1734 ;; this is no longer supported since IDL breakpoints
1735 ;; have learned counting.
1736 ;; Do breakpoint command processing
1737 (let ((bp (assoc
1738 (list
1739 (nth 0 idlwave-shell-halt-frame)
1740 (nth 1 idlwave-shell-halt-frame))
1741 idlwave-shell-bp-alist)))
1742 ;(message "Scanning with %s" bp)
1743 (if bp
1744 (let ((cmd (idlwave-shell-bp-get bp 'cmd)))
1745 (if cmd ;; Execute any breakpoint command
1746 (if (listp cmd) (eval cmd) (funcall cmd))))
1747 ;; A breakpoint that we did not know about - perhaps it was
1748 ;; set by the user... Let's update our list.
1749 (idlwave-shell-bp-query)))
1750 (setq idlwave-shell-current-state 'breakpoint)
1751 (idlwave-shell-display-line (idlwave-shell-pc-frame)))
1753 ;; Last Priority: Can't Step errors
1754 ((string-match idlwave-shell-cant-continue-error
1755 idlwave-shell-command-output)
1756 (setq idlwave-shell-current-state 'breakpoint))
1758 ;; Otherwise, no particular state
1759 (t (setq idlwave-shell-current-state nil)))))
1762 (defun idlwave-shell-parse-line (string &optional skip-main)
1763 "Parse IDL message for the subroutine, file name and line number."
1764 ;We need to work hard here to remove the stupid line breaks inserted by
1765 ;IDL5. These line breaks can be right in the middle of procedure
1766 ;or file names.
1767 ;It is very difficult to come up with a robust solution. This one seems
1768 ;to be pretty good though.
1770 ;Here is in what ways it improves over the previous solution:
1772 ;1. The procedure name can be split and will be restored.
1773 ;2. The number can be split. I have never seen this, but who knows.
1774 ;3. We do not require the `.pro' extension for files.
1776 ;This function can still break when the file name ends on an end line
1777 ;and the message line contains an additional line with garbage. Then
1778 ;the first part of that garbage will be added to the file name.
1779 ;However, the function checks the existence of the files with and
1780 ;without this last part - thus the function only breaks if file name
1781 ;plus garbage match an existing regular file. This is hopefully very
1782 ;unlikely.
1784 ;If optional arg SKIP-MAIN is non-nil, don't parse $MAIN$ routine stop
1785 ;statements.
1787 (let (number procedure file)
1788 (when (and (not (if skip-main (string-match ":\\s-*\\$MAIN" string)))
1789 (string-match idlwave-shell-file-line-message string))
1790 (setq procedure (match-string 1 string)
1791 number (match-string 3 string)
1792 file (match-string 5 string))
1794 ;; Repair the strings
1795 (setq procedure (idlwave-shell-repair-string procedure))
1796 (setq number (idlwave-shell-repair-string number))
1797 (setq file (idlwave-shell-repair-file-name file))
1799 ;; If we have a file, return the frame list
1800 (if file
1801 (list (idlwave-shell-file-name file)
1802 (string-to-number number)
1803 procedure)
1804 ;; No success finding a file
1805 nil))))
1807 (defun idlwave-shell-repair-string (string)
1808 "Repair a string by taking out all linebreaks. This is destructive!"
1809 (while (string-match "[ \t]*\n[ \t]*" string)
1810 (setq string (replace-match "" t t string)))
1811 string)
1813 (defun idlwave-shell-repair-file-name (file)
1814 "Repair a file name string by taking out all linebreaks.
1815 The last line of STRING may be garbage - we check which one makes a valid
1816 file name."
1817 (let ((file1 "") (file2 "") (start 0))
1818 ;; We scan no further than to the next "^%" line
1819 (if (string-match "^%" file)
1820 (setq file (substring file 0 (match-beginning 0))))
1821 ;; Take out the line breaks
1822 (while (string-match "[ \t]*\n[ \t]*" file start)
1823 (setq file1 (concat file1 (substring file start (match-beginning 0)))
1824 start (match-end 0)))
1825 (setq file2 (concat file1 (substring file start)))
1826 (cond
1827 ((file-regular-p file2) file2)
1828 ((file-regular-p file1) file1)
1829 ;; If we cannot verify the existence of the file, we return the shorter
1830 ;; name. The idea behind this is that this may be a relative file name
1831 ;; and our idea about the current working directory may be wrong.
1832 ;; If it is a relative file name, it hopefully is short.
1833 ((not (string= "" file1)) file1)
1834 ((not (string= "" file2)) file2)
1835 (t nil))))
1837 (defun idlwave-shell-cleanup ()
1838 "Do necessary cleanup for a terminated IDL process."
1839 (setq idlwave-shell-step-frame nil
1840 idlwave-shell-halt-frame nil
1841 idlwave-shell-pending-commands nil
1842 idlwave-shell-command-line-to-execute nil
1843 idlwave-shell-bp-alist nil
1844 idlwave-shell-calling-stack-index 0
1845 idlwave-idlwave_routine_info-compiled nil)
1846 (idlwave-shell-delete-temp-files)
1847 (idlwave-shell-display-line nil)
1848 (idlwave-shell-update-bp-overlays) ; kill old overlays
1849 (idlwave-shell-kill-buffer idlwave-shell-hidden-output-buffer)
1850 (idlwave-shell-kill-buffer idlwave-shell-bp-buffer)
1851 (idlwave-shell-kill-buffer idlwave-shell-error-buffer)
1852 ;; (idlwave-shell-kill-buffer (idlwave-shell-buffer))
1853 (and (get-buffer (idlwave-shell-buffer))
1854 (bury-buffer (get-buffer (idlwave-shell-buffer))))
1855 (run-hooks 'idlwave-shell-cleanup-hook))
1857 (defun idlwave-shell-kill-buffer (buf)
1858 "Kill buffer BUF if it exists."
1859 (if (setq buf (get-buffer buf))
1860 (kill-buffer buf)))
1862 (defun idlwave-shell-kill-shell-buffer-confirm ()
1863 (when (idlwave-shell-is-running)
1864 (ding)
1865 (unless (y-or-n-p "IDL shell is running. Are you sure you want to kill the buffer? ")
1866 (error "Abort"))
1867 (message "Killing buffer *idl* and the associated process")))
1869 (defun idlwave-shell-window (n)
1870 "Issue a `window,N' command to IDL, with special window size.
1871 The size is given by `idlwave-shell-graphics-window-size'."
1872 (interactive "P")
1873 (let ((n (if n (prefix-numeric-value n) 0)))
1874 (idlwave-shell-send-command
1875 (apply 'format "window,%d,xs=%d,ys=%d"
1876 n idlwave-shell-graphics-window-size)
1877 nil (idlwave-shell-hide-p 'misc) nil t)))
1879 (defun idlwave-shell-resync-dirs ()
1880 "Resync the buffer's idea of the current directory.
1881 This command queries IDL with the command bound to
1882 `idlwave-shell-dirstack-query', reads the output for the new
1883 directory."
1884 (interactive)
1885 (idlwave-shell-send-command idlwave-shell-dirstack-query
1886 'idlwave-shell-filter-directory
1887 'hide 'wait))
1889 (defun idlwave-shell-retall (&optional arg)
1890 "Return from the entire calling stack.
1891 Also get rid of widget events in the queue."
1892 (interactive "P")
1893 (save-selected-window
1894 ;;if (widget_info(/MANAGED))[0] gt 0 then for i=0,n_elements(widget_info(/MANAGED))-1 do widget_control,(widget_info(/MANAGED))[i],/clear_events &
1895 (idlwave-shell-send-command "retall" nil
1896 (if (idlwave-shell-hide-p 'misc) 'mostly)
1897 nil t)
1898 (idlwave-shell-display-line nil)))
1900 (defun idlwave-shell-closeall (&optional arg)
1901 "Close all open files."
1902 (interactive "P")
1903 (idlwave-shell-send-command "close,/all" nil
1904 (idlwave-shell-hide-p 'misc) nil t))
1906 (defun idlwave-shell-quit (&optional arg)
1907 "Exit the IDL process after confirmation.
1908 With prefix ARG, exit without confirmation."
1909 (interactive "P")
1910 (if (not (idlwave-shell-is-running))
1911 (error "Shell is not running")
1912 (if (or arg (y-or-n-p "Exit the IDLWAVE Shell? "))
1913 (condition-case nil
1914 (idlwave-shell-send-command "exit")
1915 (error nil)))))
1917 (defun idlwave-shell-reset (&optional hidden)
1918 "Reset IDL. Return to main level and destroy the leftover variables.
1919 This issues the following commands:
1920 RETALL
1921 WIDGET_CONTROL,/RESET
1922 CLOSE, /ALL
1923 HEAP_GC, /VERBOSE"
1924 ;; OBJ_DESTROY, OBJ_VALID() FIXME: should this be added?
1925 (interactive "P")
1926 (when (or idlwave-shell-reset-no-prompt
1927 (yes-or-no-p "Really Reset IDL and discard current session? "))
1928 (message "Resetting IDL")
1929 (setq idlwave-shell-calling-stack-index 0)
1930 ;; Give widget exit handlers a chance
1931 (idlwave-shell-send-command "retall" nil hidden)
1932 (idlwave-shell-send-command "widget_control,/reset" nil hidden)
1933 (idlwave-shell-send-command "close,/all" nil hidden)
1934 ;; (idlwave-shell-send-command "obj_destroy, obj_valid()" nil hidden)
1935 (idlwave-shell-send-command "heap_gc,/verbose" nil hidden)
1936 (idlwave-shell-display-line nil)))
1938 (defun idlwave-shell-path-filter ()
1939 ;; Convert the output of the path query into a list of directories
1940 (let ((path-string idlwave-shell-command-output)
1941 (case-fold-search t)
1942 (start 0)
1943 dirs sysdir)
1944 (while (string-match "^PATH:[ \t]*<\\(.*\\)>[ \t]*\n" path-string start)
1945 (push (match-string 1 path-string) dirs)
1946 (setq start (match-end 0)))
1947 (setq dirs (mapcar 'file-name-as-directory dirs))
1948 (if (string-match "^SYSDIR:[ \t]*<\\(.*\\)>[ \t]*\n" path-string)
1949 (setq sysdir (file-name-as-directory
1950 (match-string 1 path-string))))
1951 (cons sysdir (nreverse dirs))))
1953 (defun idlwave-shell-routine-info-filter ()
1954 "Function which parses the special output from idlwave_routine_info.pro."
1955 (let ((text idlwave-shell-command-output)
1956 (start 0)
1957 sep sep-re file type spec specs name cs key keys class entry)
1958 ;; (message "GOT: %s" text) ;??????????????????????
1959 ;; Initialize variables
1960 (setq idlwave-compiled-routines nil
1961 idlwave-unresolved-routines nil)
1962 ;; Cut out the correct part of the output.
1963 (if (string-match
1964 "^>>>BEGIN OF IDLWAVE ROUTINE INFO (\"\\(.+\\)\" IS THE SEPARATOR.*"
1965 text)
1966 (setq sep (match-string 1 text)
1967 sep-re (concat (regexp-quote sep) " *")
1968 text (substring text (match-end 0)))
1969 ;; Set dummy values and kill the text
1970 (setq sep "@" sep-re "@ *" text "")
1971 (if idlwave-idlwave_routine_info-compiled
1972 (message
1973 "Routine Info warning: No match for BEGIN line in \n>>>\n%s\n<<<\n"
1974 idlwave-shell-command-output)))
1975 (if (string-match "^>>>END OF IDLWAVE ROUTINE INFO.*" text)
1976 (setq text (substring text 0 (match-beginning 0)))
1977 (if idlwave-idlwave_routine_info-compiled
1978 (message
1979 "Routine Info warning: No match for END line in \n>>>\n%s\n<<<\n"
1980 idlwave-shell-command-output)))
1981 ;; Match the output lines
1982 (while (string-match "^IDLWAVE-\\(PRO\\|FUN\\): \\(.*\\)" text start)
1983 (setq start (match-end 0))
1984 (setq type (match-string 1 text)
1985 spec (match-string 2 text)
1986 specs (idlwave-split-string spec sep-re)
1987 name (nth 0 specs)
1988 class (if (equal (nth 1 specs) "") nil (nth 1 specs))
1989 file (nth 2 specs)
1990 cs (nth 3 specs)
1991 key (nth 4 specs)
1992 keys (if (and (stringp key)
1993 (not (string-match "\\` *\\'" key)))
1994 (mapcar 'list
1995 (delete "" (idlwave-split-string key " +")))))
1996 (setq name (idlwave-sintern-routine-or-method name class t)
1997 class (idlwave-sintern-class class t)
1998 file (if (equal file "") nil file)
1999 keys (mapcar (lambda (x)
2000 (list (idlwave-sintern-keyword (car x) t))) keys))
2002 ;; In the following ignore routines already defined in buffers,
2003 ;; assuming that if the buffer stuff differs, it is a "new"
2004 ;; version, not yet compiled, and should take precedence.
2005 ;; We could do the same for the library to avoid duplicates -
2006 ;; but I think frequently a user might have several versions of
2007 ;; the same function in different programs, and in this case the
2008 ;; compiled one will be the best guess of all versions.
2009 ;; Therefore, we leave duplicates of library routines in.
2010 (cond ((string= name "$MAIN$")) ; ignore this one
2011 ((and (string= type "PRO")
2012 ;; FIXME: is it OK to make the buffer routines dominate?
2013 (or t (null file)
2014 (not (idlwave-rinfo-assq name 'pro class
2015 idlwave-buffer-routines)))
2016 ;; FIXME: is it OK to make the library routines dominate?
2017 ;;(not (idlwave-rinfo-assq name 'pro class
2018 ;; idlwave-library-routines))
2020 (setq entry (list name 'pro class
2021 (cons 'compiled
2022 (if file
2023 (list
2024 (file-name-nondirectory file)
2025 (idlwave-sintern-dir
2026 (file-name-directory file)))))
2027 cs (cons nil keys)))
2028 (if file
2029 (push entry idlwave-compiled-routines)
2030 (push entry idlwave-unresolved-routines)))
2032 ((and (string= type "FUN")
2033 ;; FIXME: is it OK to make the buffer routines dominate?
2034 (or t (not file)
2035 (not (idlwave-rinfo-assq name 'fun class
2036 idlwave-buffer-routines)))
2037 ;; FIXME: is it OK to make the library routines dominate?
2038 ;; (not (idlwave-rinfo-assq name 'fun class
2039 ;; idlwave-library-routines))
2041 (setq entry (list name 'fun class
2042 (cons 'compiled
2043 (if file
2044 (list
2045 (file-name-nondirectory file)
2046 (idlwave-sintern-dir
2047 (file-name-directory file)))))
2048 cs (cons nil keys)))
2049 (if file
2050 (push entry idlwave-compiled-routines)
2051 (push entry idlwave-unresolved-routines))))))
2052 ;; Reverse the definitions so that they are alphabetically sorted.
2053 (setq idlwave-compiled-routines (nreverse idlwave-compiled-routines)
2054 idlwave-unresolved-routines (nreverse idlwave-unresolved-routines)))
2056 (defun idlwave-shell-filter-directory ()
2057 "Get the current directory from `idlwave-shell-command-output'.
2058 Change the default directory for the process buffer to concur."
2059 (with-current-buffer (idlwave-shell-buffer)
2060 (if (string-match ",___cur[\n\r ]+\\([^\n\r]+\\)[\n\r]"
2061 idlwave-shell-command-output)
2062 (let ((dir (substring idlwave-shell-command-output
2063 (match-beginning 1) (match-end 1))))
2064 ;; (message "Setting Emacs working dir to %s" dir)
2065 (setq idlwave-shell-default-directory dir)
2066 (setq default-directory (file-name-as-directory dir))))))
2068 (defvar idlwave-shell-get-object-class nil)
2069 (defun idlwave-shell-get-object-class (apos)
2070 "Query the shell for the class of the object before point."
2071 (let ((bos (save-excursion (idlwave-start-of-substatement 'pre) (point)))
2072 (bol (save-excursion (forward-line 0) (point)))
2073 expression)
2074 (save-excursion
2075 (goto-char apos)
2076 (setq expression (buffer-substring
2077 (catch 'exit
2078 (while t
2079 (if (not (re-search-backward
2080 "[^][.A-Za-z0-9_() ]" bos t))
2081 (throw 'exit bos)) ;ran into bos
2082 (if (not (idlwave-is-pointer-dereference bol))
2083 (throw 'exit (1+ (point))))))
2084 apos)))
2085 (when (not (string= expression ""))
2086 (setq idlwave-shell-get-object-class nil)
2087 (idlwave-shell-send-command
2088 (concat "if obj_valid(" expression ") then print,obj_class("
2089 expression ")")
2090 'idlwave-shell-parse-object-class
2091 'hide 'wait)
2092 ;; If we don't know anything about the class, update shell routines
2093 (if (and idlwave-shell-get-object-class
2094 (not (assoc-string idlwave-shell-get-object-class
2095 (idlwave-class-alist) t)))
2096 (idlwave-shell-maybe-update-routine-info))
2097 idlwave-shell-get-object-class)))
2099 (defun idlwave-shell-parse-object-class ()
2100 "Parse the output of the obj_class command."
2101 (let ((match "obj_class([^\n\r]+[\n\r ]"))
2102 (if (string-match (concat match "\\([A-Za-z_0-9]+\\) *[\n\r]\\("
2103 idlwave-shell-prompt-pattern "\\)")
2104 idlwave-shell-command-output)
2105 (setq idlwave-shell-get-object-class
2106 (match-string 1 idlwave-shell-command-output)))))
2108 (defvar idlwave-sint-sysvars nil)
2109 (idlwave-new-sintern-type 'execcomm)
2111 (defun idlwave-shell-complete (&optional arg)
2112 "Do completion in the idlwave-shell buffer.
2113 Calls `idlwave-shell-complete-filename' after some executive commands or
2114 in strings. Otherwise, calls `idlwave-complete' to complete modules and
2115 keywords."
2116 (interactive "P")
2117 (let (exec-cmd)
2118 (cond
2119 ((and
2120 (setq exec-cmd (idlwave-shell-executive-command))
2121 (cdr exec-cmd)
2122 (member (upcase (cdr exec-cmd))
2123 '(".R" ".RU" ".RUN" ".RN" ".RNE" ".RNEW"
2124 ".COM" ".COMP" ".COMPI" ".COMPIL" ".COMPILE")))
2125 ;; We are in a command line with an executive command
2126 (idlwave-shell-complete-filename))
2128 ((car-safe exec-cmd)
2129 (setq idlwave-completion-help-info
2130 '(idlwave-shell-complete-execcomm-help))
2131 (idlwave-complete-in-buffer 'execcomm 'execcomm
2132 idlwave-executive-commands-alist nil
2133 "Select an executive command"
2134 "system variable"))
2136 ((idlwave-shell-batch-command)
2137 (idlwave-shell-complete-filename))
2139 ((idlwave-shell-shell-command)
2140 (idlwave-shell-complete-filename))
2142 ((and (idlwave-shell-filename-string)
2143 (save-excursion
2144 (beginning-of-line)
2145 (let ((case-fold-search t))
2146 (not (looking-at ".*obj_new")))))
2147 (idlwave-shell-complete-filename))
2150 ;; Default completion of modules and keywords
2151 (idlwave-complete arg)))))
2153 ;; Get rid of opaque dynamic variable passing of idlw-help-link?
2154 (defvar idlw-help-link) ; dynamic variable from idlwave-do-mouse-completion-help
2155 (defun idlwave-shell-complete-execcomm-help (mode word)
2156 (let ((word (or (nth 1 idlwave-completion-help-info) word))
2157 (entry (assoc-string word idlwave-executive-commands-alist t)))
2158 (cond
2159 ((eq mode 'test)
2160 (and (stringp word) entry (cdr entry)))
2161 ((eq mode 'set)
2162 (if entry (setq idlw-help-link (cdr entry)))) ; setting dynamic variable!
2163 (t (error "This should not happen")))))
2165 (defun idlwave-shell-complete-filename (&optional arg)
2166 "Complete a file name at point if after a file name.
2167 We assume that we are after a file name when completing one of the
2168 args of an executive .run, .rnew or .compile."
2169 ;; CWD might have changed, resync, to set default directory
2170 (idlwave-shell-resync-dirs)
2171 (let ((comint-file-name-chars idlwave-shell-file-name-chars))
2172 (comint-dynamic-complete-filename)))
2174 (defun idlwave-shell-executive-command ()
2175 "Return the name of the current executive command, if any."
2176 (save-excursion
2177 (idlwave-beginning-of-statement)
2178 (cons (looking-at "[ \t]*\\.")
2179 (if (looking-at "[ \t]*[.]\\([^ \t\n\r]+\\)[ \t]")
2180 (match-string 1)))))
2182 (defun idlwave-shell-filename-string ()
2183 "Return t if in a string and after what could be a file name."
2184 (let ((limit (point-at-bol)))
2185 (save-excursion
2186 ;; Skip backwards over file name chars
2187 (skip-chars-backward idlwave-shell-file-name-chars limit)
2188 ;; Check of the next char is a string delimiter
2189 (memq (preceding-char) '(?\' ?\")))))
2191 (defun idlwave-shell-batch-command ()
2192 "Return t if we're in a batch command statement like @foo"
2193 (let ((limit (point-at-bol)))
2194 (save-excursion
2195 ;; Skip backwards over filename
2196 (skip-chars-backward idlwave-shell-file-name-chars limit)
2197 (skip-chars-backward " \t" limit)
2198 (and (eq (preceding-char) ?@) (not (idlwave-in-quote))))))
2200 (defun idlwave-shell-shell-command ()
2201 "Return t if we're in a shell command statement like $ls"
2202 (save-excursion
2203 (idlwave-beginning-of-statement)
2204 (looking-at "\\$")))
2206 ;; Debugging Commands ------------------------------------------------------
2208 (defun idlwave-shell-redisplay (&optional hide)
2209 "Try to resync the display with where execution has stopped.
2210 Issues a \"help,/trace\" command followed by a call to
2211 `idlwave-shell-display-line'. Also updates the breakpoint
2212 overlays."
2213 (interactive)
2214 (setq idlwave-shell-calling-stack-index 0)
2215 (idlwave-shell-send-command
2216 "help,/trace"
2217 '(idlwave-shell-display-line
2218 (idlwave-shell-pc-frame))
2219 hide)
2220 (idlwave-shell-bp-query))
2222 (defun idlwave-shell-display-level-in-calling-stack (&optional hide)
2223 (idlwave-shell-send-command
2224 "help,/trace"
2225 `(progn
2226 ;; scanning for the state will reset the stack level - restore it
2227 (setq idlwave-shell-calling-stack-index
2228 ,idlwave-shell-calling-stack-index)
2229 ;; parse the stack and visit the selected frame
2230 (idlwave-shell-parse-stack-and-display))
2231 hide))
2233 (defun idlwave-shell-parse-stack-and-display ()
2234 (let* ((lines (delete "" (idlwave-split-string
2235 idlwave-shell-command-output "^%")))
2236 (stack (delq nil (mapcar 'idlwave-shell-parse-line lines)))
2237 (nmax (1- (length stack)))
2238 (nmin 0) message)
2239 (cond
2240 ((< nmax nmin)
2241 (setq idlwave-shell-calling-stack-index 0)
2242 (ding)
2243 (message "Problem with calling stack"))
2244 ((> idlwave-shell-calling-stack-index nmax)
2245 (ding)
2246 (setq idlwave-shell-calling-stack-index nmax
2247 message (format "%d is the highest calling stack level - can't go further up"
2248 (- nmax))))
2249 ((< idlwave-shell-calling-stack-index nmin)
2250 (ding)
2251 (setq idlwave-shell-calling-stack-index nmin
2252 message (format "%d is the current calling stack level - can't go further down"
2253 (- nmin)))))
2254 (setq idlwave-shell-calling-stack-routine
2255 (nth 2 (nth idlwave-shell-calling-stack-index stack)))
2257 ;; force edebug for this frame if we're in that mode already
2258 (idlwave-shell-display-line
2259 (nth idlwave-shell-calling-stack-index stack) nil
2260 (if idlwave-shell-electric-debug-mode 'force))
2261 (message "%s" (or message
2262 (format "In routine %s (stack level %d)"
2263 idlwave-shell-calling-stack-routine
2264 (- idlwave-shell-calling-stack-index))))))
2266 (defun idlwave-shell-stack-up ()
2267 "Display the source code one step up the calling stack."
2268 (interactive)
2269 (incf idlwave-shell-calling-stack-index)
2270 (idlwave-shell-display-level-in-calling-stack 'hide))
2271 (defun idlwave-shell-stack-down ()
2272 "Display the source code one step down the calling stack."
2273 (interactive)
2274 (decf idlwave-shell-calling-stack-index)
2275 (idlwave-shell-display-level-in-calling-stack 'hide))
2277 (defun idlwave-shell-goto-frame (&optional frame)
2278 "Set buffer to FRAME with point at the frame line.
2279 If the optional argument FRAME is nil then `idlwave-shell-pc-frame'
2280 is used. Does nothing if the resulting frame is nil."
2281 (if frame ()
2282 (setq frame (idlwave-shell-pc-frame)))
2283 (cond
2284 (frame
2285 (set-buffer (idlwave-find-file-noselect (car frame) 'shell))
2286 (widen)
2287 (goto-char (point-min))
2288 (forward-line (1- (nth 1 frame))))))
2290 (defun idlwave-shell-pc-frame ()
2291 "Return the frame for IDL execution."
2292 (and idlwave-shell-halt-frame
2293 (list (nth 0 idlwave-shell-halt-frame)
2294 (nth 1 idlwave-shell-halt-frame)
2295 (nth 2 idlwave-shell-halt-frame))))
2297 (defun idlwave-shell-valid-frame (frame)
2298 "Check that frame is for an existing file."
2299 (file-readable-p (car frame)))
2301 (defun idlwave-shell-stop-line-pending ()
2302 ;; Temporarily change the color of the stop line overlay
2303 (if idlwave-shell-stop-line-overlay
2304 (overlay-put idlwave-shell-stop-line-overlay 'face
2305 (if idlwave-shell-electric-debug-mode
2306 'idlwave-shell-pending-electric-stop
2307 'idlwave-shell-pending-stop))))
2309 (defvar idlwave-shell-suppress-electric-debug nil)
2310 (defun idlwave-shell-display-line (frame &optional col debug)
2311 "Display frame file in other window with overlay arrow.
2313 FRAME is a list of file name, line number, and subroutine name. If
2314 FRAME is nil then remove overlay. If COL is set, move point to that
2315 column in the line. If DEBUG is non-nil, enable the electric debug
2316 mode. If it is 'disable, do not enable no matter what the setting of
2317 `idlwave-shell-automatic-electric-debug'. If it is 'force, enable no
2318 matter what the settings of that variable."
2319 (if (not frame)
2320 ;; remove stop-line overlay from old position
2321 (progn
2322 (setq overlay-arrow-string nil)
2323 (setq idlwave-shell-mode-line-info nil)
2324 (setq idlwave-shell-is-stopped nil)
2325 (if idlwave-shell-stop-line-overlay
2326 (delete-overlay idlwave-shell-stop-line-overlay))
2327 ;; turn off electric debug everywhere, if it's on
2328 (idlwave-shell-electric-debug-all-off))
2329 (if (not (idlwave-shell-valid-frame frame))
2330 ;; fixme: errors are dangerous in shell filters. but i think i
2331 ;; have never encountered this one.
2332 (error "invalid frame - unable to access file: %s" (car frame))
2334 ;; buffer : the buffer to display a line in.
2335 ;; select-shell: current buffer is the shell.
2337 (setq idlwave-shell-mode-line-info
2338 (if (nth 2 frame)
2339 (format "[%d:%s]"
2340 (- idlwave-shell-calling-stack-index)
2341 (nth 2 frame))))
2342 (let* ((buffer (idlwave-find-file-noselect (car frame) 'shell))
2343 (select-shell (equal (buffer-name) (idlwave-shell-buffer)))
2344 window pos electric)
2346 ;; first make sure the shell window is visible
2347 (idlwave-display-buffer (idlwave-shell-buffer)
2348 nil (idlwave-shell-shell-frame))
2350 ;; now display the buffer and remember which window it is.
2351 (setq window (idlwave-display-buffer buffer
2352 nil (idlwave-shell-source-frame)))
2354 ;; enter the buffer and mark the line
2355 (with-current-buffer buffer
2356 (save-restriction
2357 (widen)
2358 (goto-char (point-min))
2359 (forward-line (1- (nth 1 frame)))
2360 (setq pos (point))
2361 (setq idlwave-shell-is-stopped t)
2363 (if idlwave-shell-stop-line-overlay
2364 (progn
2365 ;; restore face and move overlay
2366 (overlay-put idlwave-shell-stop-line-overlay 'face
2367 (if idlwave-shell-electric-debug-mode
2368 idlwave-shell-electric-stop-line-face
2369 idlwave-shell-stop-line-face))
2370 (move-overlay idlwave-shell-stop-line-overlay
2371 (point) (point-at-eol)
2372 (current-buffer)))
2373 ;; use the arrow instead, but only if marking is wanted.
2374 (if idlwave-shell-mark-stop-line
2375 (setq overlay-arrow-string idlwave-shell-overlay-arrow))
2376 (or overlay-arrow-position ; create the marker if necessary
2377 (setq overlay-arrow-position (make-marker)))
2378 (set-marker overlay-arrow-position (point) buffer)))
2380 ;; if the point is outside the restriction, widen the buffer.
2381 (if (or (< pos (point-min)) (> pos (point-max)))
2382 (progn
2383 (widen)
2384 (goto-char pos)))
2386 ;; if we have the column of the error, move the cursor there.
2387 (if col (move-to-column col))
2388 (setq pos (point))
2390 ;; enter electric debug mode, if not prohibited and not in
2391 ;; it already
2392 (when (and (not idlwave-shell-electric-debug-mode)
2393 (or (eq debug 'force)
2394 (and
2395 (not (eq debug 'disable)) ;; explicitly disabled
2397 (eq idlwave-shell-automatic-electric-debug t)
2398 (and
2399 (eq idlwave-shell-automatic-electric-debug
2400 'breakpoint)
2401 (not (eq idlwave-shell-current-state 'error))))
2402 (not idlwave-shell-suppress-electric-debug))))
2403 (idlwave-shell-electric-debug-mode t))
2404 (setq electric idlwave-shell-electric-debug-mode))
2406 ;; Make sure pos is really displayed in the window.
2407 (set-window-point window pos)
2409 ;; If we came from the shell, go back there. Otherwise select
2410 ;; the window where the error/halt is displayed.
2411 (if (or (and idlwave-shell-electric-zap-to-file electric)
2412 (and (equal (buffer-name) (idlwave-shell-buffer))
2413 (not select-shell)))
2414 (select-window window))))))
2417 (defun idlwave-shell-step (arg)
2418 "Step one source line.
2419 If given prefix argument ARG, step ARG source lines."
2420 (interactive "p")
2421 (or (not arg) (< arg 1)
2422 (setq arg 1))
2423 (idlwave-shell-stop-line-pending)
2424 (idlwave-shell-send-command
2425 (concat ".s " (if (integerp arg) (int-to-string arg) arg))
2426 nil (if (idlwave-shell-hide-p 'debug) 'mostly) nil t))
2428 (defun idlwave-shell-stepover (arg)
2429 "Stepover one source line.
2430 If given prefix argument ARG, step ARG source lines.
2431 Uses IDL's stepover executive command which does not enter called functions."
2432 (interactive "p")
2433 (or (not arg) (< arg 1)
2434 (setq arg 1))
2435 (idlwave-shell-stop-line-pending)
2436 (idlwave-shell-send-command
2437 (concat ".so " (if (integerp arg) (int-to-string arg) arg))
2438 nil (if (idlwave-shell-hide-p 'debug) 'mostly) nil t))
2440 (defun idlwave-shell-break-here (&optional count cmd condition disabled
2441 no-show)
2442 "Set breakpoint at current line.
2444 If COUNT is nil then an ordinary breakpoint is set. We treat a COUNT
2445 of 1 as a temporary breakpoint using the ONCE keyword. Counts greater
2446 than 1 use the IDL AFTER=count keyword to break only after reaching
2447 the statement COUNT times.
2449 Optional argument CMD is a list or function to evaluate upon reaching
2450 the breakpoint. CONDITION is a break condition, and DISABLED, if
2451 non-nil disables the breakpoint."
2452 (interactive "P")
2453 (when (listp count)
2454 (if (equal (car count) 4)
2455 (setq condition (read-string "Break Condition: ")))
2456 (setq count nil))
2457 (idlwave-shell-set-bp
2458 ;; Create breakpoint
2459 (idlwave-shell-bp (idlwave-shell-current-frame)
2460 (list count cmd condition disabled)
2461 (idlwave-shell-current-module))
2462 no-show))
2464 (defun idlwave-shell-set-bp-check (bp)
2465 "Check for failure to set breakpoint.
2466 This is run on `idlwave-shell-post-command-hook'.
2467 Offers to recompile the procedure if we failed. This usually fixes
2468 the problem with not being able to set the breakpoint."
2469 ;; Scan for message
2470 (if idlwave-shell-command-output
2471 (cond
2472 ((string-match "% BREAKPOINT: *Unable to find code"
2473 idlwave-shell-command-output)
2474 ;; Offer to recompile
2475 (if (progn
2476 (beep)
2477 (y-or-n-p
2478 (concat "Okay to recompile file "
2479 (idlwave-shell-bp-get bp 'file) "?")))
2480 ;; Recompile
2481 (progn
2482 ;; Clean up before retrying
2483 (idlwave-shell-command-failure)
2484 (idlwave-shell-send-command
2485 (concat ".run \"" (idlwave-shell-bp-get bp 'file) "\"") nil
2486 (if (idlwave-shell-hide-p 'run) 'mostly) nil t)
2487 ;; Try setting breakpoint again
2488 (idlwave-shell-set-bp bp))
2489 (beep)
2490 (message "Unable to set breakpoint.")
2491 (idlwave-shell-command-failure))
2492 nil)
2494 ((string-match "% Syntax error" idlwave-shell-command-output)
2495 (message "Syntax error in condition.")
2496 (idlwave-shell-command-failure)
2497 nil)
2499 (t 'okay))))
2501 (defun idlwave-shell-command-failure ()
2502 "Do any necessary clean up when an IDL command fails.
2503 Call this from a function attached to `idlwave-shell-post-command-hook'
2504 that detects the failure of a command.
2505 For example, this is called from `idlwave-shell-set-bp-check' when a
2506 breakpoint can not be set."
2507 ;; Clear pending commands
2508 (setq idlwave-shell-pending-commands nil))
2510 (defun idlwave-shell-cont (&optional no-show)
2511 "Continue executing."
2512 (interactive)
2513 (idlwave-shell-stop-line-pending)
2514 (idlwave-shell-send-command ".c" (unless no-show
2515 '(idlwave-shell-redisplay 'hide))
2516 (if (idlwave-shell-hide-p 'debug) 'mostly)
2517 nil t))
2519 (defun idlwave-shell-go ()
2520 "Run .GO. This starts the main program of the last compiled file."
2521 (interactive)
2522 (idlwave-shell-stop-line-pending)
2523 (idlwave-shell-send-command ".go" '(idlwave-shell-redisplay 'hide)
2524 (if (idlwave-shell-hide-p 'debug) 'mostly)
2525 nil t))
2527 (defun idlwave-shell-return ()
2528 "Run .RETURN (continue to next return, but stay in subprogram)."
2529 (interactive)
2530 (idlwave-shell-stop-line-pending)
2531 (idlwave-shell-send-command ".return" '(idlwave-shell-redisplay 'hide)
2532 (if (idlwave-shell-hide-p 'debug) 'mostly)
2533 nil t))
2535 (defun idlwave-shell-skip ()
2536 "Run .SKIP (skip one line, then step)."
2537 (interactive)
2538 (idlwave-shell-stop-line-pending)
2539 (idlwave-shell-send-command ".skip" '(idlwave-shell-redisplay 'hide)
2540 (if (idlwave-shell-hide-p 'debug) 'mostly)
2541 nil t))
2543 (defun idlwave-shell-clear-bp (bp &optional no-query)
2544 "Clear breakpoint BP.
2545 Clears in IDL and in `idlwave-shell-bp-alist'."
2546 (let ((index (idlwave-shell-bp-get bp)))
2547 (if index
2548 (progn
2549 (idlwave-shell-send-command
2550 (concat "breakpoint,/clear," (int-to-string index))
2551 nil (idlwave-shell-hide-p 'breakpoint) nil t)
2552 (unless no-query (idlwave-shell-bp-query))))))
2554 (defun idlwave-shell-current-frame ()
2555 "Return a list containing the current file name and line point is in.
2556 If in the IDL shell buffer, returns `idlwave-shell-pc-frame'."
2557 (if (eq (current-buffer) (get-buffer (idlwave-shell-buffer)))
2558 ;; In IDL shell
2559 (idlwave-shell-pc-frame)
2560 ;; In source
2561 (list (idlwave-shell-file-name (buffer-file-name))
2562 (save-restriction
2563 (widen)
2564 (1+ (count-lines 1 (point-at-bol)))))))
2566 (defun idlwave-shell-current-module ()
2567 "Return the name of the module for the current file.
2568 Returns nil if unable to obtain a module name."
2569 (if (eq (current-buffer) (get-buffer (idlwave-shell-buffer)))
2570 ;; In IDL shell
2571 (nth 2 idlwave-shell-halt-frame)
2572 ;; In pro file
2573 (save-restriction
2574 (widen)
2575 (save-excursion
2576 (if (idlwave-prev-index-position)
2577 (let* ((module (idlwave-what-module))
2578 (name (idlwave-make-full-name (nth 2 module) (car module)))
2579 (type (nth 1 module)))
2580 (list (upcase name) type)))))))
2582 (defun idlwave-shell-clear-current-bp ()
2583 "Remove breakpoint at current line.
2584 This command can be called from the shell buffer if IDL is currently
2585 stopped at a breakpoint."
2586 (interactive)
2587 (let ((bp (idlwave-shell-find-current-bp)))
2588 (if bp (idlwave-shell-clear-bp bp))))
2591 (defun idlwave-shell-toggle-enable-current-bp (&optional bp force
2592 no-update)
2593 "Disable or enable current breakpoint or a breakpoint passed in BP.
2594 If FORCE is 'disable or 'enable, for that condition instead of
2595 toggling. If NO-UPDATE is non-nil, don't update the breakpoint
2596 list after toggling."
2597 (interactive)
2598 (let* ((bp (or bp (idlwave-shell-find-current-bp)))
2599 (disabled (idlwave-shell-bp-get bp 'disabled)))
2600 (cond ((eq force 'disable) (setq disabled nil))
2601 ((eq force 'enable) (setq disabled t)))
2602 (when bp
2603 (setf (nth 3 (cdr (cdr bp))) (not disabled))
2604 (idlwave-shell-send-command
2605 (concat "breakpoint,"
2606 (if disabled "/enable," "/disable,")
2607 (int-to-string (idlwave-shell-bp-get bp)))
2608 nil (idlwave-shell-hide-p 'breakpoint) nil t)
2609 (unless no-update (idlwave-shell-bp-query)))))
2611 (defun idlwave-shell-enable-all-bp (&optional enable no-update bpl)
2612 "Disable all breakpoints we know about which need disabling.
2613 If ENABLE is non-nil, enable them instead."
2614 (let ((bpl (or bpl idlwave-shell-bp-alist)) disabled modified)
2615 (while bpl
2616 (setq disabled (idlwave-shell-bp-get (car bpl) 'disabled))
2617 (when (idlwave-xor (not disabled) (eq enable 'enable))
2618 (idlwave-shell-toggle-enable-current-bp
2619 (car bpl) (if (eq enable 'enable) 'enable 'disable) no-update)
2620 (push (car bpl) modified))
2621 (setq bpl (cdr bpl)))
2622 (unless no-update (idlwave-shell-bp-query))
2623 modified))
2625 (defun idlwave-shell-to-here ()
2626 "Set a breakpoint with count 1 then continue."
2627 (interactive)
2628 ;; temporarily disable all other breakpoints
2629 (let ((disabled (idlwave-shell-enable-all-bp 'disable 'no-update)))
2630 (idlwave-shell-break-here 1 nil nil nil 'no-show)
2631 (idlwave-shell-cont 'no-show)
2632 (idlwave-shell-enable-all-bp 'enable 'no-update disabled))
2633 (idlwave-shell-redisplay)) ; sync up everything at the end
2635 (defun idlwave-shell-break-this-module (&optional arg)
2636 (interactive "P")
2637 (save-excursion
2638 (idlwave-beginning-of-subprogram)
2639 (idlwave-shell-break-here arg)))
2641 (defun idlwave-shell-break-in ()
2642 "Look for a module name near point and set a break point for it.
2643 The command looks for an identifier near point and sets a breakpoint
2644 for the first line of the corresponding module. If MODULE is `t', set
2645 in the current routine."
2646 (interactive)
2647 (let* ((module (idlwave-fix-module-if-obj_new (idlwave-what-module)))
2648 (type (nth 1 module))
2649 (name (car module))
2650 (class (nth 2 module)))
2651 (if module
2652 (progn
2653 (setq module (idlwave-make-full-name class name))
2654 (idlwave-shell-module-source-query module type)
2655 (idlwave-shell-set-bp-in-module name type class))
2656 (error "No identifier at point"))))
2659 (defun idlwave-shell-set-bp-in-module (name type class)
2660 "Set breakpoint in module.
2661 Assumes that `idlwave-shell-sources-alist' contains an entry for that module."
2662 (let* ((module (idlwave-make-full-name class name))
2663 (source-file
2664 (car-safe (cdr-safe
2666 (assoc (upcase module)
2667 idlwave-shell-sources-alist)
2668 (nth 3 (idlwave-best-rinfo-assoc name type class
2669 (idlwave-routines)))))))
2670 buf)
2671 (if (or (not source-file)
2672 (not (file-regular-p source-file))
2673 (not (setq buf
2674 (or (idlwave-get-buffer-visiting source-file)
2675 (find-file-noselect source-file)))))
2676 (progn
2677 (message "The source file for module %s is probably not compiled"
2678 module)
2679 (beep))
2680 (with-current-buffer buf
2681 (save-excursion
2682 (goto-char (point-min))
2683 (let ((case-fold-search t))
2684 (if (re-search-forward
2685 (concat "^[ \t]*\\(pro\\|function\\)[ \t]+"
2686 (downcase module)
2687 "[ \t\n,]") nil t)
2688 (progn
2689 (goto-char (match-beginning 1))
2690 (message "Setting breakpoint for module %s" module)
2691 (idlwave-shell-break-here))
2692 (message "Cannot find module %s in file %s" module source-file)
2693 (beep))))))))
2695 (defun idlwave-shell-up ()
2696 "Run to end of current block.
2697 Sets a breakpoint with count 1 at end of block, then continues."
2698 (interactive)
2699 (if (idlwave-shell-pc-frame)
2700 (save-excursion
2701 (idlwave-shell-goto-frame)
2702 ;; find end of subprogram
2703 (let ((eos (save-excursion
2704 (idlwave-beginning-of-subprogram)
2705 (idlwave-forward-block)
2706 (point))))
2707 (idlwave-backward-up-block -1)
2708 ;; move beyond end block line - IDL will not break there.
2709 ;; That is, you can put a breakpoint there but when IDL does
2710 ;; break it will report that it is at the next line.
2711 (idlwave-next-statement)
2712 (idlwave-end-of-statement)
2713 ;; Make sure we are not beyond subprogram
2714 (if (< (point) eos)
2715 ;; okay
2717 ;; Move back inside subprogram
2718 (goto-char eos)
2719 (idlwave-previous-statement))
2720 (idlwave-shell-to-here)))))
2722 (defun idlwave-shell-out ()
2723 "Attempt to run until this procedure exits.
2724 Runs to the last statement and then steps 1 statement. Use the .out command."
2725 (interactive)
2726 (idlwave-shell-send-command ".o" nil
2727 (if (idlwave-shell-hide-p 'debug) 'mostly)
2728 nil t))
2730 (defun idlwave-shell-goto-previous-bp ()
2731 "Move to the previous breakpoint in the buffer."
2732 (interactive)
2733 (idlwave-shell-move-to-bp -1))
2734 (defun idlwave-shell-goto-next-bp ()
2735 "Move to the next breakpoint in the buffer."
2736 (interactive)
2737 (idlwave-shell-move-to-bp 1))
2739 (defun idlwave-shell-move-to-bp (dir)
2740 "Move to the next or previous breakpoint, depending on direction DIR."
2741 (let* ((frame (idlwave-shell-current-frame))
2742 (file (car frame))
2743 (orig-bp-line (nth 1 frame))
2744 (bp-alist idlwave-shell-bp-alist)
2745 (orig-func (if (> dir 0) '> '<))
2746 (closer-func (if (> dir 0) '< '>))
2747 bp got-bp bp-line cur-line)
2748 (while (setq bp (pop bp-alist))
2749 (when (string= file (car (car bp)))
2750 (setq got-bp 1)
2751 (setq cur-line (nth 1 (car bp)))
2752 (if (and
2753 (funcall orig-func cur-line orig-bp-line)
2754 (or (not bp-line) (funcall closer-func cur-line bp-line)))
2755 (setq bp-line cur-line))))
2756 (unless bp-line (error "No further breakpoints"))
2757 (goto-char (point-min))
2758 (forward-line (1- bp-line))))
2760 ;; Examine Commands ------------------------------------------------------
2762 (defun idlwave-shell-help-expression (arg)
2763 "Print help on current expression. See `idlwave-shell-print'."
2764 (interactive "P")
2765 (idlwave-shell-print arg 'help))
2767 (defmacro idlwave-shell-mouse-examine (help &optional ev)
2768 "Create a function for generic examination of expressions."
2769 `(lambda (event)
2770 "Expansion function for expression examination."
2771 (interactive "e")
2772 (let* ((drag-track (fboundp 'mouse-drag-track))
2773 (transient-mark-mode t)
2774 (zmacs-regions t)
2775 (tracker (if (featurep 'xemacs)
2776 (if (fboundp
2777 'default-mouse-track-event-is-with-button)
2778 'idlwave-xemacs-hack-mouse-track
2779 'mouse-track)
2780 ;; Emacs 22 no longer completes the drag with
2781 ;; mouse-drag-region, without an additional
2782 ;; event. mouse-drag-track does so.
2783 (if drag-track 'mouse-drag-track 'mouse-drag-region))))
2784 (funcall tracker event)
2785 (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil)
2786 ,help ,ev))))
2788 ;; Begin terrible hack section -- XEmacs tests for button2 explicitly
2789 ;; on drag events, calling drag-n-drop code if detected. Ughhh...
2790 (defun idlwave-default-mouse-track-event-is-with-button (event n)
2793 (defun idlwave-xemacs-hack-mouse-track (event)
2794 (if (featurep 'xemacs)
2795 (let ((oldfunc (symbol-function
2796 'default-mouse-track-event-is-with-button)))
2797 (unwind-protect
2798 (progn
2799 (fset 'default-mouse-track-event-is-with-button
2800 'idlwave-default-mouse-track-event-is-with-button)
2801 (mouse-track event))
2802 (fset 'default-mouse-track-event-is-with-button oldfunc)))))
2803 ;;; End terrible hack section
2805 (defun idlwave-shell-mouse-print (event)
2806 "Print value of variable at the mouse position, with `print'."
2807 (interactive "e")
2808 (funcall (idlwave-shell-mouse-examine nil) event))
2810 (defun idlwave-shell-mouse-help (event)
2811 "Print value of variable at the mouse position, with `help'."
2812 (interactive "e")
2813 (funcall (idlwave-shell-mouse-examine 'help) event))
2815 (defun idlwave-shell-examine-select (event)
2816 "Pop-up a list to select from for examining the expression."
2817 (interactive "e")
2818 (funcall (idlwave-shell-mouse-examine nil event) event))
2820 (defmacro idlwave-shell-examine (help)
2821 "Create a function for key-driven expression examination."
2822 `(lambda ()
2823 (interactive)
2824 (idlwave-shell-print nil ,help)))
2826 (defvar idlwave-shell-examine-label nil
2827 "Label to include with examine text if in a separate buffer.")
2828 (defvar idlwave-shell-examine-completion-list nil)
2830 (defun idlwave-shell-print (arg &optional help ev complete-help-type)
2831 "Print current expression.
2833 With HELP non-nil, show help on expression. If HELP is a string,
2834 the expression will be put in place of ___, e.g.:
2836 print,size(___,/DIMENSIONS)
2838 HELP can also be a cons cell ( NAME . STRING ) in which case NAME will
2839 be used to label the help print-out.
2841 Otherwise, print is called on the expression.
2843 An expression is an identifier plus 1 pair of matched parentheses
2844 directly following the identifier - an array or function call.
2845 Alternatively, an expression is the contents of any matched
2846 parentheses when the open parenthesis is not directly preceded by an
2847 identifier. If point is at the beginning or within an expression
2848 return the inner-most containing expression, otherwise, return the
2849 preceding expression.
2851 With prefix arg, or if transient mode set and the region is defined,
2852 use the current region as the expression.
2854 With double prefix arg ARG prompt for an expression.
2856 If EV is a valid event passed, pop-up a list from
2857 `idlwave-shell-examine-alist' from which to select the help
2858 command text. If instead COMPLETE-HELP-TYPE is non-nil, choose
2859 from `idlwave-shell-examine-alist' via mini-buffer shortcut key."
2860 (interactive "P")
2862 ;; For speed: assume the helper routine hasn't been lost, e.g. with
2863 ;; .FULL_RESET_SESSION. We'll recover if necessary
2864 (unless idlwave-idlwave_routine_info-compiled
2865 (idlwave-shell-compile-helper-routines))
2866 (save-excursion
2867 (let* ((process (get-buffer-process (current-buffer)))
2868 (process-mark (if process (process-mark process)))
2869 (stack-label
2870 (if (and (integerp idlwave-shell-calling-stack-index)
2871 (> idlwave-shell-calling-stack-index 0))
2872 (format " [-%d:%s]"
2873 idlwave-shell-calling-stack-index
2874 idlwave-shell-calling-stack-routine)))
2875 expr beg end cmd)
2876 (cond
2877 ((equal arg '(16))
2878 (setq expr (read-string "Expression: ")))
2879 ((and (or arg (idlwave-region-active-p))
2880 (< (- (region-end) (region-beginning)) 2000))
2881 (setq beg (region-beginning)
2882 end (region-end)))
2884 (idlwave-with-special-syntax
2885 ;; Move to beginning of current or previous expression
2886 (if (looking-at "\\<\\|(")
2887 ;; At beginning of expression, don't move backwards unless
2888 ;; this is at the end of an identifier.
2889 (if (looking-at "\\>")
2890 (backward-sexp))
2891 (backward-sexp))
2892 (if (looking-at "\\>")
2893 ;; Move to beginning of identifier - must be an array or
2894 ;; function expression.
2895 (backward-sexp))
2896 ;; Move to end of expression
2897 (setq beg (point))
2898 (forward-sexp)
2899 (while (looking-at "\\>[[(]\\|\\.")
2900 ;; an array
2901 (forward-sexp))
2902 (setq end (point)))))
2904 ;; Get expression, but first move the begin mark if a
2905 ;; process-mark is inside the region, to keep the overlay from
2906 ;; wandering in the Shell.
2907 (when (and beg end)
2908 (if (and process-mark (> process-mark beg) (< process-mark end))
2909 (setq beg (marker-position process-mark)))
2910 (setq expr (buffer-substring beg end)))
2912 ;; Show the overlay(s) and attach any necessary hooks and filters
2913 (when (and beg end idlwave-shell-expression-overlay)
2914 (move-overlay idlwave-shell-expression-overlay beg end
2915 (current-buffer))
2916 (add-hook 'pre-command-hook
2917 'idlwave-shell-delete-expression-overlay))
2918 (add-hook 'pre-command-hook
2919 'idlwave-shell-delete-output-overlay)
2921 ;; Remove empty or comment-only lines
2922 (while (string-match "\n[ \t]*\\(;.*\\)?\r*\n" expr)
2923 (setq expr (replace-match "\n" t t expr)))
2924 ;; Concatenate continuation lines
2925 (while (string-match "[ \t]*\\$[ \t]*\\(;.*\\)?\\(\n[ \t]*\\|$\\)" expr)
2926 (setq expr (replace-match "" t t expr)))
2927 ;; Remove final newline
2928 (if (string-match "\n[ \t\r]*\\'" expr)
2929 (setq expr (replace-match "" t t expr)))
2931 (catch 'exit
2932 ;; Pop-up or complete on the examine selection list, if appropriate
2933 (if (or
2934 complete-help-type
2935 (and ev idlwave-shell-examine-alist)
2936 (consp help))
2937 (let ((help-cons
2938 (if (consp help) help
2939 (assoc
2940 ;; A cons from either a pop-up or mini-buffer completion
2941 (if complete-help-type
2942 (idlwave-one-key-select 'idlwave-shell-examine-alist
2943 "Examine with: " 1.5)
2944 ;; (idlwave-completing-read
2945 ;; "Examine with: "
2946 ;; idlwave-shell-examine-alist nil nil nil
2947 ;; 'idlwave-shell-examine-completion-list
2948 ;; "Print")
2949 (idlwave-popup-select
2951 (mapcar 'car idlwave-shell-examine-alist)
2952 "Examine with"))
2953 idlwave-shell-examine-alist))))
2954 (setq help (cdr help-cons))
2955 (if (null help) (throw 'exit nil))
2956 (if idlwave-shell-separate-examine-output
2957 (setq idlwave-shell-examine-label
2958 (concat
2959 (format "==>%s<==\n%s:" expr (car help-cons))
2960 stack-label "\n"))))
2961 ;; The regular help label (no popups, cons cells, etc.)
2962 (setq idlwave-shell-examine-label
2963 (concat
2964 (format "==>%s<==\n%s:" expr
2965 (cond ((null help) "print")
2966 ((stringp help) help)
2967 (t (symbol-name help))))
2968 stack-label "\n")))
2970 ;; Send the command
2971 (if stack-label
2972 (setq expr (idlwave-retrieve-expression-from-level
2973 expr
2974 idlwave-shell-calling-stack-index)))
2975 (setq cmd (idlwave-shell-help-statement help expr))
2976 ;;(idlwave-shell-recenter-shell-window)
2977 (idlwave-shell-send-command
2979 'idlwave-shell-check-compiled-and-display
2980 (if idlwave-shell-separate-examine-output 'hide))))))
2982 (defvar idlwave-shell-examine-window-alist nil
2983 "Variable to hold the win/height pairs for all *Examine* windows.")
2985 (defvar idlwave-shell-examine-map (make-sparse-keymap))
2986 (define-key idlwave-shell-examine-map "q" 'idlwave-shell-examine-display-quit)
2987 (define-key idlwave-shell-examine-map "c" 'idlwave-shell-examine-display-clear)
2990 (defun idlwave-shell-check-compiled-and-display ()
2991 "Check examine output for warning about undefined procedure/function."
2992 (if (string-match "% Attempt to call undefined" idlwave-shell-command-output)
2993 (idlwave-shell-compile-helper-routines))
2994 (if idlwave-shell-separate-examine-output
2995 (idlwave-shell-examine-display)
2996 (idlwave-shell-examine-highlight)))
2998 (defun idlwave-shell-examine-display ()
2999 "View the examine command output in a separate buffer."
3000 (let (win cur-beg cur-end)
3001 (with-current-buffer (get-buffer-create "*Examine*")
3002 (use-local-map idlwave-shell-examine-map)
3003 (setq buffer-read-only nil)
3004 (goto-char (point-max))
3005 (save-restriction
3006 (narrow-to-region (point) (point))
3007 (if (string-match "^% Syntax error." idlwave-shell-command-output)
3008 (insert "% Syntax error.\n")
3009 (insert idlwave-shell-command-output)
3010 ;; Just take the last bit between the prompts (if more than one).
3011 (let* ((end (or
3012 (re-search-backward idlwave-shell-prompt-pattern nil t)
3013 (point-max)))
3014 (beg (progn
3015 (goto-char
3016 (or (progn (if (re-search-backward
3017 idlwave-shell-prompt-pattern nil t)
3018 (match-end 0)))
3019 (point-min)))
3020 (re-search-forward "\n")))
3021 (str (buffer-substring beg end)))
3022 (delete-region (point-min) (point-max))
3023 (insert str)
3024 (if idlwave-shell-examine-label
3025 (progn (goto-char (point-min))
3026 (insert idlwave-shell-examine-label)
3027 (setq idlwave-shell-examine-label nil)))))
3028 (setq cur-beg (point-min)
3029 cur-end (point-max))
3030 (setq buffer-read-only t)
3031 (move-overlay idlwave-shell-output-overlay cur-beg cur-end
3032 (current-buffer))
3034 ;; Look for the examine buffer in all windows. If one is
3035 ;; found in a frame all by itself, use that, otherwise, switch
3036 ;; to or create an examine window in this frame, and resize if
3037 ;; it's a newly created window
3038 (let* ((winlist (get-buffer-window-list "*Examine*" nil 'visible)))
3039 (setq win (idlwave-display-buffer
3040 "*Examine*"
3042 (let ((list winlist) thiswin)
3043 (catch 'exit
3044 (save-selected-window
3045 (while (setq thiswin (pop list))
3046 (select-window thiswin)
3047 (if (one-window-p)
3048 (throw 'exit (window-frame thiswin)))))))))
3049 (set-window-start win (point-min)) ; Ensure the point is visible.
3050 (save-selected-window
3051 (select-window win)
3052 (let ((elt (assoc win idlwave-shell-examine-window-alist)))
3053 (when (and (not (one-window-p))
3054 (or (not (memq win winlist)) ;a newly created window
3055 (eq (window-height) (cdr elt))))
3056 ;; Autosize it.
3057 (enlarge-window (- (/ (frame-height) 2)
3058 (window-height)))
3059 (shrink-window-if-larger-than-buffer)
3060 ;; Clean the window list of dead windows
3061 (setq idlwave-shell-examine-window-alist
3062 (delq nil
3063 (mapcar (lambda (x) (if (window-live-p (car x)) x))
3064 idlwave-shell-examine-window-alist)))
3065 ;; And add the new value.
3066 (if (setq elt (assoc win idlwave-shell-examine-window-alist))
3067 (setcdr elt (window-height))
3068 (add-to-list 'idlwave-shell-examine-window-alist
3069 (cons win (window-height)))))))))
3070 ;; Recenter for maximum output, after widened
3071 (save-selected-window
3072 (select-window win)
3073 (goto-char (point-max))
3074 (skip-chars-backward "\n")
3075 (recenter -1)))))
3077 (defun idlwave-shell-examine-display-quit ()
3078 (interactive)
3079 (let ((win (selected-window)))
3080 (if (one-window-p)
3081 (delete-frame (window-frame win))
3082 (delete-window win))))
3084 (defun idlwave-shell-examine-display-clear ()
3085 (interactive)
3086 (let ((buf (get-buffer "*Examine*")))
3087 (when (bufferp buf)
3088 (with-current-buffer buf
3089 (let ((inhibit-read-only t))
3090 (erase-buffer))))))
3092 (defun idlwave-retrieve-expression-from-level (expr level)
3093 "Return IDL command to print the expression EXPR from stack level LEVEL.
3095 It does not seem possible to evaluate an expression on a different
3096 level than the current. Therefore, this function retrieves variables
3097 by reference from other levels, and then includes that variable in
3098 place of the chosen one.
3100 Since this function depends upon the undocumented IDL routine
3101 routine_names, there is no guarantee that this will work with future
3102 versions of IDL."
3103 (let ((fetch (- 0 level))
3104 (start 0)
3105 var fetch-start fetch-end pre post)
3107 ;; FIXME: In the following we try to find the variables in expression
3108 ;; This is quite empirical - I don't know in what situations this will
3109 ;; break. We will look for identifiers and exclude cases where we
3110 ;; know it is not a variable. To distinguish array references from
3111 ;; function calls, we require that arrays use [] instead of ()
3113 (while (string-match
3114 "\\(\\`\\|[^a-zA-Z0-9$_][ \t]*\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)\\([ \t]*[^a-zA-Z0-9$_]\\|\\'\\)" expr start)
3115 (setq var (match-string 2 expr)
3116 start (match-end 2)
3117 pre (substring expr 0 (match-beginning 2))
3118 post (substring expr (match-end 2)))
3119 (cond
3120 ((or
3121 ;; Exclude identifiers which are not variables
3122 (string-match ",[ \t$\n]*/\\'" pre) ;; a `/' KEYWORD
3123 (and (string-match "[,(][ \t\n]*\\'" pre)
3124 (string-match "\\`[ \t]*=" post)) ;; a `=' KEYWORD
3125 (string-match "\\`(" post) ;; a function
3126 (string-match "->[ \t]*\\'" pre) ;; a method
3127 (string-match "\\.\\'" pre))) ;; structure member
3129 ;; Skip over strings
3130 ((and (string-match "\\([\"\']\\)[^\1]*$" pre)
3131 (string-match (concat "^[^" (match-string 1 pre) "]*"
3132 (match-string 1 pre)) post))
3133 (setq start (+ start (match-end 0))))
3136 ;; seems to be a variable - delimit its name
3138 (put-text-property start (- start (length var)) 'fetch t expr))))
3140 (setq start 0)
3141 (while (setq fetch-start
3142 (next-single-property-change start 'fetch expr))
3143 (if (get-text-property start 'fetch expr) ; it's on in range
3144 (setq fetch-end fetch-start ;it's off in range
3145 fetch-start start)
3146 (setq fetch-end (next-single-property-change fetch-start 'fetch expr)))
3147 (unless fetch-end (setq fetch-end (length expr)))
3148 (remove-text-properties fetch-start fetch-end '(fetch) expr)
3149 (setq expr (concat (substring expr 0 fetch-start)
3150 (format "(routine_names('%s',fetch=%d))"
3151 (substring expr fetch-start fetch-end)
3152 fetch)
3153 (substring expr fetch-end)))
3154 (setq start fetch-end))
3155 (if (get-text-property 0 'fetch expr) ; Full expression, left over
3156 (setq expr (format "(routine_names('%s',fetch=%d))" expr fetch)))
3157 expr))
3160 (defun idlwave-shell-help-statement (help expr)
3161 "Construct a help statement for printing expression EXPR.
3163 HELP can be non-nil for `help,', nil for 'print,' or any string into which
3164 to insert expression in place of the marker ___, e.g.: print,
3165 size(___,/DIMENSIONS)"
3166 (cond
3167 ((null help)
3168 (concat "idlwave_print_safe, " expr ","
3169 (number-to-string idlwave-shell-max-print-length)))
3170 ((stringp help)
3171 (if (string-match "\\(^\\|[^_]\\)\\(___\\)\\([^_]\\|$\\)" help)
3172 (concat (substring help 0 (match-beginning 2))
3173 expr
3174 (substring help (match-end 2)))))
3176 (concat "help, " expr))))
3179 (defun idlwave-shell-examine-highlight ()
3180 "Highlight the most recent IDL output."
3181 (let* ((buffer (get-buffer (idlwave-shell-buffer)))
3182 (process (get-buffer-process buffer))
3183 (process-mark (if process (process-mark process)))
3184 output-begin output-end)
3185 (with-current-buffer buffer
3186 (goto-char process-mark)
3187 (beginning-of-line)
3188 (setq output-end (point))
3189 (re-search-backward idlwave-shell-prompt-pattern nil t)
3190 (beginning-of-line 2)
3191 (setq output-begin (point)))
3193 ;; First make sure the shell window is visible
3194 (idlwave-display-buffer (idlwave-shell-buffer)
3195 nil (idlwave-shell-shell-frame))
3196 (if (and idlwave-shell-output-overlay process-mark)
3197 (move-overlay idlwave-shell-output-overlay
3198 output-begin output-end buffer))))
3200 (defun idlwave-shell-delete-output-overlay ()
3201 (unless (or (eq this-command 'idlwave-shell-mouse-nop)
3202 (eq this-command 'handle-switch-frame))
3203 (condition-case nil
3204 (if idlwave-shell-output-overlay
3205 (delete-overlay idlwave-shell-output-overlay))
3206 (error nil))
3207 (remove-hook 'pre-command-hook 'idlwave-shell-delete-output-overlay)))
3209 (defun idlwave-shell-delete-expression-overlay ()
3210 (unless (or (eq this-command 'idlwave-shell-mouse-nop)
3211 (eq this-command 'handle-switch-frame))
3212 (condition-case nil
3213 (if idlwave-shell-expression-overlay
3214 (delete-overlay idlwave-shell-expression-overlay))
3215 (error nil))
3216 (remove-hook 'pre-command-hook 'idlwave-shell-delete-expression-overlay)))
3218 (defvar idlwave-shell-bp-alist nil
3219 "Alist of breakpoints.
3220 A breakpoint is a cons cell \(\(file line\) . \(\(index module\) data\)\)
3222 The car is the `frame' for the breakpoint:
3223 file - full path file name.
3224 line - line number of breakpoint - integer.
3226 The first element of the cdr is a list of internal IDL data:
3227 index - the index number of the breakpoint internal to IDL.
3228 module - the module for breakpoint internal to IDL.
3230 Remaining elements of the cdr:
3231 data - Data associated with the breakpoint by idlwave-shell currently
3232 contains four items:
3234 count - number of times to execute breakpoint. When count reaches 0
3235 the breakpoint is cleared and removed from the alist.
3237 command - command to execute when breakpoint is reached, either a
3238 lisp function to be called with `funcall' with no arguments or a
3239 list to be evaluated with `eval'.
3241 condition - any condition to apply to the breakpoint.
3243 disabled - whether the bp is disabled.")
3245 (defun idlwave-shell-run-region (beg end &optional n)
3246 "Compile and run the region using the IDL process.
3247 Copies the region to a temporary file `idlwave-shell-temp-pro-file'
3248 and issues the IDL .run command for the file. Because the region
3249 is compiled and run as a main program there is no problem with
3250 begin-end blocks extending over multiple lines - which would be
3251 a problem if `idlwave-shell-evaluate-region' was used.
3252 An END statement is appended to the region if necessary.
3254 If there is a prefix argument, display IDL process."
3255 (interactive "r\nP")
3256 (let ((oldbuf (current-buffer)))
3257 (with-current-buffer (idlwave-find-file-noselect
3258 (idlwave-shell-temp-file 'pro) 'tmp)
3259 (set (make-local-variable 'comment-start-skip) ";+[ \t]*")
3260 (set (make-local-variable 'comment-start) ";")
3261 (erase-buffer)
3262 (insert-buffer-substring oldbuf beg end)
3263 (if (not (save-excursion
3264 (idlwave-previous-statement)
3265 (idlwave-look-at "\\<end\\>")))
3266 (insert "\nend\n"))
3267 (save-buffer 0)))
3268 (idlwave-shell-send-command (concat ".run \""
3269 idlwave-shell-temp-pro-file "\"")
3271 (if (idlwave-shell-hide-p 'run) 'mostly)
3272 nil t)
3273 (if n
3274 (idlwave-display-buffer (idlwave-shell-buffer)
3275 nil (idlwave-shell-shell-frame))))
3277 (defun idlwave-shell-evaluate-region (beg end &optional n)
3278 "Send region to the IDL process.
3279 If there is a prefix argument, display IDL process.
3280 Does not work for a region with multiline blocks - use
3281 `idlwave-shell-run-region' for this."
3282 (interactive "r\nP")
3283 (idlwave-shell-send-command (buffer-substring beg end))
3284 (if n
3285 (idlwave-display-buffer (idlwave-shell-buffer)
3286 nil (idlwave-shell-shell-frame))))
3288 (defun idlwave-shell-delete-temp-files ()
3289 "Delete the temporary files and kill associated buffers."
3290 (if (stringp idlwave-shell-temp-pro-file)
3291 (condition-case nil
3292 (let ((buf (idlwave-get-buffer-visiting
3293 idlwave-shell-temp-pro-file)))
3294 (if (buffer-live-p buf)
3295 (kill-buffer buf))
3296 (delete-file idlwave-shell-temp-pro-file))
3297 (error nil)))
3298 (if (stringp idlwave-shell-temp-rinfo-save-file)
3299 (condition-case nil
3300 (delete-file idlwave-shell-temp-rinfo-save-file)
3301 (error nil))))
3303 (defun idlwave-display-buffer (buf not-this-window-p &optional frame)
3304 (if (featurep 'xemacs)
3305 ;; The XEmacs version enforces the frame
3306 (display-buffer buf not-this-window-p frame)
3307 ;; For Emacs, we need to force the frame ourselves.
3308 (let ((this-frame (selected-frame)))
3309 (save-excursion ;; make sure we end up in the same buffer
3310 (if (frame-live-p frame)
3311 (select-frame frame))
3312 (if (eq this-frame (selected-frame))
3313 ;; same frame: use display buffer, to make sure the current
3314 ;; window stays.
3315 (display-buffer buf)
3316 ;; different frame
3317 (if (one-window-p)
3318 ;; only window: switch
3319 (progn
3320 (switch-to-buffer buf)
3321 (selected-window)) ; must return the window.
3322 ;; several windows - use display-buffer
3323 (display-buffer buf not-this-window-p)))))))
3324 ; (if (not (frame-live-p frame)) (setq frame nil))
3325 ; (display-buffer buf not-this-window-p frame))
3327 (defvar idlwave-shell-bp-buffer " *idlwave-shell-bp*"
3328 "Scratch buffer for parsing IDL breakpoint lists and other stuff.")
3330 (defun idlwave-shell-bp-query (&optional no-show)
3331 "Reconcile idlwave-shell's breakpoint list with IDL's.
3332 Queries IDL using the string in `idlwave-shell-bp-query'."
3333 (interactive)
3334 (idlwave-shell-send-command idlwave-shell-bp-query
3335 `(progn
3336 (idlwave-shell-filter-bp (quote ,no-show)))
3337 'hide))
3339 (defun idlwave-shell-bp-get (bp &optional item)
3340 "Get a value for a breakpoint.
3341 BP has the form of elements in `idlwave-shell-bp-alist'.
3342 Optional second arg ITEM is the particular value to retrieve.
3343 ITEM can be 'file, 'line, 'index, 'module, 'count, 'cmd,
3344 'condition, 'disabled, 'type, or 'data. 'data returns a list
3345 of 'count, 'cmd and 'condition. Defaults to 'index."
3346 (cond
3347 ;; Frame
3348 ((eq item 'line) (nth 1 (car bp)))
3349 ((eq item 'file) (nth 0 (car bp)))
3350 ;; idlwave-shell breakpoint data
3351 ((eq item 'data) (cdr (cdr bp)))
3352 ((eq item 'count) (nth 0 (cdr (cdr bp))))
3353 ((eq item 'cmd) (nth 1 (cdr (cdr bp))))
3354 ((eq item 'condition) (nth 2 (cdr (cdr bp))))
3355 ((eq item 'disabled) (nth 3 (cdr (cdr bp))))
3356 ;; IDL breakpoint info
3357 ((eq item 'module)
3358 (let ((module (nth 1 (car (cdr bp)))))
3359 (if (listp module) (car module) module)))
3360 ((eq item 'type)
3361 (let ((module (nth 1 (car (cdr bp)))))
3362 (if (listp module) (nth 1 module))))
3363 ;; index - default
3364 (t (nth 0 (car (cdr bp))))))
3366 (defun idlwave-shell-filter-bp (&optional no-show)
3367 "Get the breakpoints from `idlwave-shell-command-output'.
3368 Create `idlwave-shell-bp-alist' updating breakpoint count and command
3369 data from previous breakpoint list. If NO-SHOW is set, don't update
3370 the breakpoint overlays."
3371 (with-current-buffer (get-buffer-create idlwave-shell-bp-buffer)
3372 (erase-buffer)
3373 (insert idlwave-shell-command-output)
3374 (goto-char (point-min))
3375 (let ((old-bp-alist idlwave-shell-bp-alist)
3376 ;; Searching the breakpoints
3377 ;; In IDL 5.5, the breakpoint reporting format changed.
3378 (bp-re54 "^[ \t]*\\([0-9]+\\)[ \t]+\\(\\S-+\\)?[ \t]+\\([0-9]+\\)[ \t]+\\(\\S-+\\)")
3379 (bp-re55
3380 (concat
3381 "^\\s-*\\([0-9]+\\)" ; 1 index
3382 "\\s-+\\([0-9]+\\)" ; 2 line number
3383 "\\s-+\\(Uncompiled\\|" ; 3-6 either uncompiled or routine name
3384 "\\(\\(Func=\\|Pro=\\)\\(\\$?[a-zA-Z][a-zA-Z0-9$_:]*\\$?\\)\\)\\)"
3385 "\\(\\s-*,\\s-*After=[0-9]+/\\([0-9]+\\)?\\)?" ; 7-8 After part
3386 "\\(\\s-*,\\s-*\\(BreakOnce\\)\\)?" ; 9-10 BreakOnce
3387 "\\(\\s-*,\\s-*\\(Condition='\\(.*\\)'\\)\n?\\)?" ; 11-13 Condition
3388 "\\(\\s-*,\\s-*\\(Disabled\\)\n?\\)?" ; 14-15 Disabled
3389 "\\s-+\\(\\S-+\\)")) ; 16 File name
3390 file line index module
3391 count condition disabled
3392 bp-re indmap)
3393 (setq idlwave-shell-bp-alist (list nil))
3394 ;; Search for either header type, and set the correct regexp
3395 (when (or
3396 (if (re-search-forward "^\\s-*Index.*\n\\s-*-" nil t)
3397 (setq bp-re bp-re54 ; versions <= 5.4
3398 indmap '(1 2 3 4))) ;index module line file
3399 (if (re-search-forward
3400 "^\\s-*Index\\s-*Line\\s-*Attributes\\s-*File" nil t)
3401 (setq bp-re bp-re55 ; versions >= 5.5
3402 indmap '(1 6 2 16)))) ; index module line file
3403 ;; There seems to be a breakpoint listing here, parse breakpoint lines.
3404 (while (re-search-forward bp-re nil t)
3405 (setq index (string-to-number (match-string (nth 0 indmap)))
3406 module (match-string (nth 1 indmap))
3407 line (string-to-number (match-string (nth 2 indmap)))
3408 file (idlwave-shell-file-name (match-string (nth 3 indmap))))
3409 (if (eq bp-re bp-re55)
3410 (setq count (if (match-string 10) 1
3411 (if (match-string 8)
3412 (string-to-number (match-string 8))))
3413 condition (match-string 13)
3414 disabled (not (null (match-string 15)))))
3416 ;; Add the breakpoint info to the list
3417 (nconc idlwave-shell-bp-alist
3418 (list (cons (list file line)
3419 (list
3420 (list index module)
3421 ;; bp data: count, command, condition, disabled
3422 count nil condition disabled))))))
3423 (setq idlwave-shell-bp-alist (cdr idlwave-shell-bp-alist))
3424 ;; Update breakpoint data
3425 (if (eq bp-re bp-re54)
3426 (mapc 'idlwave-shell-update-bp old-bp-alist)
3427 (mapc 'idlwave-shell-update-bp-command-only old-bp-alist))))
3428 ;; Update the breakpoint overlays
3429 (unless no-show (idlwave-shell-update-bp-overlays))
3430 ;; Return the new list
3431 idlwave-shell-bp-alist)
3433 (defun idlwave-shell-update-bp-command-only (bp)
3434 (idlwave-shell-update-bp bp t))
3436 (defun idlwave-shell-update-bp (bp &optional command-only)
3437 "Update BP data in breakpoint list.
3438 If BP frame is in `idlwave-shell-bp-alist' updates the breakpoint data."
3439 (let ((match (assoc (car bp) idlwave-shell-bp-alist)))
3440 (if match
3441 (if command-only
3442 (setf (nth 1 (cdr (cdr match))) (nth 1 (cdr (cdr match))))
3443 (setcdr (cdr match) (cdr (cdr bp)))))))
3445 (defun idlwave-shell-set-bp-data (bp data)
3446 "Set the data of BP to DATA."
3447 (setcdr (cdr bp) data))
3449 (defun idlwave-shell-bp (frame &optional data module)
3450 "Create a breakpoint structure containing FRAME and DATA.
3451 Second and third args, DATA and MODULE, are optional. Returns
3452 a breakpoint of the format used in `idlwave-shell-bp-alist'.
3453 Can be used in commands attempting match a breakpoint in
3454 `idlwave-shell-bp-alist'."
3455 (cons frame ;; (file line)
3456 (cons (list nil module) ;; (index_id (module type) | module)
3457 data))) ;; (count command condition disabled)
3459 (defvar idlwave-shell-old-bp nil
3460 "List of breakpoints previous to setting a new breakpoint.")
3462 (defun idlwave-shell-sources-bp (bp)
3463 "Check `idlwave-shell-sources-alist' for source of breakpoint using BP.
3464 If an equivalency is found, return the IDL internal source name.
3465 Otherwise return the filename in BP."
3466 (let*
3467 ((bp-file (idlwave-shell-bp-get bp 'file))
3468 (bp-module (idlwave-shell-bp-get bp 'module))
3469 (internal-file-list
3470 (if bp-module
3471 (cdr (assoc bp-module idlwave-shell-sources-alist)))))
3472 (if (and internal-file-list
3473 (equal bp-file (nth 0 internal-file-list)))
3474 (nth 1 internal-file-list)
3475 bp-file)))
3477 (defun idlwave-shell-set-bp (bp &optional no-show)
3478 "Try to set a breakpoint BP.
3479 The breakpoint will be placed at the beginning of the statement on the
3480 line specified by BP or at the next IDL statement if that line is not
3481 a statement. Determines IDL's internal representation for the
3482 breakpoint, which may have occurred at a different line than
3483 specified. If NO-SHOW is non-nil, don't do any updating."
3484 ;; Get and save the old breakpoints
3485 (idlwave-shell-send-command
3486 idlwave-shell-bp-query
3487 `(progn
3488 (idlwave-shell-filter-bp (quote ,no-show))
3489 (setq idlwave-shell-old-bp idlwave-shell-bp-alist))
3490 'hide)
3492 ;; Get sources for this routine in the sources list
3493 (idlwave-shell-module-source-query (idlwave-shell-bp-get bp 'module)
3494 (idlwave-shell-bp-get bp 'type))
3495 (let*
3496 ((count (idlwave-shell-bp-get bp 'count))
3497 (condition (idlwave-shell-bp-get bp 'condition))
3498 (disabled (idlwave-shell-bp-get bp 'disabled))
3499 (key (concat (if (and count (numberp count))
3500 (cond
3501 ((= count 1) ",/once")
3502 ((> count 1) (format ",after=%d" count))))
3503 (if condition (concat ",CONDITION=\"" condition "\""))
3504 ;; IDL can't simultaneously set a condition/count
3505 ;; and disable a breakpoint, but it does keep both
3506 ;; of these when resetting the same BP. We assume
3507 ;; DISABLE and CONDITION/COUNT are not set
3508 ;; together for a newly created breakpoint.
3509 (if (and disabled (not condition) (not count))
3510 ",/DISABLE")))
3511 (line (idlwave-shell-bp-get bp 'line)))
3512 (idlwave-shell-send-command
3513 (concat "breakpoint,'"
3514 (idlwave-shell-sources-bp bp) "',"
3515 (if (integerp line) (setq line (int-to-string line)))
3516 key)
3517 ;; Check for failure and adjust breakpoint to match IDL's list
3518 `(progn
3519 (if (idlwave-shell-set-bp-check (quote ,bp))
3520 (idlwave-shell-set-bp-adjust (quote ,bp) (quote ,no-show))))
3521 ;; hide output?
3522 (idlwave-shell-hide-p 'breakpoint)
3523 'preempt t)))
3525 (defun idlwave-shell-set-bp-adjust (bp &optional no-show)
3526 "Find the breakpoint in IDL's internal list of breakpoints."
3527 (idlwave-shell-send-command
3528 idlwave-shell-bp-query
3529 `(progn
3530 (idlwave-shell-filter-bp 'no-show)
3531 (idlwave-shell-new-bp (quote ,bp))
3532 (unless (quote ,no-show)
3533 (idlwave-shell-update-bp-overlays)))
3534 'hide
3535 'preempt))
3537 (defun idlwave-shell-find-bp (frame)
3538 "Return breakpoint from `idlwave-shell-bp-alist' for frame.
3539 Returns nil if frame not found."
3540 (assoc frame idlwave-shell-bp-alist))
3542 (defun idlwave-shell-find-current-bp ()
3543 "Find breakpoint here, or at halt location."
3544 (let ((bp (idlwave-shell-find-bp (idlwave-shell-current-frame))))
3545 (when (not bp)
3546 ;; Try moving to beginning of halted-at statement
3547 (save-excursion
3548 (idlwave-shell-goto-frame)
3549 (idlwave-beginning-of-statement)
3550 (setq bp (idlwave-shell-find-bp (idlwave-shell-current-frame))))
3551 (unless bp
3552 (beep)
3553 (message "Cannot identify breakpoint for this line")))
3554 bp))
3556 (defun idlwave-shell-new-bp (bp)
3557 "Find the new breakpoint in IDL's list and update with DATA.
3558 The actual line number for a breakpoint in IDL may be different than
3559 the line number used with the IDL breakpoint command.
3560 Looks for a new breakpoint index number in the list. This is
3561 considered the new breakpoint if the file name of frame matches."
3562 (let ((obp-index (mapcar 'idlwave-shell-bp-get idlwave-shell-old-bp))
3563 (bpl idlwave-shell-bp-alist))
3564 (while (and (member (idlwave-shell-bp-get (car bpl)) obp-index)
3565 (setq bpl (cdr bpl))))
3566 (if (and
3567 (not bpl)
3568 ;; No additional breakpoint.
3569 ;; Need to check if we are just replacing a breakpoint.
3570 (setq bpl (assoc (car bp) idlwave-shell-bp-alist)))
3571 (setq bpl (list bpl)))
3572 (if (and bpl
3573 (equal (idlwave-shell-bp-get (setq bpl (car bpl)) 'file)
3574 (idlwave-shell-bp-get bp 'file)))
3575 ;; Got the breakpoint - add count, command to it.
3576 ;; This updates `idlwave-shell-bp-alist' because a deep copy was
3577 ;; not done for bpl.
3578 (idlwave-shell-set-bp-data bpl (idlwave-shell-bp-get bp 'data))
3579 (beep)
3580 (message "Failed to identify breakpoint in IDL"))))
3582 (defvar idlwave-shell-bp-overlays nil
3583 "Alist of overlays marking breakpoints.")
3584 (defvar idlwave-shell-bp-glyph)
3586 (defvar idlwave-shell-debug-line-map (make-sparse-keymap))
3587 (define-key idlwave-shell-debug-line-map
3588 (if (featurep 'xemacs) [button3] [mouse-3])
3589 'idlwave-shell-mouse-active-bp)
3591 (defun idlwave-shell-update-bp-overlays ()
3592 "Update the overlays which mark breakpoints in the source code.
3593 Existing overlays are recycled, in order to minimize consumption."
3594 (when idlwave-shell-mark-breakpoints
3595 (let ((ov-alist (copy-alist idlwave-shell-bp-overlays))
3596 (bp-list idlwave-shell-bp-alist)
3597 (use-glyph (and (memq idlwave-shell-mark-breakpoints '(t glyph))
3598 idlwave-shell-bp-glyph))
3599 ov ov-list bp buf old-buffers win)
3601 ;; Delete the old overlays from their buffers
3602 (if ov-alist
3603 (while (setq ov-list (pop ov-alist))
3604 (while (setq ov (pop (cdr ov-list)))
3605 (add-to-list 'old-buffers (overlay-buffer ov))
3606 (delete-overlay ov))))
3608 (setq ov-alist idlwave-shell-bp-overlays
3609 idlwave-shell-bp-overlays
3610 (if idlwave-shell-bp-glyph
3611 (mapcar 'list (mapcar 'car idlwave-shell-bp-glyph))
3612 (list (list 'bp))))
3613 (while (setq bp (pop bp-list))
3614 (save-excursion
3615 (idlwave-shell-goto-frame (car bp))
3616 (let* ((end (point-at-eol))
3617 (beg (progn (beginning-of-line 1) (point)))
3618 (condition (idlwave-shell-bp-get bp 'condition))
3619 (count (idlwave-shell-bp-get bp 'count))
3620 (disabled (idlwave-shell-bp-get bp 'disabled))
3621 (type (if idlwave-shell-bp-glyph
3622 (cond
3623 (condition 'bp-cond )
3624 (count
3625 (cond
3626 ((<= count 0) 'bp)
3627 ((<= count 4)
3628 (intern
3629 (concat "bp-" (number-to-string count))))
3630 (t 'bp-n)))
3631 (t 'bp))
3632 'bp))
3633 (help-list
3634 (delq nil
3635 (list
3636 (if count
3637 (concat "after:" (int-to-string count)))
3638 (if condition
3639 (concat "condition:" condition))
3640 (if disabled "disabled"))))
3641 (help-text (concat
3642 "BP "
3643 (int-to-string (idlwave-shell-bp-get bp))
3644 (if help-list
3645 (concat
3646 " - "
3647 (mapconcat 'identity help-list ", ")))
3648 (if (and (not count) (not condition))
3649 " (use mouse-3 for breakpoint actions)")))
3650 (full-type (if disabled
3651 (intern (concat (symbol-name type)
3652 "-disabled"))
3653 type))
3654 (ov-existing (assq full-type ov-alist))
3655 (ov (or (and (cdr ov-existing)
3656 (pop (cdr ov-existing)))
3657 (idlwave-shell-make-new-bp-overlay type disabled)))
3658 match)
3659 (if idlwave-shell-breakpoint-popup-menu
3660 (overlay-put ov 'help-echo help-text))
3661 (move-overlay ov beg end)
3662 (if (setq match (assq full-type idlwave-shell-bp-overlays))
3663 (push ov (cdr match))
3664 (nconc idlwave-shell-bp-overlays
3665 (list (list full-type ov)))))
3666 ;; Take care of margins if using a glyph
3667 (when use-glyph
3668 (if old-buffers
3669 (setq old-buffers (delq (current-buffer) old-buffers)))
3670 (if (fboundp 'set-specifier) ;; XEmacs
3671 (set-specifier left-margin-width (cons (current-buffer) 2))
3672 (if (< left-margin-width 2)
3673 (setq left-margin-width 2)))
3674 (let ((window (get-buffer-window (current-buffer) 0)))
3675 (if window
3676 (set-window-margins
3677 window left-margin-width right-margin-width))))))
3678 (if use-glyph
3679 (while (setq buf (pop old-buffers))
3680 (with-current-buffer buf
3681 (if (fboundp 'set-specifier) ;; XEmacs
3682 (set-specifier left-margin-width (cons (current-buffer) 0))
3683 (setq left-margin-width 0))
3684 (let ((window (get-buffer-window buf 0)))
3685 (if window
3686 (set-window-margins
3687 window left-margin-width right-margin-width)))))))))
3689 (defun idlwave-shell-make-new-bp-overlay (&optional type disabled)
3690 "Make a new overlay for highlighting breakpoints.
3692 This stuff is strongly dependent upon the version of Emacs. If TYPE
3693 is passed, make an overlay of that type ('bp or 'bp-cond, currently
3694 only for glyphs)."
3695 (let ((ov (make-overlay 1 1))
3696 (use-glyph (and (memq idlwave-shell-mark-breakpoints '(t glyph))
3697 idlwave-shell-bp-glyph))
3698 (type (or type 'bp))
3699 (face (if disabled
3700 idlwave-shell-disabled-breakpoint-face
3701 idlwave-shell-breakpoint-face)))
3702 (if (featurep 'xemacs)
3703 ;; This is XEmacs
3704 (progn
3705 (when idlwave-shell-breakpoint-popup-menu
3706 (set-extent-property ov 'mouse-face 'highlight)
3707 (set-extent-property ov 'keymap idlwave-shell-debug-line-map))
3709 (cond
3710 ;; tty's cannot display glyphs
3711 ((eq (console-type) 'tty)
3712 (set-extent-property ov 'face face))
3714 ;; use the glyph
3715 (use-glyph
3716 (let ((glyph (cdr (assq type idlwave-shell-bp-glyph))))
3717 (if disabled (setq glyph (car glyph)) (setq glyph (nth 1 glyph)))
3718 (set-extent-property ov 'begin-glyph glyph)
3719 (set-extent-property ov 'begin-glyph-layout 'outside-margin)))
3721 ;; use the face
3722 (idlwave-shell-mark-breakpoints
3723 (set-extent-property ov 'face face))
3725 ;; no marking
3726 (t nil))
3727 (set-extent-priority ov -1)) ; make stop line face prevail
3728 ;; This is Emacs
3729 (when idlwave-shell-breakpoint-popup-menu
3730 (overlay-put ov 'mouse-face 'highlight)
3731 (overlay-put ov 'keymap idlwave-shell-debug-line-map))
3732 (cond
3733 (window-system
3734 (if use-glyph
3735 (let ((image-props (cdr (assq type idlwave-shell-bp-glyph)))
3736 string)
3738 (if disabled (setq image-props
3739 (append image-props
3740 (list :conversion 'disabled))))
3741 (setq string
3742 (propertize "@"
3743 'display
3744 (list (list 'margin 'left-margin)
3745 image-props)))
3746 (overlay-put ov 'before-string string))
3747 ;; just the face
3748 (overlay-put ov 'face face)))
3750 ;; use a face
3751 (idlwave-shell-mark-breakpoints
3752 (overlay-put ov 'face face))
3754 ;; No marking
3755 (t nil)))
3756 ov))
3758 (defun idlwave-shell-mouse-active-bp (ev)
3759 "Does right-click mouse action on breakpoint lines."
3760 (interactive "e")
3761 (if ev (mouse-set-point ev))
3762 (let ((bp (idlwave-shell-find-bp (idlwave-shell-current-frame)))
3763 index condition count select cmd disabled)
3764 (unless bp
3765 (error "Breakpoint not found"))
3766 (setq index (int-to-string (idlwave-shell-bp-get bp))
3767 condition (idlwave-shell-bp-get bp 'condition)
3768 cmd (idlwave-shell-bp-get bp 'cmd)
3769 count (idlwave-shell-bp-get bp 'count)
3770 disabled (idlwave-shell-bp-get bp 'disabled))
3771 (setq select (idlwave-popup-select
3773 (delq nil
3774 (list (if disabled "Enable" "Disable")
3775 "Clear"
3776 "Clear All"
3777 (if condition "Remove Condition" "Add Condition")
3778 (if condition "Change Condition")
3779 (if count "Remove Repeat Count"
3780 "Add Repeat Count")
3781 (if count "Change Repeat Count")))
3782 (concat "BreakPoint " index)))
3783 (if select
3784 (cond
3785 ((string-equal select "Clear All")
3786 (idlwave-shell-clear-all-bp))
3787 ((string-equal select "Clear")
3788 (idlwave-shell-clear-current-bp))
3789 ((string-match "Condition" select)
3790 (idlwave-shell-break-here count cmd
3791 (if (or (not condition)
3792 (string-match "Change" select))
3793 (read-string "Break Condition: "))
3794 disabled))
3795 ((string-match "Count" select)
3796 (idlwave-shell-break-here (if (or (not count)
3797 (string-match "Change" select))
3798 (string-to-number
3799 (read-string "Break After Count: ")))
3800 cmd condition disabled))
3801 ((string-match "able$" select)
3802 (idlwave-shell-toggle-enable-current-bp))
3804 (message "Unimplemented: %s" select))))))
3806 (defun idlwave-shell-edit-default-command-line (arg)
3807 "Edit the current execute command."
3808 (interactive "P")
3809 (setq idlwave-shell-command-line-to-execute
3810 (read-string "IDL> " idlwave-shell-command-line-to-execute)))
3812 (defun idlwave-shell-execute-default-command-line (arg)
3813 "Execute a command line. On first use, ask for the command.
3814 Also with prefix arg, ask for the command. You can also use the command
3815 `idlwave-shell-edit-default-command-line' to edit the line."
3816 (interactive "P")
3817 (cond
3818 ((equal arg '(16))
3819 (setq idlwave-shell-command-line-to-execute nil))
3820 ((equal arg '(4))
3821 (setq idlwave-shell-command-line-to-execute
3822 (read-string "IDL> " idlwave-shell-command-line-to-execute))))
3823 (idlwave-shell-reset 'hidden)
3824 (idlwave-shell-send-command
3825 (or idlwave-shell-command-line-to-execute
3826 (with-current-buffer (idlwave-shell-buffer)
3827 (ring-ref comint-input-ring 0)))
3828 '(idlwave-shell-redisplay 'hide)))
3830 (defun idlwave-shell-save-and-run ()
3831 "Save file and run it in IDL.
3832 Runs `save-buffer' and sends a '.RUN' command for the associated file to IDL.
3833 When called from the shell buffer, re-run the file which was last handled by
3834 one of the save-and-.. commands."
3835 (interactive)
3836 (idlwave-shell-save-and-action 'run))
3838 (defun idlwave-shell-save-and-compile ()
3839 "Save file and run it in IDL.
3840 Runs `save-buffer' and sends '.COMPILE' command for the associated file to IDL.
3841 When called from the shell buffer, re-compile the file which was last handled by
3842 one of the save-and-.. commands."
3843 (interactive)
3844 (idlwave-shell-save-and-action 'compile))
3846 (defun idlwave-shell-save-and-batch ()
3847 "Save file and batch it in IDL.
3848 Runs `save-buffer' and sends a '@file' command for the associated file to IDL.
3849 When called from the shell buffer, re-batch the file which was last handled by
3850 one of the save-and-.. commands."
3851 (interactive)
3852 (idlwave-shell-save-and-action 'batch))
3854 (defun idlwave-shell-save-and-action (action)
3855 "Save file and compile it in IDL.
3856 Runs `save-buffer' and sends a '.RUN' command for the associated file to IDL.
3857 When called from the shell buffer, re-compile the file which was last
3858 handled by this command."
3859 ;; Remove the stop overlay.
3860 (if idlwave-shell-stop-line-overlay
3861 (delete-overlay idlwave-shell-stop-line-overlay))
3862 (if idlwave-shell-is-stopped
3863 (idlwave-shell-electric-debug-all-off))
3864 (setq idlwave-shell-is-stopped nil)
3865 (setq overlay-arrow-string nil)
3866 (let (buf)
3867 (cond
3868 ((derived-mode-p 'idlwave-mode)
3869 (save-buffer)
3870 (setq idlwave-shell-last-save-and-action-file (buffer-file-name)))
3871 (idlwave-shell-last-save-and-action-file
3872 (if (setq buf (idlwave-get-buffer-visiting
3873 idlwave-shell-last-save-and-action-file))
3874 (with-current-buffer buf
3875 (save-buffer))))
3876 (t (setq idlwave-shell-last-save-and-action-file
3877 (read-file-name "File: ")))))
3878 (if (file-regular-p idlwave-shell-last-save-and-action-file)
3879 (progn
3880 (idlwave-shell-send-command
3881 (concat (cond ((eq action 'run) ".run ")
3882 ((eq action 'compile) ".compile ")
3883 ((eq action 'batch) "@")
3884 (t (error "Unknown action %s" action)))
3885 "\""
3886 idlwave-shell-last-save-and-action-file
3887 "\"")
3888 `(idlwave-shell-maybe-update-routine-info nil
3889 ,idlwave-shell-last-save-and-action-file)
3890 (if (idlwave-shell-hide-p 'run) 'mostly) nil t)
3891 (idlwave-shell-bp-query))
3892 (let ((msg (format "No such file %s"
3893 idlwave-shell-last-save-and-action-file)))
3894 (setq idlwave-shell-last-save-and-action-file nil)
3895 (error msg))))
3897 (defun idlwave-shell-maybe-update-routine-info (&optional wait file)
3898 "Update the routine info if the shell is not stopped at an error."
3899 (if (and (not idlwave-shell-is-stopped)
3900 (or (eq t idlwave-auto-routine-info-updates)
3901 (memq 'compile-buffer idlwave-auto-routine-info-updates))
3902 idlwave-query-shell-for-routine-info
3903 idlwave-routines)
3904 (idlwave-shell-update-routine-info t nil wait file)))
3906 (defvar idlwave-shell-sources-query "help,/source,/full"
3907 "IDL command to obtain source files for compiled procedures.")
3909 (defvar idlwave-shell-sources-alist nil
3910 "Alist of IDL procedure names and compiled source files.
3911 Elements of the alist have the form:
3913 (module name . (source-file-truename idlwave-internal-filename))")
3915 (defun idlwave-shell-module-source-query (module &optional type)
3916 "Determine the source file for a given module.
3917 Query as a function if TYPE set to something beside 'pro."
3918 (if module
3919 (idlwave-shell-send-command
3920 (format "print,(routine_info('%s',/SOURCE%s)).PATH" module
3921 (if (eq type 'pro) "" ",/FUNCTIONS"))
3922 `(idlwave-shell-module-source-filter ,module)
3923 'hide 'wait)))
3925 (defun idlwave-shell-module-source-filter (module)
3926 "Get module source, and update `idlwave-shell-sources-alist'."
3927 (let ((old (assoc (upcase module) idlwave-shell-sources-alist))
3928 filename)
3929 (when (string-match "\.PATH *[\n\r]\\([^%][^\r\n]+\\)[\n\r]"
3930 idlwave-shell-command-output)
3931 (setq filename (substring idlwave-shell-command-output
3932 (match-beginning 1) (match-end 1)))
3933 (if old
3934 (setcdr old (list (idlwave-shell-file-name filename) filename))
3935 (setq idlwave-shell-sources-alist
3936 (append idlwave-shell-sources-alist
3937 (list (cons (upcase module)
3938 (list (idlwave-shell-file-name filename)
3939 filename)))))))))
3941 (defun idlwave-shell-sources-query ()
3942 "Determine source files for all IDL compiled procedures.
3943 Queries IDL using the string in `idlwave-shell-sources-query'."
3944 (interactive)
3945 (idlwave-shell-send-command idlwave-shell-sources-query
3946 'idlwave-shell-sources-filter
3947 'hide))
3949 (defun idlwave-shell-sources-filter ()
3950 "Get source files from `idlwave-shell-sources-query' output.
3951 Create `idlwave-shell-sources-alist' consisting of list elements
3952 of the form:
3953 (module name . (source-file-truename idlwave-internal-filename))"
3954 (with-current-buffer (get-buffer-create idlwave-shell-bp-buffer)
3955 (erase-buffer)
3956 (insert idlwave-shell-command-output)
3957 (goto-char (point-min))
3958 (let (cpro cfun)
3959 (if (re-search-forward "Compiled Procedures:" nil t)
3960 (progn
3961 (forward-line) ; Skip $MAIN$
3962 (setq cpro (point))))
3963 (if (re-search-forward "Compiled Functions:" nil t)
3964 (progn
3965 (setq cfun (point))
3966 (setq idlwave-shell-sources-alist
3967 (append
3968 ;; compiled procedures
3969 (progn
3970 (narrow-to-region cpro (point-at-bol))
3971 (goto-char (point-min))
3972 (idlwave-shell-sources-grep))
3973 ;; compiled functions
3974 (progn
3975 (widen)
3976 (goto-char cfun)
3977 (idlwave-shell-sources-grep)))))))))
3979 (defun idlwave-shell-sources-grep ()
3980 (save-excursion
3981 (let ((al (list nil)))
3982 (while (and
3983 (not (progn (forward-line) (eobp)))
3984 (re-search-forward
3985 "\\s-*\\(\\S-+\\)\\s-+\\(\\S-+\\)" nil t))
3986 (nconc al
3987 (list
3988 (cons
3989 (buffer-substring ; name
3990 (match-beginning 1) (match-end 1))
3991 (let ((internal-filename
3992 (buffer-substring ; source
3993 (match-beginning 2) (match-end 2))))
3994 (list
3995 (idlwave-shell-file-name internal-filename)
3996 internal-filename))
3997 ))))
3998 (cdr al))))
4000 (defun idlwave-shell-clear-all-bp ()
4001 "Remove all breakpoints in IDL."
4002 (interactive)
4003 (idlwave-shell-send-command
4004 idlwave-shell-bp-query
4005 '(progn
4006 (idlwave-shell-filter-bp)
4007 (mapcar (lambda (x) (idlwave-shell-clear-bp x 'no-query))
4008 idlwave-shell-bp-alist)
4009 (idlwave-shell-bp-query))
4010 'hide))
4012 (defun idlwave-shell-list-all-bp ()
4013 "List all breakpoints in IDL."
4014 (interactive)
4015 (idlwave-shell-send-command
4016 idlwave-shell-bp-query))
4018 (defvar idlwave-shell-error-last 0
4019 "Position of last syntax error in `idlwave-shell-error-buffer'.")
4021 (defun idlwave-shell-goto-next-error ()
4022 "Move point to next IDL syntax error."
4023 (interactive)
4024 (let (frame col)
4025 (with-current-buffer idlwave-shell-error-buffer
4026 (goto-char idlwave-shell-error-last)
4027 (if (or
4028 (re-search-forward idlwave-shell-syntax-error nil t)
4029 (re-search-forward idlwave-shell-other-error nil t))
4030 (progn
4031 (setq frame
4032 (list
4033 (save-match-data
4034 (idlwave-shell-file-name
4035 (buffer-substring (match-beginning 1 )
4036 (match-end 1))))
4037 (string-to-number
4038 (buffer-substring (match-beginning 2)
4039 (match-end 2)))))
4040 ;; Try to find the column of the error
4041 (save-excursion
4042 (setq col
4043 (if (re-search-backward "\\^" nil t)
4044 (current-column)
4045 0)))))
4046 (setq idlwave-shell-error-last (point)))
4047 (if frame
4048 (progn
4049 (idlwave-shell-display-line frame col 'disable))
4050 (beep)
4051 (message "No more errors."))))
4053 (defun idlwave-shell-file-name (name)
4054 "If `idlwave-shell-use-truename' is non-nil, convert file name to true name.
4055 Otherwise, just expand the file name."
4056 (let ((def-dir (if (derived-mode-p 'idlwave-shell-mode)
4057 default-directory
4058 idlwave-shell-default-directory)))
4059 (if idlwave-shell-use-truename
4060 (file-truename name def-dir)
4061 (expand-file-name name def-dir))))
4063 ;; Keybindings ------------------------------------------------------------
4065 (defvar idlwave-shell-mode-map (copy-keymap comint-mode-map)
4066 "Keymap for `idlwave-mode'.")
4067 (defvar idlwave-shell-electric-debug-mode-map (make-sparse-keymap))
4068 (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap))
4069 (fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map)
4070 (defvar idlwave-mode-prefix-map (make-sparse-keymap))
4071 (fset 'idlwave-mode-prefix-map idlwave-mode-prefix-map)
4073 (defun idlwave-shell-define-key-both (key hook)
4074 "Define a key in both the shell and buffer mode maps."
4075 (define-key idlwave-mode-map key hook)
4076 (define-key idlwave-shell-mode-map key hook))
4078 ;(define-key idlwave-shell-mode-map "\M-?" 'comint-dynamic-list-completions)
4079 ;(define-key idlwave-shell-mode-map "\t" 'comint-dynamic-complete)
4081 (define-key idlwave-shell-mode-map "\C-w" 'comint-kill-region)
4082 (define-key idlwave-shell-mode-map "\t" 'idlwave-shell-complete)
4083 (define-key idlwave-shell-mode-map "\M-\t" 'idlwave-shell-complete)
4084 (define-key idlwave-shell-mode-map "\C-c\C-s" 'idlwave-shell)
4085 (define-key idlwave-shell-mode-map "\C-c?" 'idlwave-routine-info)
4086 (define-key idlwave-shell-mode-map "\C-g" 'idlwave-keyboard-quit)
4087 (define-key idlwave-shell-mode-map "\M-?" 'idlwave-context-help)
4088 (define-key idlwave-shell-mode-map [(control meta ?\?)]
4089 'idlwave-help-assistant-help-with-topic)
4090 (define-key idlwave-shell-mode-map "\C-c\C-i" 'idlwave-update-routine-info)
4091 (define-key idlwave-shell-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop)
4092 (define-key idlwave-shell-mode-map "\C-c\C-x" 'idlwave-shell-send-char)
4093 (define-key idlwave-shell-mode-map "\C-c=" 'idlwave-resolve)
4094 (define-key idlwave-shell-mode-map "\C-c\C-v" 'idlwave-find-module)
4095 (define-key idlwave-shell-mode-map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers)
4096 (define-key idlwave-shell-mode-map idlwave-shell-prefix-key
4097 'idlwave-shell-debug-map)
4098 (define-key idlwave-shell-mode-map [(up)] 'idlwave-shell-up-or-history)
4099 (define-key idlwave-shell-mode-map [(down)] 'idlwave-shell-down-or-history)
4100 (define-key idlwave-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop)
4101 (define-key idlwave-mode-map "\C-c\C-x" 'idlwave-shell-send-char)
4103 ;; The mouse bindings for PRINT and HELP
4104 (idlwave-shell-define-key-both
4105 (if (featurep 'xemacs)
4106 [(shift button2)]
4107 [(shift down-mouse-2)])
4108 'idlwave-shell-mouse-print)
4109 (idlwave-shell-define-key-both
4110 (if (featurep 'xemacs)
4111 [(control meta button2)]
4112 [(control meta down-mouse-2)])
4113 'idlwave-shell-mouse-help)
4114 (idlwave-shell-define-key-both
4115 (if (featurep 'xemacs)
4116 [(control shift button2)]
4117 [(control shift down-mouse-2)])
4118 'idlwave-shell-examine-select)
4119 ;; Add this one from the idlwave-mode-map
4120 (define-key idlwave-shell-mode-map
4121 (if (featurep 'xemacs)
4122 [(shift button3)]
4123 [(shift mouse-3)])
4124 'idlwave-mouse-context-help)
4126 ;; For Emacs, we need to turn off the button release events.
4127 (defun idlwave-shell-mouse-nop (event)
4128 (interactive "e"))
4129 (unless (featurep 'xemacs)
4130 (idlwave-shell-define-key-both
4131 [(shift mouse-2)] 'idlwave-shell-mouse-nop)
4132 (idlwave-shell-define-key-both
4133 [(shift control mouse-2)] 'idlwave-shell-mouse-nop)
4134 (idlwave-shell-define-key-both
4135 [(control meta mouse-2)] 'idlwave-shell-mouse-nop))
4138 ;; The following set of bindings is used to bind the debugging keys.
4139 ;; If `idlwave-shell-activate-prefix-keybindings' is non-nil, the
4140 ;; first key in the list gets bound the C-c C-d prefix map. If
4141 ;; `idlwave-shell-debug-modifiers' is non-nil, the second key in the
4142 ;; list gets bound with the specified modifiers in both
4143 ;; `idlwave-mode-map' and `idlwave-shell-mode-map'. The next list
4144 ;; item, if non-nil, means to bind this as a single key in the
4145 ;; electric-debug-mode-map.
4147 ;; [C-c C-d]-binding debug-modifier-key command bind-electric-debug buf-only
4148 ;; Used keys: abcdef hijklmnopqrstuvwxyz
4149 ;; Unused keys: g
4150 (let* ((specs
4151 '(([(control ?b)] ?b idlwave-shell-break-here t t)
4152 ([(control ?i)] ?i idlwave-shell-break-in t t)
4153 ([(control ?j)] ?j idlwave-shell-break-this-module t t)
4154 ([(control ?d)] ?d idlwave-shell-clear-current-bp t)
4155 ([(control ?a)] ?a idlwave-shell-clear-all-bp t)
4156 ([(control ?\\)] ?\\ idlwave-shell-toggle-enable-current-bp t)
4157 ([(control ?s)] ?s idlwave-shell-step t)
4158 ([(control ?n)] ?n idlwave-shell-stepover t)
4159 ([(control ?k)] ?k idlwave-shell-skip t)
4160 ([(control ?u)] ?u idlwave-shell-up t)
4161 ([(control ?o)] ?o idlwave-shell-out t)
4162 ([(control ?m)] ?m idlwave-shell-return t)
4163 ([(control ?h)] ?h idlwave-shell-to-here t t)
4164 ([(control ?r)] ?r idlwave-shell-cont t)
4165 ([(control ?y)] ?y idlwave-shell-execute-default-command-line)
4166 ([(control ?z)] ?z idlwave-shell-reset t)
4167 ([(control ?q)] ?q idlwave-shell-quit)
4168 ([(control ?p)] ?p idlwave-shell-print t)
4169 ([( ??)] ?? idlwave-shell-help-expression t)
4170 ([(control ?v)] ?v idlwave-shell-toggle-electric-debug-mode t t)
4171 ([(control ?x)] ?x idlwave-shell-goto-next-error)
4172 ([(control ?c)] ?c idlwave-shell-save-and-run t)
4173 ([( ?@)] ?@ idlwave-shell-save-and-batch)
4174 ([(control ?e)] ?e idlwave-shell-run-region)
4175 ([(control ?w)] ?w idlwave-shell-resync-dirs)
4176 ([(control ?l)] ?l idlwave-shell-redisplay t)
4177 ([(control ?t)] ?t idlwave-shell-toggle-toolbar)
4178 ([(control up)] up idlwave-shell-stack-up)
4179 ([(control down)] down idlwave-shell-stack-down)
4180 ([( ?[)] ?[ idlwave-shell-goto-previous-bp t t)
4181 ([( ?])] ?] idlwave-shell-goto-next-bp t t)
4182 ([(control ?f)] ?f idlwave-shell-window)))
4183 (mod (and (listp idlwave-shell-debug-modifiers)
4184 idlwave-shell-debug-modifiers))
4185 (shift (memq 'shift mod))
4186 (mod-noshift (delete 'shift (copy-sequence mod)))
4187 s k1 c2 k2 cmd electric only-buffer cannotshift)
4188 (while (setq s (pop specs))
4189 (setq k1 (nth 0 s)
4190 c2 (nth 1 s)
4191 cmd (nth 2 s)
4192 electric (nth 3 s)
4193 only-buffer (nth 4 s)
4194 cannotshift (and shift (characterp c2) (eq c2 (upcase c2))))
4196 ;; The regular prefix keymap.
4197 (when (and idlwave-shell-activate-prefix-keybindings k1)
4198 (unless only-buffer
4199 (define-key idlwave-shell-mode-prefix-map k1 cmd))
4200 (define-key idlwave-mode-prefix-map k1 cmd))
4201 ;; The debug modifier map
4202 (when (and mod window-system)
4203 (if (char-or-string-p c2)
4204 (setq k2 (vector (append mod-noshift
4205 (list (if shift (upcase c2) c2)))))
4206 (setq k2 (vector (append mod (list c2)))))
4207 (unless cannotshift
4208 (define-key idlwave-mode-map k2 cmd)
4209 (unless only-buffer (define-key idlwave-shell-mode-map k2 cmd))))
4210 ;; The electric debug single-keystroke map
4211 (if (and electric (char-or-string-p c2))
4212 (define-key idlwave-shell-electric-debug-mode-map (char-to-string c2)
4213 cmd))))
4215 ;; A few extras in the electric debug map
4216 (define-key idlwave-shell-electric-debug-mode-map " " 'idlwave-shell-step)
4217 (define-key idlwave-shell-electric-debug-mode-map "+" 'idlwave-shell-stack-up)
4218 (define-key idlwave-shell-electric-debug-mode-map "=" 'idlwave-shell-stack-up)
4219 (define-key idlwave-shell-electric-debug-mode-map "-"
4220 'idlwave-shell-stack-down)
4221 (define-key idlwave-shell-electric-debug-mode-map "_"
4222 'idlwave-shell-stack-down)
4223 (define-key idlwave-shell-electric-debug-mode-map "e"
4224 (lambda () (interactive) (idlwave-shell-print '(16))))
4225 (define-key idlwave-shell-electric-debug-mode-map "q" 'idlwave-shell-retall)
4226 (define-key idlwave-shell-electric-debug-mode-map "t"
4227 (lambda () (interactive) (idlwave-shell-send-command "help,/TRACE")))
4228 (define-key idlwave-shell-electric-debug-mode-map [(control ??)]
4229 'idlwave-shell-electric-debug-help)
4230 (define-key idlwave-shell-electric-debug-mode-map "x"
4231 (lambda (arg) (interactive "P")
4232 (idlwave-shell-print arg nil nil t)))
4235 ; Enter the prefix map in two places.
4236 (fset 'idlwave-debug-map idlwave-mode-prefix-map)
4237 (fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map)
4239 ;; The Electric Debug Minor Mode --------------------------------------------
4241 (defun idlwave-shell-toggle-electric-debug-mode ()
4242 "Toggle electric-debug-mode, suppressing re-entry into mode if turned off."
4243 (interactive)
4244 ;; If turning it off, make sure it stays off throughout the debug
4245 ;; session until we return or hit $MAIN$. Cancel this suppression
4246 ;; if it's explicitly turned on.
4247 (if idlwave-shell-electric-debug-mode
4248 (progn ;; Turn it off, and make sure it stays off.
4249 (setq idlwave-shell-suppress-electric-debug t)
4250 (idlwave-shell-electric-debug-mode 0))
4251 (setq idlwave-shell-suppress-electric-debug nil)
4252 (idlwave-shell-electric-debug-mode t)))
4254 (defvar idlwave-shell-electric-debug-read-only)
4255 (defvar idlwave-shell-electric-debug-buffers nil)
4257 (define-minor-mode idlwave-shell-electric-debug-mode
4258 "Toggle Idlwave Shell Electric Debug mode.
4259 With a prefix argument ARG, enable the mode if ARG is positive,
4260 and disable it otherwise. If called from Lisp, enable the mode
4261 if ARG is omitted or nil.
4263 When Idlwave Shell Electric Debug mode is enabled, the Idlwave
4264 Shell debugging commands are available as single key sequences."
4265 nil " *Debugging*" idlwave-shell-electric-debug-mode-map)
4267 (add-hook
4268 'idlwave-shell-electric-debug-mode-on-hook
4269 (lambda ()
4270 (set (make-local-variable 'idlwave-shell-electric-debug-read-only)
4271 buffer-read-only)
4272 (setq buffer-read-only t)
4273 (add-to-list 'idlwave-shell-electric-debug-buffers (current-buffer))
4274 (if idlwave-shell-stop-line-overlay
4275 (overlay-put idlwave-shell-stop-line-overlay 'face
4276 idlwave-shell-electric-stop-line-face))
4277 (if (facep 'fringe)
4278 (set-face-foreground 'fringe idlwave-shell-electric-stop-color
4279 (selected-frame)))))
4281 (add-hook
4282 'idlwave-shell-electric-debug-mode-off-hook
4283 (lambda ()
4284 ;; Return to previous read-only state
4285 (setq buffer-read-only (if (boundp 'idlwave-shell-electric-debug-read-only)
4286 idlwave-shell-electric-debug-read-only))
4287 (setq idlwave-shell-electric-debug-buffers
4288 (delq (current-buffer) idlwave-shell-electric-debug-buffers))
4289 (if idlwave-shell-stop-line-overlay
4290 (overlay-put idlwave-shell-stop-line-overlay 'face
4291 idlwave-shell-stop-line-face)
4292 (if (facep 'fringe)
4293 (set-face-foreground 'fringe (face-foreground 'default))))))
4295 ;; easy-mmode defines electric-debug-mode for us, so we need to advise it.
4296 (defadvice idlwave-shell-electric-debug-mode (after print-enter activate)
4297 "Print out an entrance message."
4298 (when idlwave-shell-electric-debug-mode
4299 (message
4300 "Electric Debugging mode entered. Press [C-?] for help, [q] to quit"))
4301 (force-mode-line-update))
4303 ;; Turn it off in all relevant buffers
4304 (defvar idlwave-shell-electric-debug-buffers nil)
4305 (defun idlwave-shell-electric-debug-all-off ()
4306 (setq idlwave-shell-suppress-electric-debug nil)
4307 (let ((buffers idlwave-shell-electric-debug-buffers)
4308 buf)
4309 (save-excursion
4310 (while (setq buf (pop buffers))
4311 (when (buffer-live-p buf)
4312 (set-buffer buf)
4313 (when (and (derived-mode-p 'idlwave-mode)
4314 buffer-file-name
4315 idlwave-shell-electric-debug-mode)
4316 (idlwave-shell-electric-debug-mode 0))))))
4317 (setq idlwave-shell-electric-debug-buffers nil))
4319 ;; Show the help text
4320 (defun idlwave-shell-electric-debug-help ()
4321 (interactive)
4322 (with-output-to-temp-buffer "*IDLWAVE Electric Debug Help*"
4323 (princ idlwave-shell-electric-debug-help))
4324 (let* ((current-window (selected-window))
4325 (window (get-buffer-window "*IDLWAVE Electric Debug Help*"))
4326 (window-lines (window-height window)))
4327 (select-window window)
4328 (enlarge-window (1+ (- (count-lines 1 (point-max)) window-lines)))
4329 (select-window current-window)))
4332 ;; The Menus --------------------------------------------------------------
4333 (defvar idlwave-shell-menu-def
4334 `("Debug"
4335 ["Electric Debug Mode"
4336 idlwave-shell-electric-debug-mode
4337 :style toggle :selected idlwave-shell-electric-debug-mode
4338 :included (derived-mode-p 'idlwave-mode) :keys "C-c C-d C-v"]
4339 "--"
4340 ("Compile & Run"
4341 ["Save and .RUN" idlwave-shell-save-and-run
4342 (or (derived-mode-p 'idlwave-mode)
4343 idlwave-shell-last-save-and-action-file)]
4344 ["Save and .COMPILE" idlwave-shell-save-and-compile
4345 (or (derived-mode-p 'idlwave-mode)
4346 idlwave-shell-last-save-and-action-file)]
4347 ["Save and @Batch" idlwave-shell-save-and-batch
4348 (or (derived-mode-p 'idlwave-mode)
4349 idlwave-shell-last-save-and-action-file)]
4350 "--"
4351 ["Goto Next Error" idlwave-shell-goto-next-error t]
4352 "--"
4353 ["Compile and Run Region" idlwave-shell-run-region
4354 (derived-mode-p 'idlwave-mode)]
4355 ["Evaluate Region" idlwave-shell-evaluate-region
4356 (derived-mode-p 'idlwave-mode)]
4357 "--"
4358 ["Execute Default Cmd" idlwave-shell-execute-default-command-line t]
4359 ["Edit Default Cmd" idlwave-shell-edit-default-command-line t])
4360 ("Breakpoints"
4361 ["Set Breakpoint" idlwave-shell-break-here
4362 :keys "C-c C-d C-b" :active (derived-mode-p 'idlwave-mode)]
4363 ("Set Special Breakpoint"
4364 ["Set After Count Breakpoint"
4365 (progn
4366 (let ((count (string-to-number (read-string "Break after count: "))))
4367 (if (integerp count) (idlwave-shell-break-here count))))
4368 :active (derived-mode-p 'idlwave-mode)]
4369 ["Set Condition Breakpoint"
4370 (idlwave-shell-break-here '(4))
4371 :active (derived-mode-p 'idlwave-mode)])
4372 ["Break in Module" idlwave-shell-break-in
4373 :keys "C-c C-d C-i" :active (derived-mode-p 'idlwave-mode)]
4374 ["Break in this Module" idlwave-shell-break-this-module
4375 :keys "C-c C-d C-j" :active (derived-mode-p 'idlwave-mode)]
4376 ["Clear Breakpoint" idlwave-shell-clear-current-bp t]
4377 ["Clear All Breakpoints" idlwave-shell-clear-all-bp t]
4378 ["Disable/Enable Breakpoint" idlwave-shell-toggle-enable-current-bp t]
4379 ["Goto Previous Breakpoint" idlwave-shell-goto-previous-bp
4380 :keys "C-c C-d [" :active (derived-mode-p 'idlwave-mode)]
4381 ["Goto Next Breakpoint" idlwave-shell-goto-next-bp
4382 :keys "C-c C-d ]" :active (derived-mode-p 'idlwave-mode)]
4383 ["List All Breakpoints" idlwave-shell-list-all-bp t]
4384 ["Resync Breakpoints" idlwave-shell-bp-query t])
4385 ("Continue/Step"
4386 ["Step (into)" idlwave-shell-step t]
4387 ["Step (over)" idlwave-shell-stepover t]
4388 ["Skip One Statement" idlwave-shell-skip t]
4389 ["Continue" idlwave-shell-cont t]
4390 ["... to End of Block" idlwave-shell-up t]
4391 ["... to End of Subprog" idlwave-shell-return t]
4392 ["... to End of Subprog+1" idlwave-shell-out t]
4393 ["... to Here (Cursor Line)" idlwave-shell-to-here
4394 :keys "C-c C-d C-h" :active (derived-mode-p 'idlwave-mode)])
4395 ("Examine Expressions"
4396 ["Print expression" idlwave-shell-print t]
4397 ["Help on expression" idlwave-shell-help-expression t]
4398 ("Examine nearby expression with"
4399 ,@(mapcar (lambda(x)
4400 `[ ,(car x) (idlwave-shell-print nil ',x) t ])
4401 idlwave-shell-examine-alist))
4402 ("Examine region with"
4403 ,@(mapcar (lambda(x)
4404 `[ ,(car x) (idlwave-shell-print '(4) ',x) t ])
4405 idlwave-shell-examine-alist)))
4406 ("Call Stack"
4407 ["Stack Up" idlwave-shell-stack-up t]
4408 ["Stack Down" idlwave-shell-stack-down t]
4409 "--"
4410 ["Redisplay and Sync" idlwave-shell-redisplay t])
4411 ("Show Commands"
4412 ["Everything" (if (eq idlwave-shell-show-commands 'everything)
4413 (progn
4414 (setq idlwave-shell-show-commands
4415 (get 'idlwave-shell-show-commands 'last-val))
4416 (put 'idlwave-shell-show-commands 'last-val nil))
4417 (put 'idlwave-shell-show-commands 'last-val
4418 idlwave-shell-show-commands)
4419 (setq idlwave-shell-show-commands 'everything))
4420 :style toggle :selected (and (not (listp idlwave-shell-show-commands))
4421 (eq idlwave-shell-show-commands
4422 'everything))]
4423 "--"
4424 ["Compiling Commands" (idlwave-shell-add-or-remove-show 'run)
4425 :style toggle
4426 :selected (not (idlwave-shell-hide-p
4427 'run
4428 (get 'idlwave-shell-show-commands 'last-val)))
4429 :active (not (eq idlwave-shell-show-commands 'everything))]
4430 ["Breakpoint Commands" (idlwave-shell-add-or-remove-show 'breakpoint)
4431 :style toggle
4432 :selected (not (idlwave-shell-hide-p
4433 'breakpoint
4434 (get 'idlwave-shell-show-commands 'last-val)))
4435 :active (not (eq idlwave-shell-show-commands 'everything))]
4436 ["Debug Commands" (idlwave-shell-add-or-remove-show 'debug)
4437 :style toggle
4438 :selected (not (idlwave-shell-hide-p
4439 'debug
4440 (get 'idlwave-shell-show-commands 'last-val)))
4441 :active (not (eq idlwave-shell-show-commands 'everything))]
4442 ["Miscellaneous Commands" (idlwave-shell-add-or-remove-show 'misc)
4443 :style toggle
4444 :selected (not (idlwave-shell-hide-p
4445 'misc
4446 (get 'idlwave-shell-show-commands 'last-val)))
4447 :active (not (eq idlwave-shell-show-commands 'everything))])
4448 ("Input Mode"
4449 ["Send one char" idlwave-shell-send-char t]
4450 ["Temporary Character Mode" idlwave-shell-char-mode-loop t]
4451 "--"
4452 ["Use Input Mode Magic"
4453 (setq idlwave-shell-use-input-mode-magic
4454 (not idlwave-shell-use-input-mode-magic))
4455 :style toggle :selected idlwave-shell-use-input-mode-magic])
4456 "--"
4457 ["Update Working Dir" idlwave-shell-resync-dirs t]
4458 ["Save Path Info"
4459 (idlwave-shell-send-command idlwave-shell-path-query
4460 'idlwave-shell-get-path-info
4461 'hide)
4463 ["Reset IDL" idlwave-shell-reset t]
4464 "--"
4465 ["Toggle Toolbar" idlwave-shell-toggle-toolbar t]
4466 ["Exit IDL" idlwave-shell-quit t]))
4468 (if (or (featurep 'easymenu) (load "easymenu" t))
4469 (progn
4470 (easy-menu-define
4471 idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"
4472 idlwave-shell-menu-def)
4473 (easy-menu-define
4474 idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"
4475 idlwave-shell-menu-def)
4476 (save-current-buffer
4477 (dolist (buf (buffer-list))
4478 (set-buffer buf)
4479 (if (derived-mode-p 'idlwave-mode)
4480 (progn
4481 (easy-menu-remove idlwave-mode-debug-menu)
4482 (easy-menu-add idlwave-mode-debug-menu)))))))
4484 ;; The Breakpoint Glyph -------------------------------------------------------
4486 (defvar idlwave-shell-bp-glyph nil
4487 "The glyphs to mark breakpoint lines in the source code.")
4489 (let ((image-alist
4490 '((bp . "/* XPM */
4491 static char * file[] = {
4492 \"14 12 3 1\",
4493 \" c None s backgroundColor\",
4494 \". c #4B4B4B4B4B4B\",
4495 \"R c #FFFF00000000\",
4496 \" \",
4497 \" .... \",
4498 \" .RRRR. \",
4499 \" .RRRRRR. \",
4500 \" .RRRRRRRR. \",
4501 \" .RRRRRRRR. \",
4502 \" .RRRRRRRR. \",
4503 \" .RRRRRRRR. \",
4504 \" .RRRRRR. \",
4505 \" .RRRR. \",
4506 \" .... \",
4507 \" \"};")
4508 (bp-cond . "/* XPM */
4509 static char * file[] = {
4510 \"14 12 4 1\",
4511 \" c None s backgroundColor\",
4512 \". c #4B4B4B4B4B4B\",
4513 \"R c #FFFF00000000\",
4514 \"B c #000000000000\",
4515 \" \",
4516 \" .... \",
4517 \" .RRRR. \",
4518 \" .RRRRRR. \",
4519 \" .RRRRRRRR. \",
4520 \" .RRBBBBRR. \",
4521 \" .RRRRRRRR. \",
4522 \" .RRBBBBRR. \",
4523 \" .RRRRRR. \",
4524 \" .RRRR. \",
4525 \" .... \",
4526 \" \"};")
4527 (bp-1 . "/* XPM */
4528 static char * file[] = {
4529 \"14 12 4 1\",
4530 \" c None s backgroundColor\",
4531 \". c #4B4B4B4B4B4B\",
4532 \"X c #FFFF00000000\",
4533 \"o c #000000000000\",
4534 \" \",
4535 \" .... \",
4536 \" .XXXX. \",
4537 \" .XXooXX. \",
4538 \" .XXoooXXX. \",
4539 \" .XXXooXXX. \",
4540 \" .XXXooXXX. \",
4541 \" .XXooooXX. \",
4542 \" .XooooX. \",
4543 \" .XXXX. \",
4544 \" .... \",
4545 \" \"};")
4546 (bp-2 . "/* XPM */
4547 static char * file[] = {
4548 \"14 12 4 1\",
4549 \" c None s backgroundColor\",
4550 \". c #4B4B4B4B4B4B\",
4551 \"X c #FFFF00000000\",
4552 \"o c #000000000000\",
4553 \" \",
4554 \" .... \",
4555 \" .XXXX. \",
4556 \" .XoooXX. \",
4557 \" .XXoXooXX. \",
4558 \" .XXXXooXX. \",
4559 \" .XXXooXXX. \",
4560 \" .XXooXXXX. \",
4561 \" .XooooX. \",
4562 \" .XXXX. \",
4563 \" .... \",
4564 \" \"};")
4565 (bp-3 . "/* XPM */
4566 static char * file[] = {
4567 \"14 12 4 1\",
4568 \" c None s backgroundColor\",
4569 \". c #4B4B4B4B4B4B\",
4570 \"X c #FFFF00000000\",
4571 \"o c #000000000000\",
4572 \" \",
4573 \" .... \",
4574 \" .XXXX. \",
4575 \" .XoooXX. \",
4576 \" .XXXXooXX. \",
4577 \" .XXXooXXX. \",
4578 \" .XXXXooXX. \",
4579 \" .XXoXooXX. \",
4580 \" .XoooXX. \",
4581 \" .XXXX. \",
4582 \" .... \",
4583 \" \"};")
4584 (bp-4 . "/* XPM */
4585 static char * file[] = {
4586 \"14 12 4 1\",
4587 \" c None s backgroundColor\",
4588 \". c #4B4B4B4B4B4B\",
4589 \"X c #FFFF00000000\",
4590 \"o c #000000000000\",
4591 \" \",
4592 \" .... \",
4593 \" .XXXX. \",
4594 \" .XoXXoX. \",
4595 \" .XXoXXoXX. \",
4596 \" .XXooooXX. \",
4597 \" .XXXXooXX. \",
4598 \" .XXXXooXX. \",
4599 \" .XXXooX. \",
4600 \" .XXXX. \",
4601 \" .... \",
4602 \" \"};")
4603 (bp-n . "/* XPM */
4604 static char * file[] = {
4605 \"14 12 4 1\",
4606 \" c None s backgroundColor\",
4607 \". c #4B4B4B4B4B4B\",
4608 \"X c #FFFF00000000\",
4609 \"o c #000000000000\",
4610 \" \",
4611 \" .... \",
4612 \" .XXXX. \",
4613 \" .XXXXXX. \",
4614 \" .XXoXoXXX. \",
4615 \" .XXooXoXX. \",
4616 \" .XXoXXoXX. \",
4617 \" .XXoXXoXX. \",
4618 \" .XoXXoX. \",
4619 \" .XXXX. \",
4620 \" .... \",
4621 \" \"};"))) im-cons im)
4623 (while (setq im-cons (pop image-alist))
4624 (setq im (cond ((and (featurep 'xemacs)
4625 (featurep 'xpm))
4626 (list
4627 (let ((data (cdr im-cons)))
4628 (string-match "#FFFF00000000" data)
4629 (setq data (replace-match "#8F8F8F8F8F8F" t t data))
4630 (make-glyph data))
4631 (make-glyph (cdr im-cons))))
4632 ((and (not (featurep 'xemacs))
4633 (fboundp 'image-type-available-p)
4634 (image-type-available-p 'xpm))
4635 (list 'image :type 'xpm :data (cdr im-cons)
4636 :ascent 'center))
4637 (t nil)))
4638 (if im (push (cons (car im-cons) im) idlwave-shell-bp-glyph))))
4640 (provide 'idlw-shell)
4641 (provide 'idlwave-shell)
4643 ;; Load the toolbar when wanted by the user.
4645 (autoload 'idlwave-toolbar-toggle "idlw-toolbar"
4646 "Toggle the IDLWAVE toolbar.")
4647 (autoload 'idlwave-toolbar-add-everywhere "idlw-toolbar"
4648 "Add IDLWAVE toolbar.")
4649 (defun idlwave-shell-toggle-toolbar ()
4650 "Toggle the display of the debugging toolbar."
4651 (interactive)
4652 (idlwave-toolbar-toggle))
4654 (if idlwave-shell-use-toolbar
4655 (add-hook 'idlwave-shell-mode-hook 'idlwave-toolbar-add-everywhere))
4657 ;;; idlw-shell.el ends here