/[emacs]/emacs/lisp/progmodes/idlw-shell.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/idlw-shell.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3.15.2.6 by miles, Fri Nov 12 04:21:21 2004 UTC revision 3.15.2.7 by miles, Wed Dec 8 23:31:44 2004 UTC
# Line 1  Line 1 
1  ;; idlw-shell.el --- run IDL as an inferior process of Emacs.  ;; idlw-shell.el --- run IDL as an inferior process of Emacs.
2  ;; Copyright (c) 1999, 2000, 2001,2002 Free Software Foundation  ;; Copyright (c) 1999,2000,2001,2002,2003,2004 Free Software Foundation
3    
4  ;; Author: Carsten Dominik <dominik@astro.uva.nl>  ;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
5  ;;         Chris Chase <chase@att.com>  ;;          Carsten Dominik <dominik@astro.uva.nl>
6    ;;          Chris Chase <chase@att.com>
7  ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>  ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>
8  ;; Version: 4.15  ;; Version: 5.5
9  ;; Keywords: processes  ;; Keywords: processes
10    
11  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 44  Line 45 
45  ;;  ;;
46  ;; INSTALLATION:  ;; INSTALLATION:
47  ;; =============  ;; =============
48  ;;  ;;
49  ;; Follow the instructions in the INSTALL file of the distribution.  ;; Follow the instructions in the INSTALL file of the distribution.
50  ;; In short, put this file on your load path and add the following  ;; In short, put this file on your load path and add the following
51  ;; lines to your .emacs file:  ;; lines to your .emacs file:
# Line 57  Line 58 
58  ;;  ;;
59  ;;   The newest version of this file can be found on the maintainers  ;;   The newest version of this file can be found on the maintainers
60  ;;   web site.  ;;   web site.
61  ;;  ;;
62  ;;     http://idlwave.org  ;;     http://idlwave.org
63  ;;  ;;
64  ;; DOCUMENTATION  ;; DOCUMENTATION
65  ;; =============  ;; =============
66  ;;  ;;
# Line 76  Line 77 
77  ;; it is a bug in XEmacs.  ;; it is a bug in XEmacs.
78  ;; The Debug menu in source buffers *does* display the bindings correctly.  ;; The Debug menu in source buffers *does* display the bindings correctly.
79  ;;  ;;
80  ;;  ;;
81  ;; CUSTOMIZATION VARIABLES  ;; CUSTOMIZATION VARIABLES
82  ;; =======================  ;; =======================
83  ;;  ;;
# Line 100  Line 101 
101    (condition-case () (require 'custom) (error nil))    (condition-case () (require 'custom) (error nil))
102    (if (and (featurep 'custom)    (if (and (featurep 'custom)
103             (fboundp 'custom-declare-variable)             (fboundp 'custom-declare-variable)
104             (fboundp 'defface))             (fboundp 'defface))    
105        ;; We've got what we needed        ;; We've got what we needed
106        (setq idlwave-shell-have-new-custom t)        (setq idlwave-shell-have-new-custom t)
107      ;; We have the old or no custom-library, hack around it!      ;; We have the old or no custom-library, hack around it!
108      (defmacro defgroup (&rest args) nil)      (defmacro defgroup (&rest args) nil)
109      (defmacro defcustom (var value doc &rest args)      (defmacro defcustom (var value doc &rest args)
110        `(defvar ,var ,value ,doc))))        `(defvar ,var ,value ,doc))))
111    
112  ;;; Customizations: idlwave-shell group  ;;; Customizations: idlwave-shell group
# Line 117  Line 118 
118    :group 'idlwave)    :group 'idlwave)
119    
120  (defcustom idlwave-shell-prompt-pattern "^ ?IDL> "  (defcustom idlwave-shell-prompt-pattern "^ ?IDL> "
121    "*Regexp to match IDL prompt at beginning of a line.    "*Regexp to match IDL prompt at beginning of a line.
122  For example, \"^IDL> \" or \"^WAVE> \".  For example, \"^IDL> \" or \"^WAVE> \".
123  The \"^\" means beginning of line.  The \"^\" means beginning of line, and is required.
124  This variable is used to initialise `comint-prompt-regexp' in the  This variable is used to initialize `comint-prompt-regexp' in the
125  process buffer.  process buffer.
126    
127  This is a fine thing to set in your `.emacs' file."  This is a fine thing to set in your `.emacs' file."
# Line 208  So by default setting a breakpoint will Line 209  So by default setting a breakpoint will
209    :group 'idlwave-shell-general-setup    :group 'idlwave-shell-general-setup
210    :type 'boolean)    :type 'boolean)
211    
212    (defcustom idlwave-shell-automatic-electric-debug 'breakpoint
213      "Enter the electric-debug minor mode automatically.  
214    This occurs at a breakpoint or any other halt.  The mode is exited
215    upon return to the main level.  Can be set to 'breakpoint to enter
216    electric debug mode only when breakpoints are tripped."
217      :group 'idlwave-shell-general-setup
218      :type '(choice
219              (const :tag "never" nil)
220              (const :tag "always" t)
221              (const :tag "for breakpoints only" breakpoint)))
222    
223    (defcustom idlwave-shell-electric-zap-to-file t
224      "When entering electric debug mode, select the window displaying the
225    file at which point is stopped.  This takes point away from the shell
226    window, but is useful for stepping, etc."
227      :group 'idlwave-shell-general-setup
228      :type 'boolean)
229    
230  ;; (defcustom idlwave-shell-debug-modifiers... See idlwave.el  ;; (defcustom idlwave-shell-debug-modifiers... See idlwave.el
231    
232  (defvar idlwave-shell-activate-alt-keybindings nil  (defvar idlwave-shell-activate-alt-keybindings nil
# Line 247  A command like `WINDOW,N,xsize=XX,ysize= Line 266  A command like `WINDOW,N,xsize=XX,ysize=
266            (integer :tag "x size")            (integer :tag "x size")
267            (integer :tag "y size")))            (integer :tag "y size")))
268    
269    
270  ;; Commands Sent to Shell... etc.  ;; Commands Sent to Shell... etc.
271  (defgroup idlwave-shell-command-setup nil  (defgroup idlwave-shell-command-setup nil
272    "Setup for command parameters of the Shell interaction for IDLWAVE."    "Setup for command parameters of the Shell interaction for IDLWAVE."
273    :prefix "idlwave-shell"    :prefix "idlwave-shell"
274    :group 'idlwave)    :group 'idlwave)
275    
276  (defcustom idlwave-shell-initial-commands "!more=0"  (defcustom idlwave-shell-initial-commands "!more=0 & defsysv,'!ERROR_STATE',EXISTS=__e & if __e then begin & !ERROR_STATE.MSG_PREFIX=\"% \" & delvar,__e & endif"
277    "Initial commands, separated by newlines, to send to IDL.    "Initial commands, separated by newlines, to send to IDL.
278  This string is sent to the IDL process by `idlwave-shell-mode' which is  This string is sent to the IDL process by `idlwave-shell-mode' which is
279  invoked by `idlwave-shell'."  invoked by `idlwave-shell'."
# Line 267  the history." Line 287  the history."
287    :group 'idlwave-shell-command-setup    :group 'idlwave-shell-command-setup
288    :type 'boolean)    :type 'boolean)
289    
290  (defcustom idlwave-shell-command-history-file "~/.idlwhist"  (defcustom idlwave-shell-command-history-file "idlwhist"
291    "The file in which the command history of the idlwave shell is saved.    "The file in which the command history of the idlwave shell is saved.
292  In order to change the size of the history, see the variable  In order to change the size of the history, see the variable
293  `comint-input-ring-size'.  `comint-input-ring-size'.
# Line 275  The history is only saved if the variabl Line 295  The history is only saved if the variabl
295  is non-nil."  is non-nil."
296    :group 'idlwave-shell-command-setup    :group 'idlwave-shell-command-setup
297    :type 'file)    :type 'file)
298      
299  (defcustom idlwave-shell-show-commands  (defcustom idlwave-shell-show-commands
300    '(run misc breakpoint)    '(run misc breakpoint)
301    "*A list of command types to show output from in the shell.    "*A list of command types to show output from in the shell.
302  Possibilities are 'run, 'debug, 'breakpoint, and 'misc .  Unlisted  Possibilities are 'run, 'debug, 'breakpoint, and 'misc.  Unselected
303  types are not displayed in the shell.  The single type 'everything  types are not displayed in the shell.  The type 'everything causes all
304  causes all the copious shell traffic to be displayed."  the copious shell traffic to be displayed."
305    :group 'idlwave-shell-command-setup    :group 'idlwave-shell-command-setup
306    :type '(choice    :type '(choice
307            (const everything)            (const everything)
308            (set :tag "Checklist" :greedy t            (set :tag "Checklist" :greedy t
309                 (const :tag "All .run and .compile commands"  run)                 (const :tag "All .run and .compile commands"        run)  
310                 (const :tag "All breakpoint commands"         breakpoint)                 (const :tag "All breakpoint commands"               breakpoint)
311                 (const :tag "All debug and stepping commands" debug)                 (const :tag "All debug and stepping commands"       debug)
312                 (const :tag "Return, close, etc. commands"    misc))))                 (const :tag "Close, window, retall, etc. commands"  misc))))
313    
314  (defcustom idlwave-shell-examine-alist  (defcustom idlwave-shell-examine-alist
315    '(("Print"            . "print,___")    '(("Print"            . "print,___")
316      ("Help"             . "help,___")      ("Help"             . "help,___")
317      ("Structure Help"   . "help,___,/STRUCTURE")      ("Structure Help"   . "help,___,/STRUCTURE")
# Line 302  causes all the copious shell traffic to Line 322  causes all the copious shell traffic to
322      ("Ptr Valid"        . "print,ptr_valid(___)")      ("Ptr Valid"        . "print,ptr_valid(___)")
323      ("Widget Valid"     . "print,widget_info(___,/VALID)")      ("Widget Valid"     . "print,widget_info(___,/VALID)")
324      ("Widget Geometry"  . "help,widget_info(___,/GEOMETRY)"))      ("Widget Geometry"  . "help,widget_info(___,/GEOMETRY)"))
325    "Alist of special examine commands for popup selection.    "Alist of special examine commands for popup selection.  
326  The keys are used in the selection popup created by  The keys are used in the selection popup created by
327  `idlwave-shell-examine-select', and the corresponding value is sent as  `idlwave-shell-examine-select', and the corresponding value is sent as
328  a command to the shell, with special sequence `___' replaced by the  a command to the shell, with special sequence `___' replaced by the
329  expression being examined."  expression being examined."
330    :group 'idlwave-shell-command-setup    :group 'idlwave-shell-command-setup
331    :type '(repeat    :type '(repeat
332            (cons            (cons
333             (string :tag "Label  ")             (string :tag "Label  ")
334             (string :tag "Command"))))             (string :tag "Command"))))
335    
# Line 320  expression being examined." Line 340  expression being examined."
340    "*Non-nil mean, put output of examine commands in their own buffer."    "*Non-nil mean, put output of examine commands in their own buffer."
341    :group 'idlwave-shell-command-setup    :group 'idlwave-shell-command-setup
342    :type 'boolean)    :type 'boolean)
343      
344  (defcustom idlwave-shell-comint-settings  (defcustom idlwave-shell-comint-settings
345    '((comint-scroll-to-bottom-on-input . t)    '((comint-scroll-to-bottom-on-input . t)
346      (comint-scroll-to-bottom-on-output . t)      (comint-scroll-to-bottom-on-output . t)
# Line 353  back, respectively.  See `idlwave-shell- Line 373  back, respectively.  See `idlwave-shell-
373    '("^<onechar>$" "^<chars>$" "^</chars>$")    '("^<onechar>$" "^<chars>$" "^</chars>$")
374    "The three regular expressions which match the magic spells for input modes.    "The three regular expressions which match the magic spells for input modes.
375    
376  When the first regexp matches in the output streem of IDL, IDLWAVE  When the first regexp matches in the output stream of IDL, IDLWAVE
377  prompts for a single character and sends it immediately to IDL, similar  prompts for a single character and sends it immediately to IDL, similar
378  to the command \\[idlwave-shell-send-char].  to the command \\[idlwave-shell-send-char].
379    
# Line 383  strings.  Here is some example code whic Line 403  strings.  Here is some example code whic
403    answer = GET_KBRD(1)    answer = GET_KBRD(1)
404    
405  Since the IDLWAVE shell defines the system variable `!IDLWAVE_VERSION',  Since the IDLWAVE shell defines the system variable `!IDLWAVE_VERSION',
406  you could actually check if you are running under Emacs before printing  you could actually check if you are running under Emacs before printing
407  the magic strings.  Here is a procedure which uses this.  the magic strings.  Here is a procedure which uses this.
408    
409  Usage:  Usage:
410  ======  ======
411  idlwave_char_input               ; Make IDLWAVE send one character  idlwave_char_input               ; Make IDLWAVE send one character
412  idlwave_char_input,/on           ; Start the loop to send characters  idlwave_char_input,/on           ; Start the loop to send characters
413  idlwave_char_input,/off          ; End the loop to send chracters  idlwave_char_input,/off          ; End the loop to send characters
414    
415    
416  pro idlwave_char_input,on=on,off=off  pro idlwave_char_input,on=on,off=off
# Line 400  pro idlwave_char_input,on=on,off=off Line 420  pro idlwave_char_input,on=on,off=off
420        if keyword_set(on) then         print,'<chars>' $        if keyword_set(on) then         print,'<chars>' $
421          else if keyword_set(off) then print,'</chars>' $          else if keyword_set(off) then print,'</chars>' $
422          else                          print,'<onechar>'          else                          print,'<onechar>'
423    endif    endif
424  end"  end"
425    :group 'idlwave-shell-command-setup    :group 'idlwave-shell-command-setup
426    :type '(list    :type '(list
# Line 453  line where IDL is stopped.  See also `id Line 473  line where IDL is stopped.  See also `id
473    :group 'idlwave-shell-highlighting-and-faces    :group 'idlwave-shell-highlighting-and-faces
474    :type 'symbol)    :type 'symbol)
475    
476    (defcustom idlwave-shell-electric-stop-color "Violet"
477      "*The color for the default face or overlay arrow when stopped."
478      :group 'idlwave-shell-highlighting-and-faces
479      :type 'string)
480    
481    (defcustom idlwave-shell-electric-stop-line-face
482      (prog1
483          (copy-face 'modeline 'idlwave-shell-electric-stop-line-face)
484        (set-face-background 'idlwave-shell-electric-stop-line-face
485                             idlwave-shell-electric-stop-color)
486        (condition-case nil
487            (set-face-foreground 'idlwave-shell-electric-stop-line-face nil)
488          (error nil)))
489      "*The face for `idlwave-shell-stop-line-overlay' when in electric debug mode.
490    Allows you to choose the font, color and other properties for the line
491    where IDL is stopped, when in Electric Debug Mode."
492      :group 'idlwave-shell-highlighting-and-faces
493      :type 'symbol)
494    
495  (defcustom idlwave-shell-mark-breakpoints t  (defcustom idlwave-shell-mark-breakpoints t
496    "*Non-nil means, mark breakpoints in the source files.    "*Non-nil means, mark breakpoints in the source files.
497  Legal values are:  Legal values are:
# Line 483  lines which have a breakpoint.  See also Line 522  lines which have a breakpoint.  See also
522      (defface idlwave-shell-bp-face      (defface idlwave-shell-bp-face
523        '((((class color)) (:foreground "Black" :background "Pink"))        '((((class color)) (:foreground "Black" :background "Pink"))
524          (t (:underline t)))          (t (:underline t)))
525        "Face for highlighting lines-with-breakpoints."        "Face for highlighting lines with breakpoints."
526        :group 'idlwave-shell-highlighting-and-faces)        :group 'idlwave-shell-highlighting-and-faces)
527    ;; Just copy the underline face to be on the safe side.    ;; Just copy the underline face to be on the safe side.
528    (copy-face 'underline 'idlwave-shell-bp-face))    (copy-face 'underline 'idlwave-shell-bp-face))
529    
530    (defcustom idlwave-shell-disabled-breakpoint-face
531      'idlwave-shell-disabled-bp-face
532      "*The face for disabled breakpoint lines in the source code.
533    Allows you to choose the font, color and other properties for
534    lines which have a breakpoint.  See also `idlwave-shell-mark-breakpoints'."
535      :group 'idlwave-shell-highlighting-and-faces
536      :type 'symbol)
537    
538    (if idlwave-shell-have-new-custom
539        ;; We have the new customize - use it to define a customizable face
540        (defface idlwave-shell-disabled-bp-face
541          '((((class color)) (:foreground "Black" :background "gray"))
542            (t (:underline t)))
543          "Face for highlighting lines with breakpoints."
544          :group 'idlwave-shell-highlighting-and-faces)
545      ;; Just copy the underline face to be on the safe side.
546      (copy-face 'underline 'idlwave-shell-disabled-bp-face))
547    
548    
549  (defcustom idlwave-shell-expression-face 'secondary-selection  (defcustom idlwave-shell-expression-face 'secondary-selection
550    "*The face for `idlwave-shell-expression-overlay'.    "*The face for `idlwave-shell-expression-overlay'.
551  Allows you to choose the font, color and other properties for  Allows you to choose the font, color and other properties for
# Line 508  the expression output by IDL." Line 566  the expression output by IDL."
566  (defvar comint-last-input-start)  (defvar comint-last-input-start)
567  (defvar comint-last-input-end)  (defvar comint-last-input-end)
568    
 (defvar idlwave-shell-temp-pro-file nil  
   "Absolute pathname for temporary IDL file for compiling regions")  
   
 (defvar idlwave-shell-temp-rinfo-save-file nil  
   "Absolute pathname for temporary IDL file save file for routine_info.  
 This is used to speed up the reloading of the routine info procedure  
 before use by the shell.")  
   
569  (defun idlwave-shell-temp-file (type)  (defun idlwave-shell-temp-file (type)
570    "Return a temp file, creating it if necessary.    "Return a temp file, creating it if necessary.
571    
572  TYPE is either `pro' or `rinfo', and `idlwave-shell-temp-pro-file' or  TYPE is either 'pro or 'rinfo, and idlwave-shell-temp-pro-file or
573  `idlwave-shell-temp-rinfo-save-file' is set (respectively)."  idlwave-shell-temp-rinfo-save-file is set (respectively)."
574    (cond    (cond
575     ((eq type 'rinfo)     ((eq type 'rinfo)
576      (or idlwave-shell-temp-rinfo-save-file      (or idlwave-shell-temp-rinfo-save-file
577          (setq idlwave-shell-temp-rinfo-save-file          (setq idlwave-shell-temp-rinfo-save-file
578                (idlwave-shell-make-temp-file idlwave-shell-temp-pro-prefix))))                (idlwave-shell-make-temp-file idlwave-shell-temp-pro-prefix))))
579     ((eq type 'pro)     ((eq type 'pro)
580      (or idlwave-shell-temp-pro-file      (or idlwave-shell-temp-pro-file
581          (setq idlwave-shell-temp-pro-file          (setq idlwave-shell-temp-pro-file
582                (idlwave-shell-make-temp-file idlwave-shell-temp-pro-prefix))))                (idlwave-shell-make-temp-file idlwave-shell-temp-pro-prefix))))
583     (t (error "Wrong argument (idlwave-shell-temp-file): %s"     (t (error "Wrong argument (idlwave-shell-temp-file): %s"
584               (symbol-name type)))))               (symbol-name type)))))
585        
586    
587  (defun idlwave-shell-make-temp-file (prefix)  (defun idlwave-shell-make-temp-file (prefix)
588    "Create a temporary file."    "Create a temporary file."
# Line 558  TYPE is either `pro' or `rinfo', and `id Line 608  TYPE is either `pro' or `rinfo', and `id
608          nil)          nil)
609        file)))        file)))
610    
611    ;; Other variables
612    (defvar idlwave-shell-temp-pro-file
613      nil
614      "Absolute pathname for temporary IDL file for compiling regions")
615    
616    (defvar idlwave-shell-temp-rinfo-save-file
617      nil
618      "Absolute pathname for temporary IDL file save file for routine_info.
619    This is used to speed up the reloading of the routine info procedure
620    before use by the shell.")
621    
622  (defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur"  (defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur"
623    "Command used by `idlwave-shell-resync-dirs' to query IDL for    "Command used by `idlwave-shell-resync-dirs' to query IDL for
624  the directory stack.")  the directory stack.")
625    
626  (defvar idlwave-shell-path-query "__pa=expand_path(!path,/array)&for i=0,n_elements(__pa)-1 do print,'PATH:<'+__pa[i]+'>'&print,'SYSDIR:<'+!dir+'>'"  (defvar idlwave-shell-path-query "print,'PATH:<'+transpose(expand_path(!PATH,/ARRAY))+'>' & print,'SYSDIR:<'+!dir+'>'"
627    "The command which gets !PATH and !DIR infor from the shell.")  
628      "The command which gets !PATH and !DIR info from the shell.")
629    
630  (defvar idlwave-shell-mode-line-info nil  (defvar idlwave-shell-mode-line-info nil
631    "Additional info displayed in the mode line")    "Additional info displayed in the mode line")  
632    
633  (defvar idlwave-shell-default-directory nil  (defvar idlwave-shell-default-directory nil
634    "The default directory in the idlwave-shell buffer, of outside use.")    "The default directory in the idlwave-shell buffer, of outside use.")
# Line 617  the directory stack.") Line 679  the directory stack.")
679              window-system)                ; Window systems always              window-system)                ; Window systems always
680      (progn      (progn
681        (setq idlwave-shell-stop-line-overlay (make-overlay 1 1))        (setq idlwave-shell-stop-line-overlay (make-overlay 1 1))
682        (overlay-put idlwave-shell-stop-line-overlay        (overlay-put idlwave-shell-stop-line-overlay
683                     'face idlwave-shell-stop-line-face))))                     'face idlwave-shell-stop-line-face))))
684    
685   (t   (t
# Line 625  the directory stack.") Line 687  the directory stack.")
687    (if window-system    (if window-system
688        (progn        (progn
689          (setq idlwave-shell-stop-line-overlay (make-overlay 1 1))          (setq idlwave-shell-stop-line-overlay (make-overlay 1 1))
690          (overlay-put idlwave-shell-stop-line-overlay          (overlay-put idlwave-shell-stop-line-overlay
691                       'face idlwave-shell-stop-line-face)))))                       'face idlwave-shell-stop-line-face)))))
692    
693  ;; Now the expression and output overlays  ;; Now the expression and output overlays
# Line 652  This is evaluated if it is a list or cal Line 714  This is evaluated if it is a list or cal
714    
715  (defvar idlwave-shell-hide-output nil  (defvar idlwave-shell-hide-output nil
716    "If non-nil the process output is not inserted into the output    "If non-nil the process output is not inserted into the output
717    buffer.")  buffer.")
718    
719    (defvar idlwave-shell-show-if-error nil
720      "If non-nil the process output is inserted into the output buffer if
721    it contains an error message, even if hide-output is non-nil.")
722    
723  (defvar idlwave-shell-accumulation nil  (defvar idlwave-shell-accumulation nil
724    "Accumulate last line of output.")    "Accumulate last line of output.")
# Line 682  with `*'s." Line 748  with `*'s."
748    
749  ;;; The following are the types of messages we attempt to catch to  ;;; The following are the types of messages we attempt to catch to
750  ;;; resync our idea of where IDL execution currently is.  ;;; resync our idea of where IDL execution currently is.
751  ;;;  ;;;
752    
753  (defvar idlwave-shell-halt-frame nil  (defvar idlwave-shell-halt-frame nil
754    "The frame associated with halt/breakpoint messages.")    "The frame associated with halt/breakpoint messages.")
# Line 694  with `*'s." Line 760  with `*'s."
760    "The frame associated with trace messages.")    "The frame associated with trace messages.")
761    
762  (defconst idlwave-shell-halt-messages  (defconst idlwave-shell-halt-messages
763    '("^% Execution halted at"    '("^% Interrupted at:"
     "^% Interrupted at:"  
764      "^% Stepped to:"      "^% Stepped to:"
765      "^% At "      "^% Skipped to:"
766      "^% Stop encountered:"      "^% Stop encountered:"
767      )      )
768    "*A list of regular expressions matching IDL messages.    "*A list of regular expressions matching IDL messages.
769  These are the messages containing file and line information where  These are the messages containing file and line information where
770  IDL is currently stopped.")  IDL is currently stopped.")
771    
772    
773  (defconst idlwave-shell-halt-messages-re  (defconst idlwave-shell-halt-messages-re
774    (mapconcat 'identity idlwave-shell-halt-messages "\\|")    (mapconcat 'identity idlwave-shell-halt-messages "\\|")
775    "The regular expression computed from idlwave-shell-halt-messages")    "The regular expression computed from idlwave-shell-halt-messages")
776    
777  (defconst idlwave-shell-trace-messages  (defconst idlwave-shell-trace-message-re
778    '("^% At "    ;; First line of a trace message    "^% At "    ;; First line of a trace message
779      )    "*A regular expression matching IDL trace messages.  These are the
780    "*A list of regular expressions matching IDL trace messages.  messages containing file and line information of a current
781  These are the messages containing file and line information where  traceback.")
 IDL will begin looking for the next statement to execute.")  
782    
783  (defconst idlwave-shell-step-messages  (defconst idlwave-shell-step-messages
784    '("^% Stepped to:"    '("^% Stepped to:"
# Line 725  IDL has currently stepped.") Line 790  IDL has currently stepped.")
790  (defvar idlwave-shell-break-message "^% Breakpoint at:"  (defvar idlwave-shell-break-message "^% Breakpoint at:"
791    "*Regular expression matching an IDL breakpoint message line.")    "*Regular expression matching an IDL breakpoint message line.")
792    
793    (defconst idlwave-shell-electric-debug-help
794      "   ==> IDLWAVE Electric Debug Mode Help <==
795    
796     Break Point Setting and Clearing:
797      b          Set breakpoint ([C-u b] for conditional, [C-n b] nth hit, etc.).
798      d          Clear nearby breakpoint.
799      a          Clear all breakpoints.
800      i          Set breakpoint in routine named here.
801      j          Set breakpoint at beginning of containing routine.
802      \\          Toggle breakpoint disable
803      ]          Go to next breakpoint in file.
804      [          Go to previous breakpoint in file.
805    
806     Stepping, Continuing, and the Stack:
807      s or SPACE Step, into function calls.
808      n          Step, over function calls.
809      k          Skip one statement.
810      m          Continue to end of function.
811      o          Continue past end of function.
812      u          Continue to end of block.
813      h          Continue to line at cursor position.
814      r          Continue execution to next breakpoint, if any.
815      + or =     Show higher level in calling stack.
816      - or _     Show lower level in calling stack.
817    
818     Examining Expressions (with prefix for examining the region):
819      p          Print expression near point or in region ([C-u p]).
820      ?          Help on expression near point or in region ([C-u ?]).
821      x          Examine expression near point or in region ([C-u x]) with
822                 letter completion of the examine type.
823    
824     Miscellaneous:
825      q          Quit - end debugging session and return to the Shell's main level.
826      v          Turn Electric Debugging Mode off (C-c C-d C-v to return).
827      t          Print a calling-level traceback in the shell.
828      z          Reset IDL.
829      C-?        Show this help menu.")
830    
831  (defvar idlwave-shell-bp-alist)  (defvar idlwave-shell-bp-alist)
832  ;(defvar idlwave-shell-post-command-output)  ;(defvar idlwave-shell-post-command-output)
# Line 768  IDL has currently stepped.") Line 870  IDL has currently stepped.")
870     `\\[idlwave-routine-info]' displays information about an IDL routine near point,     `\\[idlwave-routine-info]' displays information about an IDL routine near point,
871     just like in `idlwave-mode'.  The module used is the one at point or     just like in `idlwave-mode'.  The module used is the one at point or
872     the one whose argument list is being edited.     the one whose argument list is being edited.
873     To update IDLWAVE's knowledge about compiled or edited modules, use     To update IDLWAVE's knowledge about compiled or edited modules, use
874     \\[idlwave-update-routine-info].     \\[idlwave-update-routine-info].
875     \\[idlwave-find-module] find the source of a module.     \\[idlwave-find-module] find the source of a module.
876     \\[idlwave-resolve] tells IDL to compile an unresolved module.     \\[idlwave-resolve] tells IDL to compile an unresolved module.
877     \\[idlwave-context-help] shows the online help on the item at     \\[idlwave-context-help] shows the online help on the item at
878     point, if online help has been installed.     point, if online help has been installed.
879      
880    
881  4. Debugging  4. Debugging
882     ---------     ---------
883     A complete set of commands for compiling and debugging IDL programs     A complete set of commands for compiling and debugging IDL programs
884     is available from the menu.  Also keybindings starting with a     is available from the menu.  Also keybindings starting with a
885     `C-c C-d' prefix are available for most commands in the *idl* buffer     `C-c C-d' prefix are available for most commands in the *idl* buffer
886     and also in source buffers.  The best place to learn about the     and also in source buffers.  The best place to learn about the
887     keybindings is again the menu.     keybindings is again the menu.
# Line 794  IDL has currently stepped.") Line 896  IDL has currently stepped.")
896     \\[idlwave-shell-resync-dirs] queries IDL in order to change Emacs current directory     \\[idlwave-shell-resync-dirs] queries IDL in order to change Emacs current directory
897     to correspond to the IDL process current directory.     to correspond to the IDL process current directory.
898    
899  5. Hooks  5. Expression Examination
900       ----------------------
901    
902       Expressions near point can be examined with print,
903       \\[idlwave-shell-print] or \\[idlwave-shell-mouse-print] with the
904       mouse, help, \\[idlwave-shell-help-expression] or
905       \\[idlwave-shell-mouse-help] with the mouse, or with a
906       configureable set of custom examine commands using
907       \\[idlwave-shell-examine-select].  The mouse examine commands can
908       also work by click and drag, to select an expression for
909       examination.
910    
911    6. Hooks
912     -----     -----
913     Turning on `idlwave-shell-mode' runs `comint-mode-hook' and     Turning on `idlwave-shell-mode' runs `comint-mode-hook' and
914     `idlwave-shell-mode-hook' (in that order).     `idlwave-shell-mode-hook' (in that order).
915    
916  6. Documentation and Customization  7. Documentation and Customization
917     -------------------------------     -------------------------------
918     Info documentation for this package is available.  Use \\[idlwave-info]     Info documentation for this package is available.  Use \\[idlwave-info]
919     to display (complain to your sysadmin if that does not work).     to display (complain to your sysadmin if that does not work).
# Line 807  IDL has currently stepped.") Line 921  IDL has currently stepped.")
921     homepage at `http://idlwave.org'.     homepage at `http://idlwave.org'.
922     IDLWAVE has customize support - see the group `idlwave'.     IDLWAVE has customize support - see the group `idlwave'.
923    
924  7. Keybindings  8. Keybindings
925     -----------     -----------
926  \\{idlwave-shell-mode-map}"  \\{idlwave-shell-mode-map}"
927    
928    (interactive)    (interactive)
929      (idlwave-setup) ; Make sure config files and paths, etc. are available.
930      (unless (file-name-absolute-p idlwave-shell-command-history-file)
931        (setq idlwave-shell-command-history-file
932              (expand-file-name idlwave-shell-command-history-file
933                                idlwave-config-directory)))
934    
935    ;; We don't do `kill-all-local-variables' here, because this is done by    ;; We don't do `kill-all-local-variables' here, because this is done by
936    ;; comint - idlwave-shell-mode only add on top of that.    ;; comint
937    (setq comint-prompt-regexp idlwave-shell-prompt-pattern)    (setq comint-prompt-regexp idlwave-shell-prompt-pattern)
938    (setq comint-process-echoes t)    (setq comint-process-echoes t)
939    
940    ;; Can not use history expansion because "!" is used for system variables.    ;; Can not use history expansion because "!" is used for system variables.
941    (setq comint-input-autoexpand nil)    (setq comint-input-autoexpand nil)
942  ;  (setq comint-input-ring-size 64)  ;  (setq comint-input-ring-size 64)
# Line 851  IDL has currently stepped.") Line 972  IDL has currently stepped.")
972          idlwave-shell-step-frame nil)          idlwave-shell-step-frame nil)
973    (idlwave-shell-display-line nil)    (idlwave-shell-display-line nil)
974    (setq idlwave-shell-calling-stack-index 0)    (setq idlwave-shell-calling-stack-index 0)
975      (setq idlwave-shell-only-prompt-pattern
976            (concat "\\`[ \t\n]*"
977                    (substring idlwave-shell-prompt-pattern 1)
978                    "[ \t\n]*\\'"))
979    
980    (when idlwave-shell-query-for-class    (when idlwave-shell-query-for-class
981        (add-to-list (make-local-variable 'idlwave-determine-class-special)        (add-to-list (make-local-variable 'idlwave-determine-class-special)
# Line 884  IDL has currently stepped.") Line 1009  IDL has currently stepped.")
1009        (while (setq entry (pop list))        (while (setq entry (pop list))
1010          (set (make-local-variable (car entry)) (cdr entry)))))          (set (make-local-variable (car entry)) (cdr entry)))))
1011    
1012      
1013      (unless (memq 'comint-carriage-motion
1014                    (default-value 'comint-output-filter-functions))
1015        ;; Strip those pesky ctrl-m's.
1016        (add-hook 'comint-output-filter-functions
1017                  (lambda (string)
1018                    (when (string-match "\r" string)
1019                      (let ((pmark (process-mark (get-buffer-process
1020                                                  (current-buffer)))))
1021                        (save-excursion
1022                          ;; bare CR -> delete preceding line
1023                          (goto-char comint-last-output-start)
1024                          (while (search-forward "\r" pmark t)
1025                            (delete-region (point) (line-beginning-position)))))))
1026                    'append 'local)
1027        (add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m nil 'local))
1028    
1029      ;; Python-mode, bundled with many Emacs installs, quite cavalierly
1030      ;; adds this function to the global default hook.  It interferes
1031      ;; with overlay-arrows.
1032      (remove-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file)
1033    
1034    
1035    ;; IDLWAVE syntax, and turn on abbreviations    ;; IDLWAVE syntax, and turn on abbreviations
1036    (setq local-abbrev-table idlwave-mode-abbrev-table)    (setq local-abbrev-table idlwave-mode-abbrev-table)
1037    (set-syntax-table idlwave-mode-syntax-table)    (set-syntax-table idlwave-mode-syntax-table)
# Line 902  IDL has currently stepped.") Line 1050  IDL has currently stepped.")
1050      (if (file-regular-p idlwave-shell-command-history-file)      (if (file-regular-p idlwave-shell-command-history-file)
1051          (comint-read-input-ring)))          (comint-read-input-ring)))
1052    
1053      ;; Turn off the non-debug toolbar buttons (open,save,etc.)
1054      (set (make-local-variable 'tool-bar-map) nil)
1055    
1056    ;; Run the hooks.    ;; Run the hooks.
1057    (run-hooks 'idlwave-shell-mode-hook)    (run-hooks 'idlwave-shell-mode-hook)
1058    (idlwave-shell-send-command idlwave-shell-initial-commands nil 'hide)    (idlwave-shell-send-command idlwave-shell-initial-commands nil 'hide)
1059    ;; Define a system variable which knows the version of IDLWAVE    ;; Turn off IDL's ^d interpreting, and define a system
1060    (idlwave-shell-send-command    ;; variable which knows the version of IDLWAVE
1061     (format "defsysv,'!idlwave_version','%s',1" idlwave-mode-version)    (idlwave-shell-send-command
1062       (format "defsysv,'!idlwave_version','%s',1"
1063               idlwave-mode-version)
1064     nil 'hide)     nil 'hide)
1065      ;; Get the paths if they weren't read in from file
1066    (if (and (not idlwave-path-alist)    (if (and (not idlwave-path-alist)
1067             (not idlwave-sys-dir))             (or (not (stringp idlwave-system-directory))
1068                   (eq (length idlwave-system-directory) 0)))
1069        (idlwave-shell-send-command idlwave-shell-path-query        (idlwave-shell-send-command idlwave-shell-path-query
1070                                    'idlwave-shell-get-path-info                                    'idlwave-shell-get-path-info
1071                                    'hide)))                                    'hide)))
1072    
1073  (defun idlwave-shell-get-path-info ()  (defun idlwave-shell-get-path-info (&optional no-write)
1074      "Get the path lists, writing to file unless NO-WRITE is set."
1075    (let* ((rpl (idlwave-shell-path-filter))    (let* ((rpl (idlwave-shell-path-filter))
1076           (sysdir (car rpl))           (sysdir (car rpl))
1077           (dirs (cdr rpl)))           (dirs (cdr rpl))
1078      (setq idlwave-sys-dir sysdir)           (old-path-alist idlwave-path-alist))
1079      (setq idlwave-path-alist (mapcar (lambda(x) (cons x nil))      (when sysdir
1080                                       dirs))))        (setq idlwave-system-directory sysdir)
1081          (put 'idlwave-system-directory 'from-shell t))
1082        ;; Preserve any existing flags
1083        (setq idlwave-path-alist
1084              (mapcar (lambda (x)
1085                        (let ((old-entry (assoc x old-path-alist)))
1086                          (if old-entry
1087                              (cons x (cdr old-entry))
1088                            (list x))))
1089                      dirs))
1090        (put 'idlwave-path-alist 'from-shell t)
1091        (if idlwave-path-alist
1092            (if (and idlwave-auto-write-paths
1093                     (not idlwave-library-path)
1094                     (not no-write) )
1095                (idlwave-write-paths))
1096          ;; Fall back
1097          (setq idlwave-path-alist old-path-alist))))
1098    
1099  (if (not (fboundp 'idl-shell))  (if (not (fboundp 'idl-shell))
1100      (fset 'idl-shell 'idlwave-shell))      (fset 'idl-shell 'idlwave-shell))
# Line 951  IDL has currently stepped.") Line 1124  IDL has currently stepped.")
1124                           (frame (selected-frame)))                           (frame (selected-frame)))
1125                       (catch 'exit                       (catch 'exit
1126                         (while flist                         (while flist
1127                           (if (not (eq (car flist)                           (if (not (eq (car flist)
1128                                        idlwave-shell-idl-wframe))                                        idlwave-shell-idl-wframe))
1129                               (throw 'exit (car flist))                               (throw 'exit (car flist))
1130                             (setq flist (cdr flist))))))                             (setq flist (cdr flist))))))
1131                     (make-frame))                     (make-frame))
# Line 970  IDL has currently stepped.") Line 1143  IDL has currently stepped.")
1143              ;; We do not have a source frame, so we use this one.              ;; We do not have a source frame, so we use this one.
1144              (setq idlwave-shell-display-wframe (selected-frame)))              (setq idlwave-shell-display-wframe (selected-frame)))
1145          ;; Return a new frame          ;; Return a new frame
1146          (setq idlwave-shell-idl-wframe          (setq idlwave-shell-idl-wframe
1147                (make-frame idlwave-shell-frame-parameters)))))                (make-frame idlwave-shell-frame-parameters)))))
1148      
1149  ;;;###autoload  ;;;###autoload
1150  (defun idlwave-shell (&optional arg quick)  (defun idlwave-shell (&optional arg quick)
1151    "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'.    "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'.
# Line 999  See also the variable `idlwave-shell-pro Line 1172  See also the variable `idlwave-shell-pro
1172            (delete-other-windows))            (delete-other-windows))
1173          (and idlwave-shell-use-dedicated-frame          (and idlwave-shell-use-dedicated-frame
1174               (setq idlwave-shell-idl-wframe (selected-frame)))               (setq idlwave-shell-idl-wframe (selected-frame)))
1175          (add-hook 'idlwave-shell-sentinel-hook          (add-hook 'idlwave-shell-sentinel-hook
1176                    'save-buffers-kill-emacs t))                    'save-buffers-kill-emacs t))
1177    
1178      ;; A non-nil arg means, we want a dedicated frame.  This will last      ;; A non-nil arg means, we want a dedicated frame.  This will last
1179      ;; for the current editing session.      ;; for the current editing session.
1180      (if arg (setq idlwave-shell-use-dedicated-frame t))      (if arg (setq idlwave-shell-use-dedicated-frame t))
1181      (if (equal arg '(16)) (setq idlwave-shell-use-dedicated-frame nil))      (if (equal arg '(16)) (setq idlwave-shell-use-dedicated-frame nil))
1182        
1183      ;; Check if the process still exists.  If not, create it.      ;; Check if the process still exists.  If not, create it.
1184      (unless (comint-check-proc (idlwave-shell-buffer))      (unless (comint-check-proc (idlwave-shell-buffer))
1185        (let* ((prg (or idlwave-shell-explicit-file-name "idl"))        (let* ((prg (or idlwave-shell-explicit-file-name "idl"))
# Line 1031  See also the variable `idlwave-shell-pro Line 1204  See also the variable `idlwave-shell-pro
1204        (if idlwave-shell-ready        (if idlwave-shell-ready
1205            (raise-frame (window-frame window)))            (raise-frame (window-frame window)))
1206        (if (eq (selected-frame) (window-frame window))        (if (eq (selected-frame) (window-frame window))
1207            (select-window window))            (select-window window))))
1208        )))    ;; Save the paths at the end
1209      (add-hook 'idlwave-shell-sentinel-hook
1210                (lambda ()
1211                  (if (and
1212                       idlwave-auto-write-paths
1213                       idlwave-path-alist
1214                       (not idlwave-library-path)
1215                       (get 'idlwave-path-alist 'from-shell))
1216                      (idlwave-write-paths)))))
1217    
1218  (defun idlwave-shell-recenter-shell-window (&optional arg)  (defun idlwave-shell-recenter-shell-window (&optional arg)
1219    "Run `idlwave-shell', but make sure the current window stays selected."    "Run `idlwave-shell', but make sure the current window stays selected."
# Line 1041  See also the variable `idlwave-shell-pro Line 1222  See also the variable `idlwave-shell-pro
1222      (idlwave-shell arg)      (idlwave-shell arg)
1223      (select-window window)))      (select-window window)))
1224    
1225  (defun idlwave-shell-hide-p (type)  (defun idlwave-shell-hide-p (type &optional list)
1226    "Whether to hide this type of command.    "Whether to hide this type of command.
1227  Return either nil or 'hide."  Return either nil or 'hide."
1228      (let ((list (or list idlwave-shell-show-commands)))
1229        (if (listp list)
1230          (if (not (memq type list)) 'hide))))
1231    
1232    (defun idlwave-shell-add-or-remove-show (type)
1233      "Add or remove a show command from the list."
1234    (if (listp idlwave-shell-show-commands)    (if (listp idlwave-shell-show-commands)
1235        (if (not (memq type idlwave-shell-show-commands)) 'hide)))        (setq idlwave-shell-show-commands
1236                (if (memq type idlwave-shell-show-commands)
1237                    (delq type idlwave-shell-show-commands)
1238                  (add-to-list'idlwave-shell-show-commands type)))
1239        (setq idlwave-shell-show-commands (list type))))
1240    
1241  (defun idlwave-shell-send-command (&optional cmd pcmd hide preempt)  
1242    (defun idlwave-shell-send-command (&optional cmd pcmd hide preempt
1243                                                 show-if-error)
1244    "Send a command to IDL process.    "Send a command to IDL process.
1245    
1246  \(CMD PCMD HIDE\) are placed at the end of  \(CMD PCMD HIDE\) are placed at the end of `
1247  ` idlwave-shell-pending-commands'.  If IDL is ready the first command,  idlwave-shell-pending-commands'.  If IDL is ready the first command,
1248  CMD, in `idlwave-shell-pending-commands' is sent to the IDL process.  CMD, in `idlwave-shell-pending-commands' is sent to the IDL process.
1249    
1250  If optional second argument PCMD is non-nil it will be placed on  If optional second argument PCMD is non-nil it will be placed on
1251  `idlwave-shell-post-command-hook' when CMD is executed.  If the  `idlwave-shell-post-command-hook' when CMD is executed.
1252  optional third argument HIDE is non-nil, then hide output from CMD.  
1253    If the optional third argument HIDE is non-nil, then hide output from
1254    CMD, unless it is the symbol 'mostly, in which case only output
1255    beginning with \"%\" is hidden, and all other output (i.e., the
1256    results of a PRINT command), is shown.  This helps with, e.g.,
1257    stepping through code with output.
1258    
1259  If optional fourth argument PREEMPT is non-nil CMD is put at front of  If optional fourth argument PREEMPT is non-nil CMD is put at front of
1260  `idlwave-shell-pending-commands'.  If PREEMPT is 'wait, wait for all  `idlwave-shell-pending-commands'.  If PREEMPT is 'wait, wait for all
1261  output to complete and the next prompt to arrive before returning  output to complete and the next prompt to arrive before returning
1262  \(useful if you need an answer now\). IDL is considered ready if the  \(useful if you need an answer now\). IDL is considered ready if the
1263  prompt is present and if `idlwave-shell-ready' is non-nil."  prompt is present and if `idlwave-shell-ready' is non-nil.  
1264    
1265    If SHOW-IF-ERROR is non-nil, show the output it it contains an error
1266    message, independent of what HIDE is set to."
1267    
1268  ;  (setq hide nil)  ;  FIXME: turn this on for debugging only  ;  (setq hide nil)  ;  FIXME: turn this on for debugging only
1269  ;  (if (null cmd)  ;  (if (null cmd)
1270  ;      (progn  ;      (progn
1271  ;       (message "SENDING Pending commands: %s"  ;       (message "SENDING Pending commands: %s"
1272  ;                (prin1-to-string idlwave-shell-pending-commands)))  ;                (prin1-to-string idlwave-shell-pending-commands)))
1273  ;    (message "SENDING %s|||%s" cmd pcmd))  ;    (message "SENDING %s|||%s" cmd pcmd))
1274    (if (and (symbolp idlwave-shell-show-commands)    (if (and (symbolp idlwave-shell-show-commands)
1275             (eq idlwave-shell-show-commands 'everything))             (eq idlwave-shell-show-commands 'everything))
1276        (setq hide nil))        (setq hide nil))
1277    (let ((save-buffer (current-buffer))    (let ((save-buffer (current-buffer))
# Line 1093  prompt is present and if `idlwave-shell- Line 1296  prompt is present and if `idlwave-shell-
1296            (setq idlwave-shell-pending-commands            (setq idlwave-shell-pending-commands
1297                  (if preempt                  (if preempt
1298                      ;; Put at front.                      ;; Put at front.
1299                      (append (list (list cmd pcmd hide))                      (append (list (list cmd pcmd hide show-if-error))
1300                              idlwave-shell-pending-commands)                              idlwave-shell-pending-commands)
1301                    ;; Put at end.                    ;; Put at end.
1302                    (append idlwave-shell-pending-commands                    (append idlwave-shell-pending-commands
1303                            (list (list cmd pcmd hide))))))                            (list (list cmd pcmd hide show-if-error))))))
1304        ;; Check if IDL ready        ;; Check if IDL ready
1305        (let ((save-point (point-marker)))        (let ((save-point (point-marker)))
1306          (goto-char (process-mark proc))          (goto-char (process-mark proc))
# Line 1112  prompt is present and if `idlwave-shell- Line 1315  prompt is present and if `idlwave-shell-
1315              (let* ((lcmd (car idlwave-shell-pending-commands))              (let* ((lcmd (car idlwave-shell-pending-commands))
1316                     (cmd (car lcmd))                     (cmd (car lcmd))
1317                     (pcmd (nth 1 lcmd))                     (pcmd (nth 1 lcmd))
1318                     (hide (nth 2 lcmd)))                     (hide (nth 2 lcmd))
1319                       (show-if-error (nth 3 lcmd)))
1320                ;; If this is an executive command, reset the stack pointer                ;; If this is an executive command, reset the stack pointer
1321                (if (eq (string-to-char cmd) ?.)                (if (eq (string-to-char cmd) ?.)
1322                    (setq idlwave-shell-calling-stack-index 0))                    (setq idlwave-shell-calling-stack-index 0))
# Line 1120  prompt is present and if `idlwave-shell- Line 1324  prompt is present and if `idlwave-shell-
1324                (setq idlwave-shell-post-command-hook pcmd)                (setq idlwave-shell-post-command-hook pcmd)
1325                ;; Output hiding                ;; Output hiding
1326                (setq idlwave-shell-hide-output hide)                (setq idlwave-shell-hide-output hide)
1327                  ;;Showing errors
1328                  (setq idlwave-shell-show-if-error show-if-error)
1329                ;; Pop command                ;; Pop command
1330                (setq idlwave-shell-pending-commands                (setq idlwave-shell-pending-commands
1331                      (cdr idlwave-shell-pending-commands))                      (cdr idlwave-shell-pending-commands))
# Line 1142  prompt is present and if `idlwave-shell- Line 1348  prompt is present and if `idlwave-shell-
1348      (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))      (if (or (not (setq buf (get-buffer (idlwave-shell-buffer))))
1349              (not (setq proc (get-buffer-process buf))))              (not (setq proc (get-buffer-process buf))))
1350          (funcall errf "Shell is not running"))          (funcall errf "Shell is not running"))
1351      (if (equal c ?\C-g)      (if (equal c ?\C-g)
1352          (funcall errf "Abort")          (funcall errf "Abort")
1353        (comint-send-string proc (char-to-string c)))))        (comint-send-string proc (char-to-string c)))))
1354    
# Line 1183  when the IDL prompt gets displayed again Line 1389  when the IDL prompt gets displayed again
1389      (if idlwave-shell-ready      (if idlwave-shell-ready
1390          (funcall errf "No IDL program seems to be waiting for input"))          (funcall errf "No IDL program seems to be waiting for input"))
1391    
1392      ;; OK, start the loop      ;; OK, start the loop
1393      (message "Character mode on:  Sending single chars (`C-g' to exit)")      (message "Character mode on:  Sending single chars (`C-g' to exit)")
1394      (message      (message
1395       (catch 'exit       (catch 'exit
# Line 1224  Otherwise just move the line.  Move down Line 1430  Otherwise just move the line.  Move down
1430      (if (and idlwave-shell-arrows-do-history      (if (and idlwave-shell-arrows-do-history
1431               (>= (1+ (save-excursion (end-of-line) (point))) proc-pos))               (>= (1+ (save-excursion (end-of-line) (point))) proc-pos))
1432          (progn          (progn
1433            (goto-char proc-pos)            ;;(goto-char proc-pos)
1434            (and (not (eolp)) (kill-line nil))            (goto-char (point-max))
1435              ;;(and (not (eolp)) (kill-line nil))
1436            (comint-previous-input arg))            (comint-previous-input arg))
1437        (previous-line arg))))        (previous-line arg))))
1438    
# Line 1252  Otherwise just move the line.  Move down Line 1459  Otherwise just move the line.  Move down
1459    "Return t if the shell process is running."    "Return t if the shell process is running."
1460    (eq (process-status idlwave-shell-process-name) 'run))    (eq (process-status idlwave-shell-process-name) 'run))
1461    
1462    (defvar idlwave-shell-only-prompt-pattern nil)
1463    (defun idlwave-shell-filter-hidden-output (output)
1464      "Filter hidden output, leaving the good stuff.
1465    
1466    Remove everything to the first newline, and all lines with % in front
1467    of them, with optional follow-on lines starting with two spaces.  This
1468    works well enough, since any print output typically arrives before
1469    error messages, etc."
1470      (setq output (substring output (string-match "\n" output)))
1471      (while (string-match "\\(\n\\|\\`\\)%.*\\(\n  .*\\)*" output)
1472        (setq output (replace-match "" nil t output)))
1473      (unless
1474          (string-match idlwave-shell-only-prompt-pattern output)
1475        output))
1476    
1477  (defvar idlwave-shell-hidden-output-buffer " *idlwave-shell-hidden-output*"  (defvar idlwave-shell-hidden-output-buffer " *idlwave-shell-hidden-output*"
1478    "Buffer containing hidden output from IDL commands.")    "Buffer containing hidden output from IDL commands.")
1479      
1480  (defun idlwave-shell-filter (proc string)  (defun idlwave-shell-filter (proc string)
1481    "Replace Carriage returns in output. Watch for prompt.    "Watch for IDL prompt and filter incoming text.
1482  When the IDL prompt is received executes `idlwave-shell-post-command-hook'  When the IDL prompt is received executes `idlwave-shell-post-command-hook'
1483  and then calls `idlwave-shell-send-command' for any pending commands."  and then calls `idlwave-shell-send-command' for any pending commands."
1484    ;; We no longer do the cleanup here - this is done by the process sentinel    ;; We no longer do the cleanup here - this is done by the process sentinel
1485    (when (eq (process-status idlwave-shell-process-name) 'run)    (when (eq (process-status idlwave-shell-process-name) 'run)
1486      ;; OK, process is still running, so we can use it.      ;; OK, process is still running, so we can use it.
1487      (let ((data (match-data)) p)      (let ((data (match-data)) p full-output)
1488        (unwind-protect        (unwind-protect
1489            (progn            (progn
1490              ;; May change the original match data.              ;; Ring the bell if necessary
             (while (setq p (string-match "\C-M" string))  
               (aset string p ?\  ))  
   
             ;;  
             ;; Keep output  
   
 ; Should not keep output because the concat is costly.  If hidden put  
 ; the output in a hide-buffer.  Then when the output is needed in post  
 ; processing can access either the hide buffer or the idlwave-shell  
 ; buffer.  Then watching for the prompt is easier.  Furthermore, if it  
 ; is hidden and there is no post command, could throw away output.  
 ;           (setq idlwave-shell-command-output  
 ;                 (concat idlwave-shell-command-output string))  
             ;; Insert the string. Do this before getting the  
             ;; state.  
1491              (while (setq p (string-match "\C-G" string))              (while (setq p (string-match "\C-G" string))
1492                (ding)                (ding)
1493                (aset string p ?\C-j ))                (aset string p ?\C-j ))
1494              (if idlwave-shell-hide-output              (if idlwave-shell-hide-output
1495                  (save-excursion                  (save-excursion
1496                    (set-buffer                    (while (setq p (string-match "\C-M" string))
1497                     (get-buffer-create idlwave-shell-hidden-output-buffer))                      (aset string p ?\  ))
1498                    (goto-char (point-max))                    (set-buffer
1499                    (insert string))                     (get-buffer-create idlwave-shell-hidden-output-buffer))
1500                      (goto-char (point-max))
1501                      (insert string))
1502                (idlwave-shell-comint-filter proc string))                (idlwave-shell-comint-filter proc string))
1503              ;; Watch for magic - need to accumulate the current line              ;; Watch for magic - need to accumulate the current line
1504              ;; since it may not be sent all at once.              ;; since it may not be sent all at once.
# Line 1299  and then calls `idlwave-shell-send-comma Line 1508  and then calls `idlwave-shell-send-comma
1508                        (idlwave-shell-input-mode-magic                        (idlwave-shell-input-mode-magic
1509                         (concat idlwave-shell-accumulation string)))                         (concat idlwave-shell-accumulation string)))
1510                    (setq idlwave-shell-accumulation                    (setq idlwave-shell-accumulation
1511                          (substring string                          (substring string
1512                                     (progn (string-match "\\(.*\n\\)*" string)                                     (progn (string-match "\\(.*[\n\r]+\\)*"
1513                                                            string)
1514                                            (match-end 0)))))                                            (match-end 0)))))
1515                (setq idlwave-shell-accumulation                (setq idlwave-shell-accumulation
1516                      (concat idlwave-shell-accumulation string)))                      (concat idlwave-shell-accumulation string)))
1517                
1518                
1519  ;;; Test/Debug code  ;;; Test/Debug code
1520  ;            (save-excursion (set-buffer  ;             (save-excursion (set-buffer
1521  ;                             (get-buffer-create "*idlwave-shell-output*"))  ;                              (get-buffer-create "*idlwave-shell-output*"))
1522  ;                            (goto-char (point-max))  ;                             (goto-char (point-max))
1523  ;                            (insert "\nSTRING===>\n" string "\n<====\n"))  ;                             (insert "\nSTRING===>\n" string "\n<====\n"))
1524                
1525              ;; Check for prompt in current accumulating output              ;; Check for prompt in current accumulating output
1526              (if (setq idlwave-shell-ready              (if (setq idlwave-shell-ready
1527                        (string-match idlwave-shell-prompt-pattern                        (string-match idlwave-shell-prompt-pattern
1528                                      idlwave-shell-accumulation))                                      idlwave-shell-accumulation))
1529                  (progn                  (progn
1530                      ;; Gather the command output
1531                    (if idlwave-shell-hide-output                    (if idlwave-shell-hide-output
1532                        (save-excursion                        (save-excursion
1533                          (set-buffer idlwave-shell-hidden-output-buffer)                          (set-buffer idlwave-shell-hidden-output-buffer)
1534                            (setq full-output (buffer-string))
1535                          (goto-char (point-max))                          (goto-char (point-max))
1536                          (re-search-backward idlwave-shell-prompt-pattern nil t)                          (re-search-backward idlwave-shell-prompt-pattern nil t)
1537                          (goto-char (match-end 0))                          (goto-char (match-end 0))
1538                          (setq idlwave-shell-command-output                          (setq idlwave-shell-command-output
1539                                (buffer-substring (point-min) (point)))                                (buffer-substring (point-min) (point)))
   
 ;;; Test/Debug  
 ;                        (save-excursion (set-buffer  
 ;                                         (get-buffer-create "*idlwave-shell-output*"))  
 ;                                        (goto-char (point-max))  
 ;                                        (insert "\nOUPUT===>\n" idlwave-shell-command-output "\n<===\n"))  
   
1540                          (delete-region (point-min) (point)))                          (delete-region (point-min) (point)))
1541                      (setq idlwave-shell-command-output                      (setq idlwave-shell-command-output
1542                            (with-current-buffer (process-buffer proc)                            (with-current-buffer (process-buffer proc)
# Line 1342  and then calls `idlwave-shell-send-comma Line 1547  and then calls `idlwave-shell-send-comma
1547                                 (point))                                 (point))
1548                               comint-last-input-end))))                               comint-last-input-end))))
1549    
1550                    ;; Scan for state and do post command - bracket them                    ;; Scan for state and do post commands - bracket
1551                    ;; with idlwave-shell-ready=nil since they                    ;; them with idlwave-shell-ready=nil since they may
1552                    ;; may call idlwave-shell-send-command.                    ;; call idlwave-shell-send-command themselves.
1553                    (let ((idlwave-shell-ready nil))                    (let ((idlwave-shell-ready nil))
1554                      (idlwave-shell-scan-for-state)                      (idlwave-shell-scan-for-state)
1555                      ;; Unset idlwave-shell-ready to prevent sending                      ;; Show the output in the shell if it contains an error
1556                      ;; commands to IDL while running hook.                      (if idlwave-shell-hide-output
1557                            (if (and idlwave-shell-show-if-error
1558                                     (eq idlwave-shell-current-state 'error))
1559                                (idlwave-shell-comint-filter proc full-output)
1560                              ;; If it's only *mostly* hidden, filter % lines,
1561                              ;; and show anything that remains
1562                              (if (eq idlwave-shell-hide-output 'mostly)
1563                                  (let ((filtered
1564                                         (idlwave-shell-filter-hidden-output
1565                                          full-output)))
1566                                    (if filtered
1567                                        (idlwave-shell-comint-filter
1568                                         proc filtered))))))
1569                        
1570                        ;; Call the post-command hook
1571                      (if (listp idlwave-shell-post-command-hook)                      (if (listp idlwave-shell-post-command-hook)
1572                          (eval idlwave-shell-post-command-hook)                          (progn
1573                              ;(message "Calling list")
1574                              ;(prin1 idlwave-shell-post-command-hook)
1575                              (eval idlwave-shell-post-command-hook))
1576                          ;(message "Calling command function")
1577                        (funcall idlwave-shell-post-command-hook))                        (funcall idlwave-shell-post-command-hook))
1578                      ;; Reset to default state for next command.  
1579                        ;; Reset to default state for next command.
1580                      ;; Also we do not want to find this prompt again.                      ;; Also we do not want to find this prompt again.
1581                      (setq idlwave-shell-accumulation nil                      (setq idlwave-shell-accumulation nil
1582                            idlwave-shell-command-output nil                            idlwave-shell-command-output nil
1583                            idlwave-shell-post-command-hook nil                            idlwave-shell-post-command-hook nil
1584                            idlwave-shell-hide-output nil                            idlwave-shell-hide-output nil
1585                              idlwave-shell-show-if-error nil
1586                            idlwave-shell-wait-for-output nil))                            idlwave-shell-wait-for-output nil))
1587                    ;; Done with post command. Do pending command if                    ;; Done with post command. Do pending command if
1588                    ;; any.                    ;; any.
# Line 1369  and then calls `idlwave-shell-send-comma Line 1594  and then calls `idlwave-shell-send-comma
1594  ;                                (get-buffer-create "*idlwave-shell-output*"))  ;                                (get-buffer-create "*idlwave-shell-output*"))
1595  ;                               (goto-char (point-max))  ;                               (goto-char (point-max))
1596  ;                               (insert "\n<=== WAITING ON OUTPUT ==>\n"))  ;                               (insert "\n<=== WAITING ON OUTPUT ==>\n"))
1597                    (accept-process-output proc nil 100))))                    (accept-process-output proc 1))))
1598          (store-match-data data)))))          (store-match-data data)))))
1599    
1600  (defun idlwave-shell-sentinel (process event)  (defun idlwave-shell-sentinel (process event)
# Line 1386  and then calls `idlwave-shell-send-comma Line 1611  and then calls `idlwave-shell-send-comma
1611              (condition-case nil              (condition-case nil
1612                  (comint-write-input-ring)                  (comint-write-input-ring)
1613                (error nil)))))                (error nil)))))
1614                
1615      (when (and (> (length (frame-list)) 1)      (when (and (> (length (frame-list)) 1)
1616                 (frame-live-p idlwave-shell-idl-wframe))                 (frame-live-p idlwave-shell-idl-wframe))
1617        (delete-frame idlwave-shell-idl-wframe)        (delete-frame idlwave-shell-idl-wframe)
# Line 1403  and then calls `idlwave-shell-send-comma Line 1628  and then calls `idlwave-shell-send-comma
1628            (run-hooks 'idlwave-shell-sentinel-hook))            (run-hooks 'idlwave-shell-sentinel-hook))
1629        (run-hooks 'idlwave-shell-sentinel-hook))))        (run-hooks 'idlwave-shell-sentinel-hook))))
1630    
1631    (defvar idlwave-shell-current-state nil)
1632  (defun idlwave-shell-scan-for-state ()  (defun idlwave-shell-scan-for-state ()
1633    "Scan for state info.    "Scan for state info.  Looks for messages in output from last IDL
1634  Looks for messages in output from last IDL command indicating where  command indicating where IDL has stopped. The types of messages we are
1635  IDL has stopped. The types of messages we are interested in are  interested in are execution halted, stepped, breakpoint, interrupted
1636  execution halted, stepped, breakpoint, interrupted at and trace  at and trace messages.  For breakpoint messages process any attached
1637  messages.  We ignore error messages otherwise.  count or command parameters.  Update the stop line if a message is
1638  For breakpoint messages process any attached count or command  found.  The variable `idlwave-shell-current-state' is set to 'error,
1639  parameters.  'halt, or 'breakpoint, which describes the status, or nil for none of
1640  Update the windows if a message is found."  the above."
1641    (cond    (let (trace)
1642     ;; Make sure we have output      (cond
1643     ((not idlwave-shell-command-output))       ;; Make sure we have output
1644         ((not idlwave-shell-command-output))
1645     ;; First Priority: Syntax and other errors      
1646     ((or       ;; First Priority: Syntax and other errors
1647       (string-match idlwave-shell-syntax-error idlwave-shell-command-output)       ((or
1648       (string-match idlwave-shell-other-error idlwave-shell-command-output))         (string-match idlwave-shell-syntax-error
1649      (save-excursion                       idlwave-shell-command-output)
1650        (set-buffer         (string-match idlwave-shell-other-error
1651         (get-buffer-create idlwave-shell-error-buffer))                       idlwave-shell-command-output))
1652        (erase-buffer)        (save-excursion
1653        (insert idlwave-shell-command-output)          (set-buffer
1654        (goto-char (point-min))           (get-buffer-create idlwave-shell-error-buffer))
1655        (setq idlwave-shell-error-last (point)))          (erase-buffer)
1656      (idlwave-shell-goto-next-error))          (insert idlwave-shell-command-output)
1657            (goto-char (point-min))
1658            (setq idlwave-shell-error-last (point)))
1659          (setq idlwave-shell-current-state 'error)
1660          (idlwave-shell-goto-next-error))
1661      
1662         ;; Second Priority: Halting errors
1663         ((string-match idlwave-shell-halting-error
1664                        idlwave-shell-command-output)
1665          ;; Grab the file and line state info.
1666          (setq idlwave-shell-calling-stack-index 0)
1667          (setq idlwave-shell-halt-frame
1668                (idlwave-shell-parse-line
1669                 (substring idlwave-shell-command-output
1670                            (match-beginning 2)))
1671                idlwave-shell-current-state 'error)
1672          (idlwave-shell-display-line (idlwave-shell-pc-frame)))
1673        
1674         ;; Third Priority: Various types of innocuous HALT and
1675         ;; TRACEBACK messages.
1676         ((or (setq trace (string-match idlwave-shell-trace-message-re
1677                                        idlwave-shell-command-output))
1678              (string-match idlwave-shell-halt-messages-re
1679                            idlwave-shell-command-output))
1680          ;; Grab the file and line state info.
1681          (setq idlwave-shell-calling-stack-index 0)
1682          (setq idlwave-shell-halt-frame
1683                (idlwave-shell-parse-line
1684                 (substring idlwave-shell-command-output (match-end 0))))
1685          (setq idlwave-shell-current-state 'halt)
1686          ;; Don't debug trace messages
1687          (idlwave-shell-display-line (idlwave-shell-pc-frame) nil
1688                                      (if trace 'no-debug)))
1689        
1690         ;; Fourth Priority: Breakpoints
1691         ((string-match idlwave-shell-break-message
1692                        idlwave-shell-command-output)
1693          (setq idlwave-shell-calling-stack-index 0)
1694          (setq idlwave-shell-halt-frame
1695                (idlwave-shell-parse-line
1696                 (substring idlwave-shell-command-output (match-end 0))))
1697          ;; We used to count hits on breakpoints
1698          ;; this is no longer supported since IDL breakpoints
1699          ;; have learned counting.
1700          ;; Do breakpoint command processing
1701          (let ((bp (assoc
1702                     (list
1703                      (nth 0 idlwave-shell-halt-frame)
1704                      (nth 1 idlwave-shell-halt-frame))
1705                     idlwave-shell-bp-alist)))
1706            ;(message "Scanning with %s" bp)
1707            (if bp
1708                (let ((cmd (idlwave-shell-bp-get bp 'cmd)))
1709                  (if cmd ;; Execute any breakpoint command
1710                      (if (listp cmd) (eval cmd) (funcall cmd))))
1711              ;; A breakpoint that we did not know about - perhaps it was
1712              ;; set by the user...  Let's update our list.
1713              (idlwave-shell-bp-query)))
1714          (setq idlwave-shell-current-state 'breakpoint)      
1715          (idlwave-shell-display-line (idlwave-shell-pc-frame)))
1716        
1717         ;; Last Priority: Can't Step errors
1718         ((string-match idlwave-shell-cant-continue-error
1719                        idlwave-shell-command-output)
1720          (setq idlwave-shell-current-state 'breakpoint))
1721    
1722     ;; Second Priority: Various types of HALT messages.       ;; Otherwise, no particular state
1723     ((string-match idlwave-shell-halt-messages-re       (t (setq idlwave-shell-current-state nil)))))
                   idlwave-shell-command-output)  
     ;; Grab the file and line state info.  
     (setq idlwave-shell-calling-stack-index 0)  
     (setq idlwave-shell-halt-frame  
           (idlwave-shell-parse-line  
            (substring idlwave-shell-command-output (match-end 0))))  
     (idlwave-shell-display-line (idlwave-shell-pc-frame)))  
   
    ;; Last Priority: Breakpoints  
    ((string-match idlwave-shell-break-message  
                   idlwave-shell-command-output)  
     (setq idlwave-shell-calling-stack-index 0)  
     (setq idlwave-shell-halt-frame  
           (idlwave-shell-parse-line  
            (substring idlwave-shell-command-output (match-end 0))))  
     ;; We used to count hits on breakpoints  
     ;; this is no longer supported since IDL breakpoints  
     ;; have learned counting.  
     ;; Do breakpoint command processing  
     (let ((bp (assoc  
                (list  
                 (nth 0 idlwave-shell-halt-frame)  
                 (nth 1 idlwave-shell-halt-frame))  
                idlwave-shell-bp-alist)))  
       (if bp  
           (let ((cmd (idlwave-shell-bp-get bp 'cmd)))  
             (if cmd  
                 ;; Execute command  
                 (if (listp cmd) (eval cmd) (funcall cmd))))  
         ;; A breakpoint that we did not know about - perhaps it was  
         ;; set by the user or IDL isn't reporting breakpoints like  
         ;; we expect.  Lets update our list.  
         (idlwave-shell-bp-query)))  
     (idlwave-shell-display-line (idlwave-shell-pc-frame)))))  
1724    
1725  (defvar idlwave-shell-error-buffer " *idlwave-shell-errors*"  (defvar idlwave-shell-error-buffer " *idlwave-shell-errors*"
1726    "Buffer containing syntax errors from IDL compilations.")    "Buffer containing syntax errors from IDL compilations.")
# Line 1473  Update the windows if a message is found Line 1729  Update the windows if a message is found
1729  ;; in module and file names.  I am not sure if it will be necessary to  ;; in module and file names.  I am not sure if it will be necessary to
1730  ;; change this.  Currently it seems to work the way it is.  ;; change this.  Currently it seems to work the way it is.
1731  (defvar idlwave-shell-syntax-error  (defvar idlwave-shell-syntax-error
1732    "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"    "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"
1733    "A regular expression to match an IDL syntax error.    "A regular expression to match an IDL syntax error.  
1734  The first \(..\) pair should match the file name.  The second pair  The 1st pair matches the file name, the second pair matches the line
1735  should match the line number.")  number.")
1736    
1737  (defvar idlwave-shell-other-error  (defvar idlwave-shell-other-error
1738    "^% .*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"    "^% .*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)"
1739    "A regular expression to match any IDL error.    "A regular expression to match any IDL error.")
1740  The first \(..\) pair should match the file name.  The second pair  
1741  should match the line number.")  (defvar idlwave-shell-halting-error
1742      "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+\\s-*.*\\)\n"
1743      "A regular expression to match errors which halt execution.")
1744    
1745    (defvar idlwave-shell-cant-continue-error
1746      "^% Can't continue from this point.\n"
1747      "A regular expression to match errors stepping errors.")
1748    
1749  (defvar idlwave-shell-file-line-message  (defvar idlwave-shell-file-line-message
1750    (concat    (concat
1751     "\\("                                 ; program name group (1)     "\\("                                 ; program name group (1)
1752     "\\<[a-zA-Z][a-zA-Z0-9_$:]*"          ; start with a letter, followed by [..]     "\\$MAIN\\$\\|"                       ; main level routine
1753       "\\<[a-zA-Z][a-zA-Z0-9_$:]*"          ; start with a letter followed by [..]
1754     "\\([ \t]*\n[ \t]*[a-zA-Z0-9_$:]+\\)*"; continuation lines program name (2)     "\\([ \t]*\n[ \t]*[a-zA-Z0-9_$:]+\\)*"; continuation lines program name (2)
1755     "\\)"                                 ; end program name group (1)     "\\)"                                 ; end program name group (1)
1756     "[ \t\n]+"                            ; white space     "[ \t\n]+"                            ; white space
# Line 1502  should match the line number.") Line 1765  should match the line number.")
1765     "\\)"                                 ; end line number group (5)     "\\)"                                 ; end line number group (5)
1766     )     )
1767    "*A regular expression to parse out the file name and line number.    "*A regular expression to parse out the file name and line number.
1768  The 1st group should match the subroutine name.  The 1st group should match the subroutine name.  
1769  The 3rd group is the line number.  The 3rd group is the line number.
1770  The 5th group is the file name.  The 5th group is the file name.
1771  All parts may contain linebreaks surrounded by spaces.  This is important  All parts may contain linebreaks surrounded by spaces.  This is important
1772  in IDL5 which inserts random linebreaks in long module and file names.")  in IDL5 which inserts random linebreaks in long module and file names.")
1773    
1774  (defun idlwave-shell-parse-line (string)  (defun idlwave-shell-parse-line (string &optional skip-main)
1775    "Parse IDL message for the subroutine, file name and line number.    "Parse IDL message for the subroutine, file name and line number.
1776  We need to work hard here to remove the stupid line breaks inserted by  We need to work hard here to remove the stupid line breaks inserted by
1777  IDL5.  These line breaks can be right in the middle of procedure  IDL5.  These line breaks can be right in the middle of procedure
1778  or file names.  or file names.
1779  It is very difficult to come up with a robust solution.  This one seems  It is very difficult to come up with a robust solution.  This one seems
1780  to be pretty good though.  to be pretty good though.  
1781    
1782  Here is in what ways it improves over the previous solution:  Here is in what ways it improves over the previous solution:
1783    
# Line 1528  the first part of that garbage will be a Line 1791  the first part of that garbage will be a
1791  However, the function checks the existence of the files with and  However, the function checks the existence of the files with and
1792  without this last part - thus the function only breaks if file name  without this last part - thus the function only breaks if file name
1793  plus garbage match an existing regular file.  This is hopefully very  plus garbage match an existing regular file.  This is hopefully very
1794  unlikely."  unlikely.
1795    
1796    If optional arg SKIP-MAIN is non-nil, don't parse $MAIN$ routine stop
1797    statements."
1798    
1799    (let (number procedure file)    (let (number procedure file)
1800      (when (and (not (string-match ":\\s-*\\$MAIN" string))      (when (and (not (if skip-main (string-match ":\\s-*\\$MAIN" string)))
1801                  (string-match idlwave-shell-file-line-message string))                 (string-match idlwave-shell-file-line-message string))
1802        (setq procedure (match-string 1 string)        (setq procedure (match-string 1 string)
1803              number (match-string 3 string)              number (match-string 3 string)
1804              file (match-string 5 string))              file (match-string 5 string))
1805            
1806        ;; Repair the strings        ;; Repair the strings
1807        (setq procedure (idlwave-shell-repair-string procedure))        (setq procedure (idlwave-shell-repair-string procedure))
1808        (setq number (idlwave-shell-repair-string number))        (setq number (idlwave-shell-repair-string number))
# Line 1562  The last line of STRING may be garbage - Line 1828  The last line of STRING may be garbage -
1828  file name."  file name."
1829    (let ((file1 "") (file2 "") (start 0))    (let ((file1 "") (file2 "") (start 0))
1830      ;; We scan no further than to the next "^%" line      ;; We scan no further than to the next "^%" line
1831      (if (string-match "^%" file)      (if (string-match "^%" file)
1832          (setq file (substring file 0 (match-beginning 0))))          (setq file (substring file 0 (match-beginning 0))))
1833      ;; Take out the line breaks      ;; Take out the line breaks
1834      (while (string-match "[ \t]*\n[ \t]*" file start)      (while (string-match "[ \t]*\n[ \t]*" file start)
# Line 1617  file name." Line 1883  file name."
1883  The size is given by `idlwave-shell-graphics-window-size'."  The size is given by `idlwave-shell-graphics-window-size'."
1884    (interactive "P")    (interactive "P")
1885    (let ((n (if n (prefix-numeric-value n) 0)))    (let ((n (if n (prefix-numeric-value n) 0)))
1886      (idlwave-shell-send-command      (idlwave-shell-send-command
1887       (apply 'format "window,%d,xs=%d,ys=%d"       (apply 'format "window,%d,xs=%d,ys=%d"
1888              n idlwave-shell-graphics-window-size)              n idlwave-shell-graphics-window-size)
1889       nil (idlwave-shell-hide-p 'misc))))       nil (idlwave-shell-hide-p 'misc) nil t)))
1890    
1891  (defun idlwave-shell-resync-dirs ()  (defun idlwave-shell-resync-dirs ()
1892    "Resync the buffer's idea of the current directory.    "Resync the buffer's idea of the current directory.
# Line 1633  directory." Line 1899  directory."
1899                                'hide 'wait))                                'hide 'wait))
1900    
1901  (defun idlwave-shell-retall (&optional arg)  (defun idlwave-shell-retall (&optional arg)
1902    "Return from the entire calling stack."    "Return from the entire calling stack.
1903    Also get rid of widget events in the queue."
1904    (interactive "P")    (interactive "P")
1905    (idlwave-shell-send-command "retall" nil (idlwave-shell-hide-p 'misc)))    (save-selected-window
1906        ;;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 &
1907        (idlwave-shell-send-command "retall" nil
1908                                    (if (idlwave-shell-hide-p 'misc) 'mostly)
1909                                    nil t)
1910        (idlwave-shell-display-line nil)))
1911    
1912  (defun idlwave-shell-closeall (&optional arg)  (defun idlwave-shell-closeall (&optional arg)
1913    "Close all open files."    "Close all open files."
1914    (interactive "P")    (interactive "P")
1915    (idlwave-shell-send-command "close,/all" nil (idlwave-shell-hide-p 'misc)))    (idlwave-shell-send-command "close,/all" nil
1916                                  (idlwave-shell-hide-p 'misc) nil t))
1917    
1918  (defun idlwave-shell-quit (&optional arg)  (defun idlwave-shell-quit (&optional arg)
1919    "Exit the idl process after confirmation.    "Exit the idl process after confirmation.
# Line 1655  With prefix ARG, exit without confirmati Line 1928  With prefix ARG, exit without confirmati
1928    
1929  (defun idlwave-shell-reset (&optional hidden)  (defun idlwave-shell-reset (&optional hidden)
1930    "Reset IDL.  Return to main level and destroy the leftover variables.    "Reset IDL.  Return to main level and destroy the leftover variables.
1931  This issues the following commands:  This issues the following commands:  
1932  RETALL  RETALL
1933  WIDGET_CONTROL,/RESET  WIDGET_CONTROL,/RESET
1934  CLOSE, /ALL  CLOSE, /ALL
# Line 1691  HEAP_GC, /VERBOSE" Line 1964  HEAP_GC, /VERBOSE"
1964    (let ((text idlwave-shell-command-output)    (let ((text idlwave-shell-command-output)
1965          (start 0)          (start 0)
1966          sep sep-re file type spec specs name cs key keys class entry)          sep sep-re file type spec specs name cs key keys class entry)
1967  ;    (message "GOT: %s" text) ;??????????????????????      ;;    (message "GOT: %s" text) ;??????????????????????
1968      ;; Initialize variables      ;; Initialize variables
1969      (setq idlwave-compiled-routines nil      (setq idlwave-compiled-routines nil
1970            idlwave-unresolved-routines nil)            idlwave-unresolved-routines nil)
# Line 1704  HEAP_GC, /VERBOSE" Line 1977  HEAP_GC, /VERBOSE"
1977                text (substring text (match-end 0)))                text (substring text (match-end 0)))
1978        ;; Set dummy values and kill the text        ;; Set dummy values and kill the text
1979        (setq sep "@" sep-re "@ *" text "")        (setq sep "@" sep-re "@ *" text "")
1980        (message "Routine Info warning: No match for BEGIN line in \n>>>>\n%s\n<<<<\n"        (if idlwave-idlwave_routine_info-compiled
1981                 idlwave-shell-command-output))            (message
1982               "Routine Info warning: No match for BEGIN line in \n>>>\n%s\n<<<\n"
1983               idlwave-shell-command-output)))
1984      (if (string-match "^>>>END OF IDLWAVE ROUTINE INFO.*" text)      (if (string-match "^>>>END OF IDLWAVE ROUTINE INFO.*" text)
1985          (setq text (substring text 0 (match-beginning 0)))          (setq text (substring text 0 (match-beginning 0)))
1986        (message "Routine Info warning: No match for END line in \n>>>>\n%s\n<<<<\n"        (if idlwave-idlwave_routine_info-compiled
1987                 idlwave-shell-command-output))            (message
1988               "Routine Info warning: No match for END line in \n>>>\n%s\n<<<\n"
1989               idlwave-shell-command-output)))
1990      (if (string-match "\\S-" text)      (if (string-match "\\S-" text)
1991          ;; Obviously, the pro worked.  Make a note that we have it now.          ;; Obviously, the pro worked.  Make a note that we have it now.
1992          (setq idlwave-idlwave_routine_info-compiled t))          (setq idlwave-idlwave_routine_info-compiled t))
# Line 1726  HEAP_GC, /VERBOSE" Line 2003  HEAP_GC, /VERBOSE"
2003              key (nth 4 specs)              key (nth 4 specs)
2004              keys (if (and (stringp key)              keys (if (and (stringp key)
2005                            (not (string-match "\\` *\\'" key)))                            (not (string-match "\\` *\\'" key)))
2006                       (mapcar 'list                       (mapcar 'list
2007                               (delete "" (idlwave-split-string key " +")))))                               (delete "" (idlwave-split-string key " +")))))
2008        (setq name (idlwave-sintern-routine-or-method name class t)        (setq name (idlwave-sintern-routine-or-method name class t)
2009              class (idlwave-sintern-class class t)              class (idlwave-sintern-class class t)
2010              file (if (equal file "") nil file)              file (if (equal file "") nil file)
2011              keys (mapcar (lambda (x)              keys (mapcar (lambda (x)
2012                             (list (idlwave-sintern-keyword (car x) t))) keys))                             (list (idlwave-sintern-keyword (car x) t))) keys))
2013        ;; Make sure we use the same string object for the same file        
       (setq file (idlwave-sintern-file file t))  
       ;; FIXME: What should I do with routines from the temp file???  
       ;;        Maybe just leave it in - there is a chance that the  
       ;;        routine is still in there.  
       ;;      (if (equal file idlwave-shell-temp-pro-file)  
       ;;          (setq file nil))  
   
2014        ;; In the following ignore routines already defined in buffers,        ;; In the following ignore routines already defined in buffers,
2015        ;; assuming that if the buffer stuff differs, it is a "new"        ;; assuming that if the buffer stuff differs, it is a "new"
2016        ;; version.        ;; version, not yet compiled, and should take precedence.
2017        ;; We could do the same for the library to avoid duplicates -        ;; We could do the same for the library to avoid duplicates -
2018        ;; but I think frequently a user might have several versions of        ;; but I think frequently a user might have several versions of
2019        ;; the same function in different programs, and in this case the        ;; the same function in different programs, and in this case the
2020        ;; compiled one will be the best guess of all version.        ;; compiled one will be the best guess of all versions.
2021        ;; Therefore, we leave duplicates of library routines in.        ;; Therefore, we leave duplicates of library routines in.
   
2022        (cond ((string= name "$MAIN$"))    ; ignore this one        (cond ((string= name "$MAIN$"))    ; ignore this one
2023              ((and (string= type "PRO")              ((and (string= type "PRO")
2024                    ;; FIXME: is it OK to make the buffer routines dominate?                    ;; FIXME: is it OK to make the buffer routines dominate?
2025                    (or t (null file)                    (or t (null file)
2026                        (not (idlwave-rinfo-assq name 'pro class                        (not (idlwave-rinfo-assq name 'pro class
2027                                                 idlwave-buffer-routines)))                                                 idlwave-buffer-routines)))
2028                    ;; FIXME: is it OK to make the library routines dominate?                    ;; FIXME: is it OK to make the library routines dominate?
2029                    ;;(not (idlwave-rinfo-assq name 'pro class                    ;;(not (idlwave-rinfo-assq name 'pro class
2030                    ;;                       idlwave-library-routines))                    ;;                       idlwave-library-routines))
2031                    )                    )
2032               (setq entry (list name 'pro class (cons 'compiled file) cs keys))               (setq entry (list name 'pro class
2033               (if file                                 (cons 'compiled
2034                                         (if file
2035                                             (list
2036                                              (file-name-nondirectory file)
2037                                              (idlwave-sintern-dir
2038                                               (file-name-directory file)))))
2039                                   cs (cons nil keys)))
2040                 (if file
2041                   (push entry idlwave-compiled-routines)                   (push entry idlwave-compiled-routines)
2042                 (push entry idlwave-unresolved-routines)))                 (push entry idlwave-unresolved-routines)))
2043                
2044              ((and (string= type "FUN")              ((and (string= type "FUN")
2045                    ;; FIXME: is it OK to make the buffer routines dominate?                    ;; FIXME: is it OK to make the buffer routines dominate?
2046                    (or t (not file)                    (or t (not file)
2047                        (not (idlwave-rinfo-assq name 'fun class                        (not (idlwave-rinfo-assq name 'fun class
2048                                                 idlwave-buffer-routines)))                                                 idlwave-buffer-routines)))
2049                    ;; FIXME: is it OK to make the library routines dominate?                    ;; FIXME: is it OK to make the library routines dominate?
2050                    ;; (not (idlwave-rinfo-assq name 'fun class                    ;; (not (idlwave-rinfo-assq name 'fun class
2051                    ;;                       idlwave-library-routines))                    ;;                       idlwave-library-routines))
2052                    )                    )
2053               (setq entry (list name 'fun class (cons 'compiled file) cs keys))               (setq entry (list name 'fun class
2054                                   (cons 'compiled
2055                                         (if file
2056                                             (list
2057                                              (file-name-nondirectory file)
2058                                              (idlwave-sintern-dir
2059                                               (file-name-directory file)))))
2060                                   cs (cons nil keys)))
2061               (if file               (if file
2062                   (push entry idlwave-compiled-routines)                   (push entry idlwave-compiled-routines)
2063                 (push entry idlwave-unresolved-routines))))))                 (push entry idlwave-unresolved-routines))))))
# Line 1789  Change the default directory for the pro Line 2072  Change the default directory for the pro
2072      (set-buffer (idlwave-shell-buffer))      (set-buffer (idlwave-shell-buffer))
2073      (if (string-match ",___cur[\n\r]\\(\\S-*\\) *[\n\r]"      (if (string-match ",___cur[\n\r]\\(\\S-*\\) *[\n\r]"
2074                        idlwave-shell-command-output)                        idlwave-shell-command-output)
2075          (let ((dir (substring idlwave-shell-command-output          (let ((dir (substring idlwave-shell-command-output
2076                                (match-beginning 1) (match-end 1))))                                (match-beginning 1) (match-end 1))))
2077  ;         (message "Setting Emacs working dir to %s" dir)  ;         (message "Setting Emacs working dir to %s" dir)
2078            (setq idlwave-shell-default-directory dir)            (setq idlwave-shell-default-directory dir)
# Line 1803  Change the default directory for the pro Line 2086  Change the default directory for the pro
2086          expression)          expression)
2087      (save-excursion      (save-excursion
2088        (goto-char apos)        (goto-char apos)
2089        (setq expression (buffer-substring        (setq expression (buffer-substring
2090                          (catch 'exit                          (catch 'exit
2091                            (while t                            (while t
2092                              (if (not (re-search-backward                              (if (not (re-search-backward
2093                                        "[^][.A-Za-z0-9_() ]" bos t))                                        "[^][.A-Za-z0-9_() ]" bos t))
2094                                  (throw 'exit bos)) ;ran into bos                                  (throw 'exit bos)) ;ran into bos
2095                              (if (not (idlwave-is-pointer-dereference bol))                              (if (not (idlwave-is-pointer-dereference bol))
# Line 1820  Change the default directory for the pro Line 2103  Change the default directory for the pro
2103         'hide 'wait)         'hide 'wait)
2104        ;; If we don't know anything about the class, update shell routines        ;; If we don't know anything about the class, update shell routines
2105        (if (and idlwave-shell-get-object-class        (if (and idlwave-shell-get-object-class
2106                 (not (assoc-string idlwave-shell-get-object-class                 (not (assoc-ignore-case idlwave-shell-get-object-class
2107                                    (idlwave-class-alist) t)))                                         (idlwave-class-alist))))
2108            (idlwave-shell-maybe-update-routine-info))            (idlwave-shell-maybe-update-routine-info))
2109        idlwave-shell-get-object-class)))        idlwave-shell-get-object-class)))
2110    
2111  (defun idlwave-shell-parse-object-class ()  (defun idlwave-shell-parse-object-class ()
2112    "Parse the output of the obj_class command."    "Parse the output of the obj_class command."
2113    (let ((match "print,obj_class([^\n\r]+[\n\r ]+"))    (let ((match "print,obj_class([^\n\r]+[\n\r ]"))
2114      (if (and      (if (and
2115           (not (string-match (concat match match "\\s-*^[\n\r]+"           (not (string-match (concat match match "\\s-*^[\n\r]+"
2116                                      "% Syntax error")                                      "% Syntax error")
2117                              idlwave-shell-command-output))                              idlwave-shell-command-output))
2118           (string-match (concat match "\\([A-Za-z_0-9]+\\)")           (string-match (concat match "\\([A-Za-z_0-9]+\\)")
2119                         idlwave-shell-command-output))                         idlwave-shell-command-output))
2120          (setq idlwave-shell-get-object-class          (setq idlwave-shell-get-object-class
2121                (match-string 1 idlwave-shell-command-output)))))                (match-string 1 idlwave-shell-command-output)))))
2122    
2123    (defvar idlwave-sint-sysvars nil)
2124    (idlwave-new-sintern-type 'execcomm)
2125    
2126  (defun idlwave-shell-complete (&optional arg)  (defun idlwave-shell-complete (&optional arg)
2127    "Do completion in the idlwave-shell buffer.    "Do completion in the idlwave-shell buffer.
# Line 1844  Calls `idlwave-shell-complete-filename' Line 2129  Calls `idlwave-shell-complete-filename'
2129  in strings.  Otherwise, calls `idlwave-complete' to complete modules and  in strings.  Otherwise, calls `idlwave-complete' to complete modules and
2130  keywords."  keywords."
2131    (interactive "P")    (interactive "P")
2132    (let (cmd)    (let (exec-cmd)
2133      (cond      (cond
2134       ((setq cmd (idlwave-shell-executive-command))       ((and
2135           (setq exec-cmd (idlwave-shell-executive-command))
2136           (cdr exec-cmd)
2137           (member (upcase (cdr exec-cmd))
2138                   '(".R" ".RU" ".RUN" ".RN" ".RNE" ".RNEW"
2139                     ".COM" ".COMP" ".COMPI" ".COMPIL" ".COMPILE")))
2140        ;; We are in a command line with an executive command        ;; We are in a command line with an executive command
2141        (if (member (upcase cmd)        (idlwave-shell-complete-filename))
2142                    '(".R" ".RU" ".RUN" ".RN" ".RNE" ".RNEW"  
2143                      ".COM" ".COMP" ".COMPI" ".COMPIL" ".COMPILE"))       ((car-safe exec-cmd)
2144            ;; This command expects file names        (setq idlwave-completion-help-info
2145            (idlwave-shell-complete-filename)))              '(idlwave-shell-complete-execcomm-help))
2146          (idlwave-complete-in-buffer 'execcomm 'execcomm
2147                                      idlwave-executive-commands-alist nil
2148                                      "Select an executive command"
2149                                      "system variable"))
2150    
2151       ((idlwave-shell-batch-command)       ((idlwave-shell-batch-command)
2152        (idlwave-shell-complete-filename))        (idlwave-shell-complete-filename))
2153    
2154         ((idlwave-shell-shell-command)
2155          (idlwave-shell-complete-filename))
2156    
2157       ((and (idlwave-shell-filename-string)       ((and (idlwave-shell-filename-string)
2158             (save-excursion             (save-excursion
2159               (beginning-of-line)               (beginning-of-line)
2160               (let ((case-fold-search t))               (let ((case-fold-search t))
2161                 (not (looking-at ".*obj_new")))))                 (not (looking-at ".*obj_new")))))
2162        (idlwave-shell-complete-filename))        (idlwave-shell-complete-filename))
2163        
2164       (t       (t
2165        ;; Default completion of modules and keywords        ;; Default completion of modules and keywords
2166        (idlwave-complete arg)))))        (idlwave-complete arg)))))
2167    
2168    ;; Get rid of opaque dynamic variable passing of link?
2169    (defun idlwave-shell-complete-execcomm-help (mode word)
2170      (let ((word (or (nth 1 idlwave-completion-help-info) word))
2171            (entry (assoc-ignore-case word idlwave-executive-commands-alist)))
2172        (cond
2173         ((eq mode 'test)
2174          (and (stringp word) entry (cdr entry)))
2175         ((eq mode 'set)
2176          (if entry (setq link (cdr entry)))) ;; setting dynamic variable!!!
2177         (t (error "This should not happen")))))
2178    
2179  (defun idlwave-shell-complete-filename (&optional arg)  (defun idlwave-shell-complete-filename (&optional arg)
2180    "Complete a file name at point if after a file name.    "Complete a file name at point if after a file name.
2181  We assume that we are after a file name when completing one of the  We assume that we are after a file name when completing one of the
2182  args of an executive .run, .rnew or .compile."  args of an executive .run, .rnew or .compile."
2183    ;; CWD might have changed, resync, to set default directory    ;; CWD might have changed, resync, to set default directory
2184    (idlwave-shell-resync-dirs)    (idlwave-shell-resync-dirs)
2185    (let ((comint-file-name-chars idlwave-shell-file-name-chars))    (let ((comint-file-name-chars idlwave-shell-file-name-chars))
2186      (comint-dynamic-complete-as-filename)))      (comint-dynamic-complete-as-filename)))
2187    
# Line 1881  args of an executive .run, .rnew or .com Line 2189  args of an executive .run, .rnew or .com
2189    "Return the name of the current executive command, if any."    "Return the name of the current executive command, if any."
2190    (save-excursion    (save-excursion
2191      (idlwave-beginning-of-statement)      (idlwave-beginning-of-statement)
2192      (if (looking-at "[ \t]*\\([.][^ \t\n\r]+\\)")      (cons (looking-at "[ \t]*\\.")
2193          (match-string 1))))            (if (looking-at "[ \t]*[.]\\([^ \t\n\r]+\\)[ \t]")
2194                  (match-string 1)))))
2195    
2196  (defun idlwave-shell-filename-string ()  (defun idlwave-shell-filename-string ()
2197    "Return t if in a string and after what could be a file name."    "Return t if in a string and after what could be a file name."
# Line 1902  args of an executive .run, .rnew or .com Line 2211  args of an executive .run, .rnew or .com
2211        (skip-chars-backward " \t" limit)        (skip-chars-backward " \t" limit)
2212        (and (eq (preceding-char) ?@) (not (idlwave-in-quote))))))        (and (eq (preceding-char) ?@) (not (idlwave-in-quote))))))
2213    
2214  ;;;  (defun idlwave-shell-shell-command ()
2215  ;;; This section contains code for debugging IDL programs. --------------------    "Returns t if we're in a shell command statement like $ls"
2216  ;;;    (save-excursion
2217        (idlwave-beginning-of-statement)
2218        (looking-at "\\$")))
2219    
2220    ;; Debugging Commands ------------------------------------------------------
2221    
2222  (defun idlwave-shell-redisplay (&optional hide)  (defun idlwave-shell-redisplay (&optional hide)
2223    "Tries to resync the display with where execution has stopped.    "Tries to resync the display with where execution has stopped.
2224  Issues a \"help,/trace\" command followed by a call to  Issues a \"help,/trace\" command followed by a call to
2225  `idlwave-shell-display-line'.  Also updates the breakpoint  `idlwave-shell-display-line'.  Also updates the breakpoint
2226  overlays."  overlays."
2227    (interactive)    (interactive)
# Line 1921  overlays." Line 2234  overlays."
2234    (idlwave-shell-bp-query))    (idlwave-shell-bp-query))
2235    
2236  (defun idlwave-shell-display-level-in-calling-stack (&optional hide)  (defun idlwave-shell-display-level-in-calling-stack (&optional hide)
2237    (idlwave-shell-send-command    (idlwave-shell-send-command
2238     "help,/trace"     "help,/trace"
2239     `(progn     `(progn
2240        ;; scanning for the state will reset the stack level - restore it        ;; scanning for the state will reset the stack level - restore it
# Line 1952  overlays." Line 2265  overlays."
2265        (setq idlwave-shell-calling-stack-index nmin        (setq idlwave-shell-calling-stack-index nmin
2266              message (format "%d is the current calling stack level - can't go further down"              message (format "%d is the current calling stack level - can't go further down"
2267                              (- nmin)))))                              (- nmin)))))
2268      (setq idlwave-shell-calling-stack-routine      (setq idlwave-shell-calling-stack-routine
2269            (nth 2 (nth idlwave-shell-calling-stack-index stack)))            (nth 2 (nth idlwave-shell-calling-stack-index stack)))
2270      (idlwave-shell-display-line  
2271       (nth idlwave-shell-calling-stack-index stack))      ;; only edebug if in that mode already
2272      (message (or message      (idlwave-shell-display-line
2273         (nth idlwave-shell-calling-stack-index stack) nil
2274         (unless idlwave-shell-electric-debug-mode 'no-debug))
2275        (message (or message
2276                   (format "In routine %s (stack level %d)"                   (format "In routine %s (stack level %d)"
2277                           idlwave-shell-calling-stack-routine                           idlwave-shell-calling-stack-routine
2278                           (- idlwave-shell-calling-stack-index))))))                           (- idlwave-shell-calling-stack-index))))))
# Line 1987  used.  Does nothing if the resulting fra Line 2303  used.  Does nothing if the resulting fra
2303  (defun idlwave-shell-pc-frame ()  (defun idlwave-shell-pc-frame ()
2304    "Returns the frame for IDL execution."    "Returns the frame for IDL execution."
2305    (and idlwave-shell-halt-frame    (and idlwave-shell-halt-frame
2306         (list (nth 0 idlwave-shell-halt-frame)         (list (nth 0 idlwave-shell-halt-frame)
2307               (nth 1 idlwave-shell-halt-frame)               (nth 1 idlwave-shell-halt-frame)
2308               (nth 2 idlwave-shell-halt-frame))))               (nth 2 idlwave-shell-halt-frame))))
2309    
# Line 1995  used.  Does nothing if the resulting fra Line 2311  used.  Does nothing if the resulting fra
2311    "Check that frame is for an existing file."    "Check that frame is for an existing file."
2312    (file-readable-p (car frame)))    (file-readable-p (car frame)))
2313    
2314  (defun idlwave-shell-display-line (frame &optional col)  (defvar idlwave-shell-suppress-electric-debug nil)
2315    (defun idlwave-shell-display-line (frame &optional col no-debug)
2316    "Display FRAME file in other window with overlay arrow.    "Display FRAME file in other window with overlay arrow.
2317    
2318  FRAME is a list of file name, line number, and subroutine name.  FRAME is a list of file name, line number, and subroutine name.  If
2319  If FRAME is nil then remove overlay."  FRAME is nil then remove overlay.  If COL is set, move point to that
2320    column in the line.  If NO-DEBUG is non-nil, do *not* toggle the electric
2321    debug mode."
2322    (if (not frame)    (if (not frame)
2323        ;; Remove stop-line overlay from old position        ;; Remove stop-line overlay from old position
2324        (progn        (progn
2325          (setq overlay-arrow-string nil)          (setq overlay-arrow-string nil)
2326          (setq idlwave-shell-mode-line-info nil)          (setq idlwave-shell-mode-line-info nil)
2327          (setq idlwave-shell-is-stopped nil)          (setq idlwave-shell-is-stopped nil)
2328          (if idlwave-shell-stop-line-overlay          (if idlwave-shell-stop-line-overlay
2329              (delete-overlay idlwave-shell-stop-line-overlay)))              (delete-overlay idlwave-shell-stop-line-overlay))
2330            ;; Turn off electric debug everywhere, if it's on
2331            (if (and (not no-debug)
2332                     idlwave-shell-automatic-electric-debug)
2333                (idlwave-shell-electric-debug-all-off)))
2334      (if (not (idlwave-shell-valid-frame frame))      (if (not (idlwave-shell-valid-frame frame))
2335          ;; FIXME: errors are dangerous in shell filters.  But I think I          ;; FIXME: errors are dangerous in shell filters.  But I think I
2336          ;; have never encountered this one.          ;; have never encountered this one.
# Line 2015  If FRAME is nil then remove overlay." Line 2338  If FRAME is nil then remove overlay."
2338  ;;;  ;;;
2339  ;;; buffer : the buffer to display a line in.  ;;; buffer : the buffer to display a line in.
2340  ;;; select-shell: current buffer is the shell.  ;;; select-shell: current buffer is the shell.
2341  ;;;  ;;;
2342        (setq idlwave-shell-mode-line-info        (setq idlwave-shell-mode-line-info
2343              (if (nth 2 frame)              (if (nth 2 frame)
2344                  (format "[%d:%s]"                  (format "[%d:%s]"
2345                          (- idlwave-shell-calling-stack-index)                          (- idlwave-shell-calling-stack-index)
2346                          (nth 2 frame))))                          (nth 2 frame))))
2347        (let* ((buffer (idlwave-find-file-noselect (car frame) 'shell))        (let* ((buffer (idlwave-find-file-noselect (car frame) 'shell))
2348               (select-shell (equal (buffer-name) (idlwave-shell-buffer)))               (select-shell (equal (buffer-name) (idlwave-shell-buffer)))
2349               window pos)               window pos electric)
2350    
2351          ;; First make sure the shell window is visible          ;; First make sure the shell window is visible
2352          (idlwave-display-buffer (idlwave-shell-buffer)          (idlwave-display-buffer (idlwave-shell-buffer)
# Line 2039  If FRAME is nil then remove overlay." Line 2362  If FRAME is nil then remove overlay."
2362            (save-restriction            (save-restriction
2363              (widen)              (widen)
2364              (goto-line (nth 1 frame))              (goto-line (nth 1 frame))
2365                (forward-line 0)
2366              (setq pos (point))              (setq pos (point))
2367              (setq idlwave-shell-is-stopped t)              (setq idlwave-shell-is-stopped t)
2368                
2369              (if idlwave-shell-stop-line-overlay              (if idlwave-shell-stop-line-overlay
2370                  ;; Move overlay                  ;; Move overlay
2371                  (move-overlay idlwave-shell-stop-line-overlay                  (move-overlay idlwave-shell-stop-line-overlay
# Line 2051  If FRAME is nil then remove overlay." Line 2376  If FRAME is nil then remove overlay."
2376                    (setq overlay-arrow-string idlwave-shell-overlay-arrow))                    (setq overlay-arrow-string idlwave-shell-overlay-arrow))
2377                (or overlay-arrow-position  ; create the marker if necessary                (or overlay-arrow-position  ; create the marker if necessary
2378                    (setq overlay-arrow-position (make-marker)))                    (setq overlay-arrow-position (make-marker)))
2379                (set-marker overlay-arrow-position (point) buffer)))                (set-marker overlay-arrow-position (point) buffer)))
2380    
2381            ;; If the point is outside the restriction, widen the buffer.            ;; If the point is outside the restriction, widen the buffer.
2382            (if (or (< pos (point-min)) (> pos (point-max)))            (if (or (< pos (point-min)) (> pos (point-max)))
# Line 2061  If FRAME is nil then remove overlay." Line 2386  If FRAME is nil then remove overlay."
2386    
2387            ;; If we have the column of the error, move the cursor there.            ;; If we have the column of the error, move the cursor there.
2388            (if col (move-to-column col))            (if col (move-to-column col))
2389            (setq pos (point)))            (setq pos (point))
2390              
2391              ;; Enter electric debug mode, if not prohibited and not in
2392              ;; it already
2393              (when (and (or
2394                          (eq idlwave-shell-automatic-electric-debug t)
2395                          (and
2396                           (eq idlwave-shell-automatic-electric-debug 'breakpoint)
2397                           (not (eq idlwave-shell-current-state 'error))))
2398                         (not no-debug)
2399                         (not idlwave-shell-suppress-electric-debug)
2400                         (not idlwave-shell-electric-debug-mode))
2401                (idlwave-shell-electric-debug-mode)
2402                (setq electric t)))
2403            
2404          ;; Make sure pos is really displayed in the window.          ;; Make sure pos is really displayed in the window.
2405          (set-window-point window pos)          (set-window-point window pos)
2406            
2407          ;; If we came from the shell, go back there.  Otherwise select          ;; If we came from the shell, go back there.  Otherwise select
2408          ;; the window where the error is displayed.          ;; the window where the error is displayed.
2409          (if (and (equal (buffer-name) (idlwave-shell-buffer))          (if (or (and idlwave-shell-electric-zap-to-file electric)
2410                   (not select-shell))                  (and (equal (buffer-name) (idlwave-shell-buffer))
2411                         (not select-shell)))
2412              (select-window window))))))              (select-window window))))))
2413    
2414    
# Line 2078  If FRAME is nil then remove overlay." Line 2417  If FRAME is nil then remove overlay."
2417    (interactive "p")    (interactive "p")
2418    (or (not arg) (< arg 1)    (or (not arg) (< arg 1)
2419        (setq arg 1))        (setq arg 1))
2420    (idlwave-shell-send-command    (idlwave-shell-send-command
2421     (concat ".s " (if (integerp arg) (int-to-string arg) arg))     (concat ".s " (if (integerp arg) (int-to-string arg) arg))
2422     nil (idlwave-shell-hide-p 'debug)))     nil (if (idlwave-shell-hide-p 'debug) 'mostly) nil t))
2423    
2424  (defun idlwave-shell-stepover (arg)  (defun idlwave-shell-stepover (arg)
2425    "Stepover one source line.    "Stepover one source line.
2426  If given prefix argument ARG, step ARG source lines.  If given prefix argument ARG, step ARG source lines.
2427  Uses IDL's stepover executive command which does not enter called functions."  Uses IDL's stepover executive command which does not enter called functions."
2428    (interactive "p")    (interactive "p")
2429    (or (not arg) (< arg 1)    (or (not arg) (< arg 1)
2430        (setq arg 1))        (setq arg 1))
2431    (idlwave-shell-send-command    (idlwave-shell-send-command
2432     (concat ".so " (if (integerp arg) (int-to-string arg) arg))     (concat ".so " (if (integerp arg) (int-to-string arg) arg))
2433     nil (idlwave-shell-hide-p 'debug)))     nil (if (idlwave-shell-hide-p 'debug) 'mostly) nil t))
2434    
2435  (defun idlwave-shell-break-here (&optional count cmd condition)  (defun idlwave-shell-break-here (&optional count cmd condition no-show)
2436    "Set breakpoint at current line.    "Set breakpoint at current line.  
2437    
2438  If Count is nil then an ordinary breakpoint is set.  We treat a count  If Count is nil then an ordinary breakpoint is set.  We treat a count
2439  of 1 as a temporary breakpoint using the ONCE keyword.  Counts greater  of 1 as a temporary breakpoint using the ONCE keyword.  Counts greater
2440  than 1 use the IDL AFTER=count keyword to break only after reaching  than 1 use the IDL AFTER=count keyword to break only after reaching
2441  the statement count times.  the statement count times.
2442    
2443  Optional argument CMD is a list or function to evaluate upon reaching  Optional argument CMD is a list or function to evaluate upon reaching
2444  the breakpoint."  the breakpoint."
2445      
2446    (interactive "P")    (interactive "P")
2447    (when (listp count)    (when (listp count)
2448      (if (equal (car count) 4)      (if (equal (car count) 4)
2449          (setq condition (read-string "Break Condition: ")))          (setq condition (read-string "Break Condition: ")))
2450      (setq count nil))      (setq count nil))
2451    (idlwave-shell-set-bp    (idlwave-shell-set-bp
2452     ;; Create breakpoint     ;; Create breakpoint
2453     (idlwave-shell-bp (idlwave-shell-current-frame)     (idlwave-shell-bp (idlwave-shell-current-frame)
2454                       (list count cmd condition)                       (list count cmd condition nil)
2455                       (idlwave-shell-current-module))))                       (idlwave-shell-current-module))
2456       no-show))
2457    
2458  (defun idlwave-shell-set-bp-check (bp)  (defun idlwave-shell-set-bp-check (bp)
2459    "Check for failure to set breakpoint.    "Check for failure to set breakpoint.
# Line 2128  the problem with not being able to set t Line 2468  the problem with not being able to set t
2468        (progn        (progn
2469          (if (progn          (if (progn
2470                (beep)                (beep)
2471                (y-or-n-p                (y-or-n-p
2472                 (concat "Okay to recompile file "                 (concat "Okay to recompile file "
2473                         (idlwave-shell-bp-get bp 'file) " ")))                         (idlwave-shell-bp-get bp 'file) " ")))
2474              ;; Recompile              ;; Recompile
# Line 2136  the problem with not being able to set t Line 2476  the problem with not being able to set t
2476                ;; Clean up before retrying                ;; Clean up before retrying
2477                (idlwave-shell-command-failure)                (idlwave-shell-command-failure)
2478                (idlwave-shell-send-command                (idlwave-shell-send-command
2479                 (concat ".run " (idlwave-shell-bp-get bp 'file)) nil                 (concat ".run " (idlwave-shell-bp-get bp 'file)) nil
2480                 (idlwave-shell-hide-p 'run))                 (if (idlwave-shell-hide-p 'run) 'mostly) nil t)
2481                ;; Try setting breakpoint again                ;; Try setting breakpoint again
2482                (idlwave-shell-set-bp bp))                (idlwave-shell-set-bp bp))
2483            (beep)            (beep)
# Line 2157  breakpoint can not be set." Line 2497  breakpoint can not be set."
2497    ;; Clear pending commands    ;; Clear pending commands
2498    (setq idlwave-shell-pending-commands nil))    (setq idlwave-shell-pending-commands nil))
2499    
2500  (defun idlwave-shell-cont ()  (defun idlwave-shell-cont (&optional no-show)
2501    "Continue executing."    "Continue executing."
2502    (interactive)    (interactive)
2503    (idlwave-shell-send-command ".c" '(idlwave-shell-redisplay 'hide)    (idlwave-shell-send-command ".c" (unless no-show
2504                                (idlwave-shell-hide-p 'debug)))                                       '(idlwave-shell-redisplay 'hide))
2505                                  (if (idlwave-shell-hide-p 'debug) 'mostly)
2506                                  nil t))
2507    
2508  (defun idlwave-shell-go ()  (defun idlwave-shell-go ()
2509    "Run .GO.  This starts the main program of the last compiled file."    "Run .GO.  This starts the main program of the last compiled file."
2510    (interactive)    (interactive)
2511    (idlwave-shell-send-command ".go" '(idlwave-shell-redisplay 'hide)    (idlwave-shell-send-command ".go" '(idlwave-shell-redisplay 'hide)
2512                                (idlwave-shell-hide-p 'debug)))                                (if (idlwave-shell-hide-p 'debug) 'mostly)
2513                                  nil t))
2514    
2515  (defun idlwave-shell-return ()  (defun idlwave-shell-return ()
2516    "Run .RETURN (continue to next return, but stay in subprogram)."    "Run .RETURN (continue to next return, but stay in subprogram)."
2517    (interactive)    (interactive)
2518    (idlwave-shell-send-command ".return" '(idlwave-shell-redisplay 'hide)    (idlwave-shell-send-command ".return" '(idlwave-shell-redisplay 'hide)
2519                                (idlwave-shell-hide-p 'debug)))                                (if (idlwave-shell-hide-p 'debug) 'mostly)
2520                                  nil t))
2521    
2522  (defun idlwave-shell-skip ()  (defun idlwave-shell-skip ()
2523    "Run .SKIP (skip one line, then step)."    "Run .SKIP (skip one line, then step)."
2524    (interactive)    (interactive)
2525    (idlwave-shell-send-command ".skip" '(idlwave-shell-redisplay 'hide)    (idlwave-shell-send-command ".skip" '(idlwave-shell-redisplay 'hide)
2526                                (idlwave-shell-hide-p 'debug)))                                (if (idlwave-shell-hide-p 'debug) 'mostly)
2527                                  nil t))
2528    
2529  (defun idlwave-shell-clear-bp (bp)  (defun idlwave-shell-clear-bp (bp)
2530    "Clear breakpoint BP.    "Clear breakpoint BP.
# Line 2188  Clears in IDL and in `idlwave-shell-bp-a Line 2533  Clears in IDL and in `idlwave-shell-bp-a
2533      (if index      (if index
2534          (progn          (progn
2535            (idlwave-shell-send-command            (idlwave-shell-send-command
2536             (concat "breakpoint,/clear,"             (concat "breakpoint,/clear," (int-to-string index))
2537                     (if (integerp index) (int-to-string index) index))             nil (idlwave-shell-hide-p 'breakpoint) nil t)
            nil (idlwave-shell-hide-p 'breakpoint))  
2538            (idlwave-shell-bp-query)))))            (idlwave-shell-bp-query)))))
2539    
2540  (defun idlwave-shell-current-frame ()  (defun idlwave-shell-current-frame ()
# Line 2225  Returns nil if unable to obtain a module Line 2569  Returns nil if unable to obtain a module
2569  This command can be called from the shell buffer if IDL is currently stopped  This command can be called from the shell buffer if IDL is currently stopped
2570  at a breakpoint."  at a breakpoint."
2571    (interactive)    (interactive)
2572    (let ((bp (idlwave-shell-find-bp (idlwave-shell-current-frame))))    (let ((bp (idlwave-shell-find-current-bp)))
2573      (if bp (idlwave-shell-clear-bp bp)      (if bp (idlwave-shell-clear-bp bp))))
       ;; Try moving to beginning of statement  
       (save-excursion  
         (idlwave-shell-goto-frame)  
         (idlwave-beginning-of-statement)  
         (setq bp (idlwave-shell-find-bp (idlwave-shell-current-frame)))  
         (if bp (idlwave-shell-clear-bp bp)  
           (beep)  
           (message "Cannot identify breakpoint for this line"))))))  
2574    
2575  (defun idlwave-shell-disable-all-bp (&optional enable)  
2576    "Disable all breakpoints we know about.  (defun idlwave-shell-toggle-enable-current-bp (&optional bp force
2577  If ENABLE is non-nil, enable them instead."                                                           no-update)
2578    (let  ((bpl idlwave-shell-bp-alist))    "Disable or enable current bp."
2579      (while bpl    (interactive)
2580        (idlwave-shell-send-command    (let* ((bp (or bp (idlwave-shell-find-current-bp)))
2581             (disabled (idlwave-shell-bp-get bp 'disabled)))
2582        (cond ((eq force 'disable) (setq disabled nil))
2583              ((eq force 'enable) (setq disabled t)))
2584        (when bp
2585          (setf (nth 3 (cdr (cdr bp))) (not disabled))
2586          (idlwave-shell-send-command
2587         (concat "breakpoint,"         (concat "breakpoint,"
2588                 (if enable "/enable," "/disable," )                 (if disabled "/enable," "/disable,")
2589                 (idlwave-shell-bp-get (car bpl)))                 (int-to-string (idlwave-shell-bp-get bp)))
2590         nil (idlwave-shell-hide-p 'breakpoint))         nil (idlwave-shell-hide-p 'breakpoint) nil t)
2591        (setq bpl (cdr bpl)))))        (unless no-update (idlwave-shell-bp-query)))))
2592    
2593    (defun idlwave-shell-enable-all-bp (&optional enable no-update bpl)
2594      "Disable all breakpoints we know about which need disabling.
2595    If ENABLE is non-nil, enable them instead."
2596      (let  ((bpl (or bpl idlwave-shell-bp-alist)) disabled modified)
2597        (while bpl
2598          (setq disabled (idlwave-shell-bp-get (car bpl) 'disabled))
2599          (when (idlwave-xor (not disabled) (eq enable 'enable))
2600            (idlwave-shell-toggle-enable-current-bp
2601             (car bpl) (if (eq enable 'enable) 'enable 'disable) no-update)
2602            (push (car bpl) modified))
2603          (setq bpl (cdr bpl)))
2604        (unless no-update (idlwave-shell-bp-query))
2605        modified))
2606      
2607  (defun idlwave-shell-to-here ()  (defun idlwave-shell-to-here ()
2608    "Set a breakpoint with count 1 then continue."    "Set a breakpoint with count 1 then continue."
2609    (interactive)    (interactive)
2610    (idlwave-shell-disable-all-bp)    (let ((disabled (idlwave-shell-enable-all-bp 'disable 'no-update)))
2611    (idlwave-shell-break-here 1)      (idlwave-shell-break-here 1 nil nil 'no-show)
2612    (idlwave-shell-cont)      (idlwave-shell-cont 'no-show)
2613    (idlwave-shell-disable-all-bp 'enable))      (idlwave-shell-enable-all-bp 'enable 'no-update disabled))
2614      (idlwave-shell-redisplay)) ; sync up everything at the end
2615    
2616  (defun idlwave-shell-break-in (&optional module)  (defun idlwave-shell-break-this-module (&optional arg)
2617      (interactive "P")
2618      (save-excursion
2619        (idlwave-beginning-of-subprogram)
2620        (idlwave-shell-break-here arg)))
2621    
2622    (defun idlwave-shell-break-in ()
2623    "Look for a module name near point and set a break point for it.    "Look for a module name near point and set a break point for it.
2624  The command looks for an identifier near point and sets a breakpoint  The command looks for an identifier near point and sets a breakpoint
2625  for the first line of the corresponding module."  for the first line of the corresponding module.  If MODULE is `t', set
2626    in the current routine."
2627    (interactive)    (interactive)
   ;; get the identifier  
2628    (let (module)    (let (module)
2629      (save-excursion      (save-excursion
2630        (skip-chars-backward "a-zA-Z0-9_$")        (skip-chars-backward "a-zA-Z0-9_$")
# Line 2278  for the first line of the corresponding Line 2641  for the first line of the corresponding
2641  (defun idlwave-shell-set-bp-in-module (module)  (defun idlwave-shell-set-bp-in-module (module)
2642    "Set breakpoint in module.  Assumes that `idlwave-shell-sources-alist'    "Set breakpoint in module.  Assumes that `idlwave-shell-sources-alist'
2643  contains an entry for that module."  contains an entry for that module."
2644    (let ((source-file (car-safe    (let ((source-file (car-safe
2645                        (cdr-safe                        (cdr-safe
2646                         (assoc (upcase module)                         (assoc (upcase module)
2647                                idlwave-shell-sources-alist))))                                idlwave-shell-sources-alist))))
# Line 2297  contains an entry for that module." Line 2660  contains an entry for that module."
2660          (save-excursion          (save-excursion
2661            (goto-char (point-min))            (goto-char (point-min))
2662            (let ((case-fold-search t))            (let ((case-fold-search t))
2663              (if (re-search-forward              (if (re-search-forward
2664                   (concat "^[ \t]*\\(pro\\|function\\)[ \t]+"                   (concat "^[ \t]*\\(pro\\|function\\)[ \t]+"
2665                           (downcase module)                           (downcase module)
2666                           "[ \t\n,]") nil t)                           "[ \t\n,]") nil t)
# Line 2339  Sets a breakpoint with count 1 at end of Line 2702  Sets a breakpoint with count 1 at end of
2702    "Attempt to run until this procedure exits.    "Attempt to run until this procedure exits.
2703  Runs to the last statement and then steps 1 statement.  Use the .out command."  Runs to the last statement and then steps 1 statement.  Use the .out command."
2704    (interactive)    (interactive)
2705    (idlwave-shell-send-command ".o" nil (idlwave-shell-hide-p 'debug)))    (idlwave-shell-send-command ".o" nil
2706                                  (if (idlwave-shell-hide-p 'debug) 'mostly)
2707                                  nil t))
2708    
2709    (defun idlwave-shell-goto-previous-bp ()
2710      "Move to the previous breakpoint in the buffer."
2711      (interactive)
2712      (idlwave-shell-move-to-bp -1))
2713    (defun idlwave-shell-goto-next-bp ()
2714      "Move to the next breakpoint in the buffer."
2715      (interactive)
2716      (idlwave-shell-move-to-bp 1))
2717    
2718    (defun idlwave-shell-move-to-bp (dir)
2719      "Move to the next or previous breakpoint, depending on direction DIR."
2720      (let* ((frame (idlwave-shell-current-frame))
2721             (file (car frame))
2722             (orig-bp-line (nth 1 frame))
2723             (bp-alist idlwave-shell-bp-alist)
2724             (orig-func (if (> dir 0) '> '<))
2725             (closer-func (if (> dir 0) '< '>))
2726             bp got-bp bp-line cur-line)
2727        (while (setq bp (pop bp-alist))
2728          (when (string= file (car (car bp)))
2729            (setq got-bp 1)
2730            (setq cur-line (nth 1 (car bp)))
2731            (if (and
2732                 (funcall orig-func cur-line orig-bp-line)
2733                 (or (not bp-line) (funcall closer-func cur-line bp-line)))
2734                (setq bp-line cur-line))))
2735        (unless bp-line (error "No further breakpoints."))
2736        (goto-line bp-line)))
2737    
2738    ;; Examine Commands ------------------------------------------------------
2739    
2740  (defun idlwave-shell-help-expression (arg)  (defun idlwave-shell-help-expression (arg)
2741    "Print help on current expression.  See `idlwave-shell-print'."    "Print help on current expression.  See `idlwave-shell-print'."
# Line 2353  Runs to the last statement and then step Line 2749  Runs to the last statement and then step
2749       (interactive "e")       (interactive "e")
2750       (let ((transient-mark-mode t)       (let ((transient-mark-mode t)
2751             (zmacs-regions t)             (zmacs-regions t)
2752             (tracker (if (featurep 'xemacs) 'mouse-track             (tracker (if (featurep 'xemacs)
2753                            (if (fboundp 'default-mouse-track-event-is-with-button)
2754                                'idlwave-xemacs-hack-mouse-track
2755                              'mouse-track)
2756                        'mouse-drag-region)))                        'mouse-drag-region)))
2757         (funcall tracker event)         (funcall tracker event)
2758         (idlwave-shell-print (if (idlwave-region-active-p) '(16) nil)         (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil)
2759                              ,help ,ev))))                              ,help ,ev))))
2760    
2761    ;;; Begin terrible hack section -- XEmacs tests for button2 explicitly
2762    ;;; on drag events, calling drag-n-drop code if detected.  Ughhh...
2763    (defun idlwave-default-mouse-track-event-is-with-button (event n)
2764      t)
2765    
2766    (defun idlwave-xemacs-hack-mouse-track (event)
2767      (let ((oldfunc (symbol-function 'default-mouse-track-event-is-with-button)))
2768        (unwind-protect
2769            (progn
2770              (fset 'default-mouse-track-event-is-with-button
2771                    'idlwave-default-mouse-track-event-is-with-button)
2772              (mouse-track event))
2773          (fset 'default-mouse-track-event-is-with-button oldfunc))))
2774    ;;; End terrible hack section
2775    
2776  (defun idlwave-shell-mouse-print (event)  (defun idlwave-shell-mouse-print (event)
2777    "Print value of variable at the mouse position, with `help'"    "Print value of variable at the mouse position, with `help'"
2778    (interactive "e")    (interactive "e")
# Line 2380  Runs to the last statement and then step Line 2794  Runs to the last statement and then step
2794       (interactive)       (interactive)
2795       (idlwave-shell-print nil ,help)))       (idlwave-shell-print nil ,help)))
2796    
 (defun idlwave-shell-define-key-both (key hook)  
   "Define a key in both the shell and buffer mode maps."  
   (define-key idlwave-mode-map key hook)  
   (define-key idlwave-shell-mode-map key hook))  
   
2797  (defvar idlwave-shell-examine-label nil  (defvar idlwave-shell-examine-label nil
2798    "Label to include with examine text if separate.")    "Label to include with examine text if in a separate buffer.")
2799    (defvar idlwave-shell-examine-completion-list nil)
2800    
2801  (defun idlwave-shell-print (arg &optional help ev)  (defun idlwave-shell-print (arg &optional help ev complete-help-type)
2802    "Print current expression.    "Print current expression.  
2803    
2804  With HELP non-nil, show help on expression.  If HELP is a string,  With HELP non-nil, show help on expression.  If HELP is a string,
2805  the expression will be put in place of ___, e.g.:  the expression will be put in place of ___, e.g.:
2806    
2807     print,size(___,/DIMENSIONS)     print,size(___,/DIMENSIONS)
2808    
2809    HELP can also be a cons cell ( NAME . STRING ) in which case NAME will
2810    be used to label the help print-out.
2811    
2812  Otherwise, print is called on the expression.  Otherwise, print is called on the expression.
2813    
2814  An expression is an identifier plus 1 pair of matched parentheses  An expression is an identifier plus 1 pair of matched parentheses
# Line 2406  identifier. If point is at the beginning Line 2819  identifier. If point is at the beginning
2819  return the inner-most containing expression, otherwise, return the  return the inner-most containing expression, otherwise, return the
2820  preceding expression.  preceding expression.
2821    
2822  With prefix arg ARG prompt for an expression.  With prefix arg, or if transient mode set and the region is defined,
2823    use the current region as the expression.
2824    
2825  With double prefix arg, use the current region.  With double prefix arg ARG prompt for an expression.
2826    
2827  If EV is a valid event passed, pop-up a list from  If EV is a valid event passed, pop-up a list from
2828  idlw-shell-examine-alist from which to select the help command text."  idlw-shell-examine-alist from which to select the help command text.
2829    If instead COMPLETE-HELP-TYPE is non-nil, choose from
2830    idlw-shell-examine-alist via mini-buffer shortcut key."
2831    (interactive "P")    (interactive "P")
2832    (save-excursion    (save-excursion
2833      (let* ((process (get-buffer-process (current-buffer)))      (let* ((process (get-buffer-process (current-buffer)))
2834             (process-mark (if process (process-mark process)))             (process-mark (if process (process-mark process)))
2835             (stack-label             (stack-label
2836              (if (and (integerp idlwave-shell-calling-stack-index)              (if (and (integerp idlwave-shell-calling-stack-index)
2837                       (> idlwave-shell-calling-stack-index 0))                       (> idlwave-shell-calling-stack-index 0))
2838                  (format "  [-%d:%s]"                  (format "  [-%d:%s]"
2839                          idlwave-shell-calling-stack-index                          idlwave-shell-calling-stack-index
2840                          idlwave-shell-calling-stack-routine)))                          idlwave-shell-calling-stack-routine)))
2841             expr beg end cmd examine-hook)             expr beg end cmd examine-hook)
2842        (cond        (cond
2843         ((and (equal arg '(16))         ((equal arg '(16))
2844            (setq expr (read-string "Expression: ")))
2845           ((and (or arg (idlwave-region-active-p))
2846               (< (- (region-end) (region-beginning)) 2000))               (< (- (region-end) (region-beginning)) 2000))
2847          (setq beg (region-beginning)          (setq beg (region-beginning)
2848                end (region-end)))                end (region-end)))
        (arg  
         (setq expr (read-string "Expression: ")))  
2849         (t         (t
2850          (idlwave-with-special-syntax          (idlwave-with-special-syntax
2851           ;; Move to beginning of current or previous expression           ;; Move to beginning of current or previous expression
# Line 2450  idlw-shell-examine-alist from which to s Line 2866  idlw-shell-examine-alist from which to s
2866             ;; an array             ;; an array
2867             (forward-sexp))             (forward-sexp))
2868           (setq end (point)))))           (setq end (point)))))
2869          
2870        ;; Get expression, but first move the begin mark if a        ;; Get expression, but first move the begin mark if a
2871        ;; process-mark is inside the region, to keep the overlay from        ;; process-mark is inside the region, to keep the overlay from
2872        ;; wandering in the Shell.        ;; wandering in the Shell.
# Line 2461  idlw-shell-examine-alist from which to s Line 2877  idlw-shell-examine-alist from which to s
2877    
2878        ;; Show the overlay(s) and attach any necessary hooks and filters        ;; Show the overlay(s) and attach any necessary hooks and filters
2879        (when (and beg end idlwave-shell-expression-overlay)        (when (and beg end idlwave-shell-expression-overlay)
2880          (move-overlay idlwave-shell-expression-overlay beg end          (move-overlay idlwave-shell-expression-overlay beg end
2881                        (current-buffer))                        (current-buffer))
2882          (add-hook 'pre-command-hook          (add-hook 'pre-command-hook
2883                    'idlwave-shell-delete-expression-overlay))                    'idlwave-shell-delete-expression-overlay))
2884        (setq examine-hook        (setq examine-hook
2885              (if idlwave-shell-separate-examine-output              (if idlwave-shell-separate-examine-output
2886                  'idlwave-shell-examine-display                  'idlwave-shell-examine-display
2887                'idlwave-shell-examine-highlight))                'idlwave-shell-examine-highlight))
2888        (add-hook 'pre-command-hook        (add-hook 'pre-command-hook
2889                  'idlwave-shell-delete-output-overlay)                  'idlwave-shell-delete-output-overlay)
2890          
2891        ;; Remove empty or comment-only lines        ;; Remove empty or comment-only lines
2892        (while (string-match "\n[ \t]*\\(;.*\\)?\r*\n" expr)        (while (string-match "\n[ \t]*\\(;.*\\)?\r*\n" expr)
2893          (setq expr (replace-match "\n" t t expr)))          (setq expr (replace-match "\n" t t expr)))
# Line 2481  idlw-shell-examine-alist from which to s Line 2897  idlw-shell-examine-alist from which to s
2897        ;; Remove final newline        ;; Remove final newline
2898        (if (string-match "\n[ \t\r]*\\'" expr)        (if (string-match "\n[ \t\r]*\\'" expr)
2899            (setq expr (replace-match "" t t expr)))            (setq expr (replace-match "" t t expr)))
2900        ;; Pop-up the examine selection list, if appropriate        
2901        (if (and ev idlwave-shell-examine-alist)        (catch 'exit
2902            (let* ((help-cons          ;; Pop-up or complete on the examine selection list, if appropriate
2903                    (assoc          (if (or
2904                     (idlwave-popup-select               complete-help-type
2905                      ev (mapcar 'car idlwave-shell-examine-alist)               (and ev idlwave-shell-examine-alist)
2906                      "Examine with")               (consp help))
2907                     idlwave-shell-examine-alist)))              (let ((help-cons
2908              (setq help (cdr help-cons))                     (if (consp help) help
2909              (if idlwave-shell-separate-examine-output                       (assoc
2910                  (setq idlwave-shell-examine-label                        ;; A cons from either a pop-up or mini-buffer completion
2911                        (concat                        (if complete-help-type
2912                         (format "==>%s<==\n%s:" expr (car help-cons))                            (idlwave-one-key-select 'idlwave-shell-examine-alist
2913                         stack-label "\n"))))                                                    "Examine with: " 1.5)
2914          (setq idlwave-shell-examine-label  ;;                        (idlwave-completing-read
2915                (concat  ;;                         "Examine with: "
2916                 (format "==>%s<==\n%s:" expr  ;;                         idlwave-shell-examine-alist nil nil nil
2917                         (cond ((null help) "print")  ;;                         'idlwave-shell-examine-completion-list
2918                               ((stringp help) help)  ;;                         "Print")
2919                               (t (symbol-name help))))                          (idlwave-popup-select
2920                 stack-label "\n")))                           ev
2921                             (mapcar 'car idlwave-shell-examine-alist)
2922        ;; Send the command                           "Examine with"))
2923        (if stack-label                        idlwave-shell-examine-alist))))
2924            (setq cmd (idlwave-retrieve-expression-from-level                (setq help (cdr help-cons))
2925                       expr                (if (null help) (throw 'exit nil))
2926                       idlwave-shell-calling-stack-index                (if idlwave-shell-separate-examine-output
2927                       idlwave-shell-calling-stack-routine                    (setq idlwave-shell-examine-label
2928                       help))                          (concat
2929          (setq cmd (idlwave-shell-help-statement help expr)))                           (format "==>%s<==\n%s:" expr (car help-cons))
2930        ;(idlwave-shell-recenter-shell-window)                           stack-label "\n"))))
2931        (idlwave-shell-send-command            ;; The regular help label (no popups, cons cells, etc.)
2932         cmd            (setq idlwave-shell-examine-label
2933         examine-hook                  (concat
2934         (if idlwave-shell-separate-examine-output 'hide)))))                   (format "==>%s<==\n%s:" expr
2935                             (cond ((null help) "print")
2936                                   ((stringp help) help)
2937                                   (t (symbol-name help))))
2938                     stack-label "\n")))
2939    
2940            ;; Send the command
2941            (if stack-label
2942                (setq expr (idlwave-retrieve-expression-from-level
2943                            expr
2944                            idlwave-shell-calling-stack-index)))
2945            (setq cmd (idlwave-shell-help-statement help expr))
2946            ;;(idlwave-shell-recenter-shell-window)
2947            (idlwave-shell-send-command
2948             cmd
2949             examine-hook
2950             (if idlwave-shell-separate-examine-output 'hide))))))
2951    
2952  (defvar idlwave-shell-examine-window-alist nil  (defvar idlwave-shell-examine-window-alist nil
2953    "Variable to hold the win/height pairs for all *Examine* windows.")    "Variable to hold the win/height pairs for all *Examine* windows.")
2954    
 (defvar idlwave-shell-examine-map (make-sparse-keymap))  
 (define-key idlwave-shell-examine-map "q" 'idlwave-shell-examine-display-quit)  
 (define-key idlwave-shell-examine-map "c" 'idlwave-shell-examine-display-clear)  
   
2955  (defun idlwave-shell-examine-display ()  (defun idlwave-shell-examine-display ()
2956    "View the examine command output in a separate buffer."    "View the examine command output in a separate buffer."
2957    (let (win cur-beg cur-end)    (let (win cur-beg cur-end)
# Line 2541  idlw-shell-examine-alist from which to s Line 2969  idlw-shell-examine-alist from which to s
2969            (let* ((end (or            (let* ((end (or
2970                         (re-search-backward idlwave-shell-prompt-pattern nil t)                         (re-search-backward idlwave-shell-prompt-pattern nil t)
2971                         (point-max)))                         (point-max)))
2972                   (beg (progn                   (beg (progn
2973                          (goto-char                          (goto-char
2974                           (or (progn (if (re-search-backward                           (or (progn (if (re-search-backward
2975                                           idlwave-shell-prompt-pattern nil t)                                           idlwave-shell-prompt-pattern nil t)
2976                                          (match-end 0)))                                          (match-end 0)))
2977                               (point-min)))                               (point-min)))
# Line 2560  idlw-shell-examine-alist from which to s Line 2988  idlw-shell-examine-alist from which to s
2988          (setq buffer-read-only t)          (setq buffer-read-only t)
2989          (move-overlay idlwave-shell-output-overlay cur-beg cur-end          (move-overlay idlwave-shell-output-overlay cur-beg cur-end
2990                        (current-buffer))                        (current-buffer))
2991            
2992          ;; Look for the examine buffer in all windows.  If one is          ;; Look for the examine buffer in all windows.  If one is
2993          ;; found in a frame all by itself, use that, otherwise, switch          ;; found in a frame all by itself, use that, otherwise, switch
2994          ;; to or create an examine window in this frame, and resize if          ;; to or create an examine window in this frame, and resize if
2995          ;; it's a newly created window          ;; it's a newly created window
2996          (let* ((winlist (get-buffer-window-list "*Examine*" nil 'visible)))          (let* ((winlist (get-buffer-window-list "*Examine*" nil 'visible)))
2997            (setq win (idlwave-display-buffer            (setq win (idlwave-display-buffer
2998                       "*Examine*"                       "*Examine*"
2999                       nil                       nil
3000                       (let ((list winlist) thiswin)                       (let ((list winlist) thiswin)
3001                         (catch 'exit                         (catch 'exit
3002                           (save-selected-window                           (save-selected-window
3003                             (while (setq thiswin (pop list))                             (while (setq thiswin (pop list))
3004                               (select-window thiswin)                               (select-window thiswin)
3005                               (if (one-window-p)                               (if (one-window-p)
3006                                   (throw 'exit (window-frame thiswin)))))))))                                   (throw 'exit (window-frame thiswin)))))))))
3007            (set-window-start win (point-min)) ; Ensure the point is visible.            (set-window-start win (point-min)) ; Ensure the point is visible.
3008            (save-selected-window            (save-selected-window
# Line 2595  idlw-shell-examine-alist from which to s Line 3023  idlw-shell-examine-alist from which to s
3023                  ;; And add the new value.                  ;; And add the new value.
3024                  (if (setq elt (assoc win idlwave-shell-examine-window-alist))                  (if (setq elt (assoc win idlwave-shell-examine-window-alist))
3025                      (setcdr elt (window-height))                      (setcdr elt (window-height))
3026                    (add-to-list 'idlwave-shell-examine-window-alist                    (add-to-list 'idlwave-shell-examine-window-alist
3027                                 (cons win (window-height)))))))))                                 (cons win (window-height)))))))))
3028        ;; Recenter for maximum output, after widened        ;; Recenter for maximum output, after widened
3029        (save-selected-window        (save-selected-window
# Line 2604  idlw-shell-examine-alist from which to s Line 3032  idlw-shell-examine-alist from which to s
3032          (skip-chars-backward "\n")          (skip-chars-backward "\n")
3033          (recenter -1)))))          (recenter -1)))))
3034    
3035    (defvar idlwave-shell-examine-map (make-sparse-keymap))
3036    (define-key idlwave-shell-examine-map "q" 'idlwave-shell-examine-display-quit)
3037    (define-key idlwave-shell-examine-map "c" 'idlwave-shell-examine-display-clear)
3038    
3039  (defun idlwave-shell-examine-display-quit ()  (defun idlwave-shell-examine-display-quit ()
3040    (interactive)    (interactive)
3041    (let ((win (selected-window)))    (let ((win (selected-window)))
# Line 2613  idlw-shell-examine-alist from which to s Line 3045  idlw-shell-examine-alist from which to s
3045    
3046  (defun idlwave-shell-examine-display-clear ()  (defun idlwave-shell-examine-display-clear ()
3047    (interactive)    (interactive)
3048    (save-excursion    (save-excursion
3049      (let ((buf (get-buffer "*Examine*")))      (let ((buf (get-buffer "*Examine*")))
3050        (when (bufferp buf)        (when (bufferp buf)
3051          (set-buffer buf)          (set-buffer buf)
# Line 2621  idlw-shell-examine-alist from which to s Line 3053  idlw-shell-examine-alist from which to s
3053          (erase-buffer)          (erase-buffer)
3054          (setq buffer-read-only t)))))          (setq buffer-read-only t)))))
3055    
3056  (defun idlwave-retrieve-expression-from-level (expr level routine help)  (defun idlwave-retrieve-expression-from-level (expr level)
3057    "Return IDL command to print the expression EXPR from stack level LEVEL.    "Return IDL command to print the expression EXPR from stack level LEVEL.
3058    
3059  It does not seem possible to evaluate an expression on a differnt  It does not seem possible to evaluate an expression on a different
3060  level than the current.  Therefore, this function retrieves *copies* of  level than the current.  Therefore, this function retrieves variables
3061  the variables involved in the expression from the desired level in the  by reference from other levels, and then includes that variable in
3062  calling stack.  The copies are given some unlikely names on the  place of the chosen one.
3063  *current* level, and the expression is then evaluated on the *current*  
3064  level.  Since this function depends upon the undocumented IDL routine
3065    routine_names, there is no guarantee that this will work with future
3066  Since this function depends upon the undocumented IDL routine routine_names,  versions of IDL."
3067  there is no guarantee that this will work with future versions of IDL."    (let ((fetch (- 0 level))
   (let ((prefix "___")         ;; No real variables should starts with this.  
         (fetch (- 0 level))  
3068          (start 0)          (start 0)
3069          var tvar fetch-vars pre post)          var rnvar pre post)
3070    
3071       ;; FIXME: In the following we try to find the variables in expression      ;; FIXME: In the following we try to find the variables in expression
3072      ;; This is quite empirical - I don't know in what situations this will      ;; This is quite empirical - I don't know in what situations this will
3073      ;; break.  We will look for identifiers and exclude cases where we      ;; break.  We will look for identifiers and exclude cases where we
3074      ;; know it is not a variable.  To distinguish array references from      ;; know it is not a variable.  To distinguish array references from
3075      ;; function calls, we require that arrays use [] instead of ()      ;; function calls, we require that arrays use [] instead of ()
3076        
3077      (while (string-match      (while (string-match
3078              "\\(\\`\\|[^a-zA-Z0-9$_]\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)\\([^a-zA-Z0-9$_]\\|\\'\\)" expr start)              "\\(\\`\\|[^a-zA-Z0-9$_][ \t]*\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)\\([ \t]*[^a-zA-Z0-9$_]\\|\\'\\)" expr start)
3079        (setq var (match-string 2 expr)        (setq var (match-string 2 expr)
             tvar (concat prefix var)  
3080              start (match-beginning 2)              start (match-beginning 2)
3081              pre (substring expr 0 (match-beginning 2))              pre (substring expr 0 (match-beginning 2))
3082              post (substring expr (match-end 2)))              post (substring expr (match-end 2)))
# Line 2659  there is no guarantee that this will wor Line 3088  there is no guarantee that this will wor
3088         ((string-match "\\`(" post))              ;; a function         ((string-match "\\`(" post))              ;; a function
3089         ((string-match "->[ \t]*\\'" pre))        ;; a method         ((string-match "->[ \t]*\\'" pre))        ;; a method
3090         ((string-match "\\.\\'" pre))             ;; structure member         ((string-match "\\.\\'" pre))             ;; structure member
3091         (t ;; seems to be a variable - arrange to get it and replace         ((and (string-match "\\([\"\']\\)[^\1]*$" pre)
3092          ;; its name in the expression with the temproary name.               (string-match (concat "^[^" (match-string 1 pre) "]*"
3093          (push (cons var tvar) fetch-vars)                                     (match-string 1 pre)) post)))
3094          (setq expr (concat pre tvar post))))         (t ;; seems to be a variable - replace its name in the
3095        (if (= start 0) (setq start 1)))            ;; expression with the fetch.
3096      ;; Make a command line that first copies the relevant variables          (setq rnvar (format "(routine_names('%s',fetch=%d))" var fetch)
3097      ;; and then prints the expression.                expr  (concat pre rnvar post)
3098      (concat                start (+ start (length rnvar))))))
3099       (mapconcat      expr))
3100        (lambda (x)  
         (format "%s = routine_names('%s',fetch=%d)" (cdr x) (car x) fetch))  
       (nreverse fetch-vars)  
       " & ")  
      "\n"  
      (idlwave-shell-help-statement help expr)  
      (format " ; [-%d:%s]" level routine))))  
3101    
3102  (defun idlwave-shell-help-statement (help expr)  (defun idlwave-shell-help-statement (help expr)
3103    "Construct a help statement for printing expression EXPR.    "Construct a help statement for printing expression EXPR.
# Line 2684  to insert expression in place of the mar Line 3107  to insert expression in place of the mar
3107  size(___,/DIMENSIONS)"  size(___,/DIMENSIONS)"
3108    (cond    (cond
3109     ((null help) (concat "print, " expr))     ((null help) (concat "print, " expr))
3110     ((stringp help)     ((stringp help)
3111      (if (string-match "\\(^\\|[^_]\\)\\(___\\)\\([^_]\\|$\\)" help)      (if (string-match "\\(^\\|[^_]\\)\\(___\\)\\([^_]\\|$\\)" help)
3112          (concat (substring help 0 (match-beginning 2))          (concat (substring help 0 (match-beginning 2))
3113                  expr                  expr
3114                  (substring help (match-end 2)))))                  (substring help (match-end 2)))))
3115     (t (concat "help, " expr))))     (t (concat "help, " expr))))
3116      
3117    
3118  (defun idlwave-shell-examine-highlight ()  (defun idlwave-shell-examine-highlight ()
3119    "Highlight the most recent IDL output."    "Highlight the most recent IDL output."
# Line 2698  size(___,/DIMENSIONS)" Line 3121  size(___,/DIMENSIONS)"
3121           (process (get-buffer-process buffer))           (process (get-buffer-process buffer))
3122           (process-mark (if process (process-mark process)))           (process-mark (if process (process-mark process)))
3123           output-begin output-end)           output-begin output-end)
3124      (save-excursion      (save-excursion
3125        (set-buffer buffer)        (set-buffer buffer)
3126        (goto-char process-mark)        (goto-char process-mark)
3127        (beginning-of-line)        (beginning-of-line)
# Line 2706  size(___,/DIMENSIONS)" Line 3129  size(___,/DIMENSIONS)"
3129        (re-search-backward idlwave-shell-prompt-pattern nil t)        (re-search-backward idlwave-shell-prompt-pattern nil t)
3130        (beginning-of-line 2)        (beginning-of-line 2)
3131        (setq output-begin (point)))        (setq output-begin (point)))
3132                
3133      ;; First make sure the shell window is visible      ;; First make sure the shell window is visible
3134      (idlwave-display-buffer (idlwave-shell-buffer)      (idlwave-display-buffer (idlwave-shell-buffer)
3135                              nil (idlwave-shell-shell-frame))                              nil (idlwave-shell-shell-frame))
3136      (if (and idlwave-shell-output-overlay process-mark)      (if (and idlwave-shell-output-overlay process-mark)
3137          (move-overlay idlwave-shell-output-overlay          (move-overlay idlwave-shell-output-overlay
3138                        output-begin output-end buffer))))                        output-begin output-end buffer))))
3139    
3140  (defun idlwave-shell-delete-output-overlay ()  (defun idlwave-shell-delete-output-overlay ()
3141    (if (eq this-command 'idlwave-shell-mouse-nop)    (unless (or (eq this-command 'idlwave-shell-mouse-nop)
3142        nil                (eq this-command 'handle-switch-frame))
3143      (condition-case nil      (condition-case nil
3144          (if idlwave-shell-output-overlay          (if idlwave-shell-output-overlay
3145              (delete-overlay idlwave-shell-output-overlay))              (delete-overlay idlwave-shell-output-overlay))
3146        (error nil))        (error nil))
3147      (remove-hook 'pre-command-hook 'idlwave-shell-delete-output-overlay)))      (remove-hook 'pre-command-hook 'idlwave-shell-delete-output-overlay)))
3148      
3149  (defun idlwave-shell-delete-expression-overlay ()  (defun idlwave-shell-delete-expression-overlay ()
3150    (if (eq this-command 'idlwave-shell-mouse-nop)    (unless (or (eq this-command 'idlwave-shell-mouse-nop)
3151        nil                (eq this-command 'handle-switch-frame))
3152      (condition-case nil      (condition-case nil
3153          (if idlwave-shell-expression-overlay          (if idlwave-shell-expression-overlay
3154              (delete-overlay idlwave-shell-expression-overlay))              (delete-overlay idlwave-shell-expression-overlay))
# Line 2736  size(___,/DIMENSIONS)" Line 3159  size(___,/DIMENSIONS)"
3159    "Alist of breakpoints.    "Alist of breakpoints.
3160  A breakpoint is a cons cell \(\(file line\) . \(\(index module\) data\)\)  A breakpoint is a cons cell \(\(file line\) . \(\(index module\) data\)\)
3161    
3162  The car is the frame for the breakpoint:  The car is the `frame' for the breakpoint:
3163  file - full path file name.  file - full path file name.
3164  line - line number of breakpoint - integer.  line - line number of breakpoint - integer.
3165    
# Line 2746  module - the module for breakpoint inter Line 3169  module - the module for breakpoint inter
3169    
3170  Remaining elements of the cdr:  Remaining elements of the cdr:
3171  data - Data associated with the breakpoint by idlwave-shell currently  data - Data associated with the breakpoint by idlwave-shell currently
3172  contains two items:  contains four items:
3173    
3174  count - number of times to execute breakpoint. When count reaches 0  count - number of times to execute breakpoint. When count reaches 0
3175  the breakpoint is cleared and removed from the alist.    the breakpoint is cleared and removed from the alist.
3176  command - command to execute when breakpoint is reached, either a  
3177  lisp function to be called with `funcall' with no arguments or a  command - command to execute when breakpoint is reached, either a
3178  list to be evaluated with `eval'.")    lisp function to be called with `funcall' with no arguments or a
3179      list to be evaluated with `eval'.
3180    
3181    condition - any condition to apply to the breakpoint.
3182    
3183    disabled - whether the bp is disabled")
3184    
3185  (defun idlwave-shell-run-region (beg end &optional n)  (defun idlwave-shell-run-region (beg end &optional n)
3186    "Compile and run the region using the IDL process.    "Compile and run the region using the IDL process.
# Line 2779  If there is a prefix argument, display I Line 3207  If there is a prefix argument, display I
3207            (insert "\nend\n"))            (insert "\nend\n"))
3208        (save-buffer 0)))        (save-buffer 0)))
3209    (idlwave-shell-send-command (concat ".run " idlwave-shell-temp-pro-file)    (idlwave-shell-send-command (concat ".run " idlwave-shell-temp-pro-file)
3210                                nil (idlwave-shell-hide-p 'run))                                nil
3211                                  (if (idlwave-shell-hide-p 'run) 'mostly)
3212                                  nil t)
3213    (if n    (if n
3214        (idlwave-display-buffer (idlwave-shell-buffer)        (idlwave-display-buffer (idlwave-shell-buffer)
3215                                nil (idlwave-shell-shell-frame))))                                nil (idlwave-shell-shell-frame))))
3216    
3217  (defun idlwave-shell-evaluate-region (beg end &optional n)  (defun idlwave-shell-evaluate-region (beg end &optional n)
# Line 2792  Does not work for a region with multilin Line 3222  Does not work for a region with multilin
3222    (interactive "r\nP")    (interactive "r\nP")
3223    (idlwave-shell-send-command (buffer-substring beg end))    (idlwave-shell-send-command (buffer-substring beg end))
3224    (if n    (if n
3225        (idlwave-display-buffer (idlwave-shell-buffer)        (idlwave-display-buffer (idlwave-shell-buffer)
3226                                nil (idlwave-shell-shell-frame))))                                nil (idlwave-shell-shell-frame))))
3227    
3228  (defun idlwave-shell-delete-temp-files ()  (defun idlwave-shell-delete-temp-files ()
# Line 2816  Does not work for a region with multilin Line 3246  Does not work for a region with multilin
3246        (display-buffer buf not-this-window-p frame)        (display-buffer buf not-this-window-p frame)
3247      ;; For Emacs, we need to force the frame ourselves.      ;; For Emacs, we need to force the frame ourselves.
3248      (let ((this-frame (selected-frame)))      (let ((this-frame (selected-frame)))
3249        (if (frame-live-p frame)        (save-excursion ;; make sure we end up in the same buffer
3250            (select-frame frame))          (if (frame-live-p frame)
3251        (if (eq this-frame (selected-frame))              (select-frame frame))
3252            ;; same frame:  use display buffer, to make sure the current          (if (eq this-frame (selected-frame))
3253            ;; window stays.              ;; same frame:  use display buffer, to make sure the current
3254            (display-buffer buf)              ;; window stays.
3255          ;; different frame              (display-buffer buf)
3256          (if (one-window-p)            ;; different frame
3257              ;; only window:  switch            (if (one-window-p)
3258              (progn                ;; only window:  switch
3259                (switch-to-buffer buf)                (progn
3260                (selected-window))   ; must return the window.                  (switch-to-buffer buf)
3261            ;; several windows - use display-buffer                  (selected-window))   ; must return the window.
3262            (display-buffer buf not-this-window-p))))))              ;; several windows - use display-buffer
3263                (display-buffer buf not-this-window-p)))))))
3264  ;  (if (not (frame-live-p frame)) (setq frame nil))  ;  (if (not (frame-live-p frame)) (setq frame nil))
3265  ;  (display-buffer buf not-this-window-p frame))  ;  (display-buffer buf not-this-window-p frame))
3266    
3267  (defvar idlwave-shell-bp-buffer " *idlwave-shell-bp*"  (defvar idlwave-shell-bp-buffer " *idlwave-shell-bp*"
3268    "Scratch buffer for parsing IDL breakpoint lists and other stuff.")    "Scratch buffer for parsing IDL breakpoint lists and other stuff.")
3269    
3270  (defun idlwave-shell-bp-query ()  (defun idlwave-shell-bp-query (&optional no-show)
3271    "Reconcile idlwave-shell's breakpoint list with IDL's.    "Reconcile idlwave-shell's breakpoint list with IDL's.
3272  Queries IDL using the string in `idlwave-shell-bp-query'."  Queries IDL using the string in `idlwave-shell-bp-query'."
3273    (interactive)    (interactive)
3274    (idlwave-shell-send-command idlwave-shell-bp-query    (idlwave-shell-send-command idlwave-shell-bp-query
3275                                'idlwave-shell-filter-bp                                `(progn
3276                                    (idlwave-shell-filter-bp (quote ,no-show)))
3277                                'hide))                                'hide))
3278    
3279  (defun idlwave-shell-bp-get (bp &optional item)  (defun idlwave-shell-bp-get (bp &optional item)
3280    "Get a value for a breakpoint.    "Get a value for a breakpoint.  
3281  BP has the form of elements in idlwave-shell-bp-alist.  BP has the form of elements in idlwave-shell-bp-alist.  Optional
3282  Optional second arg ITEM is the particular value to retrieve.  second arg ITEM is the particular value to retrieve.  ITEM can be
3283  ITEM can be 'file, 'line, 'index, 'module, 'count, 'cmd, or 'data.  'file, 'line, 'index, 'module, 'count, 'cmd, 'condition, 'disabled or
3284  'data returns a list of 'count and 'cmd.  'data.  'data returns a list of 'count, 'cmd and 'condition.  Defaults
3285  Defaults to 'index."  to 'index."
3286    (cond    (cond
3287     ;; Frame     ;; Frame
3288     ((eq item 'line) (nth 1 (car bp)))     ((eq item 'line) (nth 1 (car bp)))
# Line 2860  Defaults to 'index." Line 3292  Defaults to 'index."
3292     ((eq item 'count) (nth 0 (cdr (cdr bp))))     ((eq item 'count) (nth 0 (cdr (cdr bp))))
3293     ((eq item 'cmd) (nth 1 (cdr (cdr bp))))     ((eq item 'cmd) (nth 1 (cdr (cdr bp))))
3294     ((eq item 'condition) (nth 2 (cdr (cdr bp))))     ((eq item 'condition) (nth 2 (cdr (cdr bp))))
3295       ((eq item 'disabled) (nth 3 (cdr (cdr bp))))
3296     ;; IDL breakpoint info     ;; IDL breakpoint info
3297     ((eq item 'module) (nth 1 (car (cdr bp))))     ((eq item 'module) (nth 1 (car (cdr bp))))
3298     ;;    index - default     ;;    index - default
3299     (t (nth 0 (car (cdr bp))))))     (t (nth 0 (car (cdr bp))))))
3300    
3301  (defun idlwave-shell-filter-bp ()  (defun idlwave-shell-filter-bp (&optional no-show)
3302    "Get the breakpoints from `idlwave-shell-command-output'.    "Get the breakpoints from `idlwave-shell-command-output'.  Create
3303  Create `idlwave-shell-bp-alist' updating breakpoint count and command data  `idlwave-shell-bp-alist' updating breakpoint count and command data
3304  from previous breakpoint list."  from previous breakpoint list.  If NO-SHOW is set, don't update the
3305    breakpoint overlays."
3306    (save-excursion    (save-excursion
3307      (set-buffer (get-buffer-create idlwave-shell-bp-buffer))      (set-buffer (get-buffer-create idlwave-shell-bp-buffer))
3308      (erase-buffer)      (erase-buffer)
# Line 2878  from previous breakpoint list." Line 3312  from previous breakpoint list."
3312            ;; Searching the breakpoints            ;; Searching the breakpoints
3313            ;; In IDL 5.5, the breakpoint reporting format changed.            ;; In IDL 5.5, the breakpoint reporting format changed.
3314            (bp-re54 "^[ \t]*\\([0-9]+\\)[ \t]+\\(\\S-+\\)?[ \t]+\\([0-9]+\\)[ \t]+\\(\\S-+\\)")            (bp-re54 "^[ \t]*\\([0-9]+\\)[ \t]+\\(\\S-+\\)?[ \t]+\\([0-9]+\\)[ \t]+\\(\\S-+\\)")
3315            (bp-re55 "^\\s-*\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\(Uncompiled\\|Func=\\|Pro=\\)\\([a-zA-Z][a-zA-Z0-9$_:]*\\)\\(,[^\n]*\n\\)?\\s-+\\(\\S-+\\)")            (bp-re55
3316               (concat
3317                "^\\s-*\\([0-9]+\\)"    ; 1 index
3318                "\\s-+\\([0-9]+\\)"     ; 2 line number
3319                "\\s-+\\(Uncompiled\\|" ; 3-6 either uncompiled or routine name
3320                "\\(\\(Func=\\|Pro=\\)\\(\\$?[a-zA-Z][a-zA-Z0-9$_:]*\\$?\\)\\)\\)"
3321                "\\(\\s-*,\\s-*After=[0-9]+/\\([0-9]+\\)?\\)?" ; 7-8 After part
3322                "\\(\\s-*,\\s-*\\(BreakOnce\\)\\)?"            ; 9-10 BreakOnce
3323                "\\(\\s-*,\\s-*\\(Condition='\\(.*\\)'\\)\n?\\)?" ; 11-13 Condition
3324                "\\(\\s-*,\\s-*\\(Disabled\\)\n?\\)?"          ; 14-15 Disabled
3325                "\\s-+\\(\\S-+\\)"))                           ; 16 File name
3326            file line index module            file line index module
3327              count condition disabled
3328            bp-re indmap)            bp-re indmap)
3329        (setq idlwave-shell-bp-alist (list nil))        (setq idlwave-shell-bp-alist (list nil))
3330        ;; Search for either header type, and set the correct regexp        ;; Search for either header type, and set the correct regexp
3331        (when (or        (when (or
3332               (if (re-search-forward "^\\s-*Index.*\n\\s-*-" nil t)               (if (re-search-forward "^\\s-*Index.*\n\\s-*-" nil t)
3333                   (setq bp-re bp-re54    ; versions <= 5.4                   (setq bp-re bp-re54    ; versions <= 5.4
3334                         indmap '(1 2 3 4)))                         indmap '(1 2 3 4))) ;index module line file
3335               (if (re-search-forward               (if (re-search-forward
3336                    "^\\s-*Index\\s-*Line\\s-*Attributes\\s-*File" nil t)                    "^\\s-*Index\\s-*Line\\s-*Attributes\\s-*File" nil t)
3337                   (setq bp-re bp-re55    ; versions >= 5.5                   (setq bp-re bp-re55    ; versions >= 5.5
3338                         indmap '(1 4 2 6))))                         indmap '(1 6 2 16)))) ; index module line file
3339          ;; There seems to be a breakpoint listing here.          ;; There seems to be a breakpoint listing here, parse breakpoint lines.
         ;; Parse breakpoint lines.  
         ;; Breakpoints have the form  
         ;;    for IDL<=v5.4:  
         ;;  Index Module Line File  
         ;;  All separated by whitespace.  
         ;;  Module may be missing if the file is not compiled.  
         ;;    for IDL>=v5.5:  
         ;;  Index Line Attributes File  
         ;;    (attributes replaces module, "Uncompiled" included)  
3340          (while (re-search-forward bp-re nil t)          (while (re-search-forward bp-re nil t)
3341            (setq index (match-string (nth 0 indmap))            (setq index (string-to-int (match-string (nth 0 indmap)))
3342                  module (match-string (nth 1 indmap))                  module (match-string (nth 1 indmap))
3343                  line (string-to-int (match-string (nth 2 indmap)))                  line (string-to-int (match-string (nth 2 indmap)))
3344                  file (idlwave-shell-file-name (match-string (nth 3 indmap))))                  file (idlwave-shell-file-name (match-string (nth 3 indmap))))
3345              (if (eq bp-re bp-re55)
3346                  (setq count (if (match-string 10) 1
3347                                (if (match-string 8)
3348                                    (string-to-int (match-string 8))))
3349                        condition (match-string 13)
3350                        disabled (not (null (match-string 15)))))
3351                        
3352            ;; Add the breakpoint info to the list            ;; Add the breakpoint info to the list
3353            (nconc idlwave-shell-bp-alist            (nconc idlwave-shell-bp-alist
3354                   (list (cons (list file line)                   (list (cons (list file line)
3355                               (list                               (list
3356                                (list index module)                                (list index module)
3357                                ;; idlwave-shell data: count, command                                ;; bp data: count, command, condition, disabled
3358                                nil nil))))))                                count nil condition disabled))))))
3359        (setq idlwave-shell-bp-alist (cdr idlwave-shell-bp-alist))        (setq idlwave-shell-bp-alist (cdr idlwave-shell-bp-alist))
3360        ;; Update count, commands of breakpoints        ;; Update breakpoint data
3361        (mapcar 'idlwave-shell-update-bp old-bp-alist)))        (if (eq bp-re bp-re54)
3362              (mapcar 'idlwave-shell-update-bp old-bp-alist)
3363            (mapcar 'idlwave-shell-update-bp-command-only old-bp-alist))))
3364    ;; Update the breakpoint overlays    ;; Update the breakpoint overlays
3365    (idlwave-shell-update-bp-overlays)    (unless no-show (idlwave-shell-update-bp-overlays))
3366    ;; Return the new list    ;; Return the new list
3367    idlwave-shell-bp-alist)    idlwave-shell-bp-alist)
3368    
3369  (defun idlwave-shell-update-bp (bp)  (defun idlwave-shell-update-bp-command-only (bp)
3370      (idlwave-shell-update-bp bp t))
3371    
3372    (defun idlwave-shell-update-bp (bp &optional command-only)
3373    "Update BP data in breakpoint list.    "Update BP data in breakpoint list.
3374  If BP frame is in `idlwave-shell-bp-alist' updates the breakpoint data."  If BP frame is in `idlwave-shell-bp-alist' updates the breakpoint data."
3375    (let ((match (assoc (car bp) idlwave-shell-bp-alist)))    (let ((match (assoc (car bp) idlwave-shell-bp-alist)))
3376      (if match (setcdr (cdr match) (cdr (cdr bp))))))      (if match
3377            (if command-only
3378                (setf (nth 1 (cdr (cdr match))) (nth 1 (cdr (cdr match))))
3379              (setcdr (cdr match) (cdr (cdr bp)))))))
3380    
3381  (defun idlwave-shell-set-bp-data (bp data)  (defun idlwave-shell-set-bp-data (bp data)
3382    "Set the data of BP to DATA."    "Set the data of BP to DATA."
# Line 2948  Otherwise return the filename in bp." Line 3399  Otherwise return the filename in bp."
3399    (let*    (let*
3400        ((bp-file (idlwave-shell-bp-get bp 'file))        ((bp-file (idlwave-shell-bp-get bp 'file))
3401         (bp-module (idlwave-shell-bp-get bp 'module))         (bp-module (idlwave-shell-bp-get bp 'module))
3402         (internal-file-list (cdr (assoc bp-module idlwave-shell-sources-alist))))         (internal-file-list
3403            (cdr (assoc bp-module idlwave-shell-sources-alist))))
3404      (if (and internal-file-list      (if (and internal-file-list
3405               (equal bp-file (nth 0 internal-file-list)))               (equal bp-file (nth 0 internal-file-list)))
3406          (nth 1 internal-file-list)          (nth 1 internal-file-list)
3407        bp-file)))        bp-file)))
3408    
3409  (defun idlwave-shell-set-bp (bp)  (defun idlwave-shell-set-bp (bp &optional no-show)
3410    "Try to set a breakpoint BP.    "Try to set a breakpoint BP.  
   
3411  The breakpoint will be placed at the beginning of the statement on the  The breakpoint will be placed at the beginning of the statement on the
3412  line specified by BP or at the next IDL statement if that line is not  line specified by BP or at the next IDL statement if that line is not
3413  a statement.  a statement.  Determines IDL's internal representation for the
3414  Determines IDL's internal representation for the breakpoint which may  breakpoint, which may have occured at a different line than
3415  have occurred at a different line then used with the breakpoint  specified.  If NO-SHOW is non-nil, don't do any updating."
 command."  
   
3416    ;; Get and save the old breakpoints    ;; Get and save the old breakpoints
3417    (idlwave-shell-send-command    (idlwave-shell-send-command
3418     idlwave-shell-bp-query     idlwave-shell-bp-query
3419     '(progn     `(progn
3420        (idlwave-shell-filter-bp)       (idlwave-shell-filter-bp (quote ,no-show))
3421        (setq idlwave-shell-old-bp idlwave-shell-bp-alist))       (setq idlwave-shell-old-bp idlwave-shell-bp-alist))
3422     'hide)     'hide)
3423    ;; Get sources for IDL compiled procedures followed by setting    ;; Get sources for IDL compiled procedures followed by setting
3424    ;; breakpoint.    ;; breakpoint.
3425    (idlwave-shell-send-command    (idlwave-shell-send-command
3426     idlwave-shell-sources-query     idlwave-shell-sources-query
3427     `(progn     `(progn
3428        (idlwave-shell-sources-filter)       (idlwave-shell-sources-filter)
3429        (idlwave-shell-set-bp2 (quote ,bp)))       (idlwave-shell-set-bp2 (quote ,bp) (quote ,no-show)))
3430     'hide))     'hide))
3431    
3432  (defun idlwave-shell-set-bp2 (bp)  (defun idlwave-shell-set-bp2 (bp &optional no-show)
3433    "Use results of breakpoint and sources query to set bp.    "Use results of breakpoint and sources query to set bp.
3434  Use the count argument with IDLs breakpoint command.  Use the count argument with IDLs breakpoint command.
3435  We treat a count of 1 as a temporary breakpoint.  We treat a count of 1 as a temporary breakpoint.
3436  Counts greater than 1 use the IDL AFTER=count keyword to break  Counts greater than 1 use the IDL AFTER=count keyword to break
3437  only after reaching the statement count times."  only after reaching the statement count times."
3438    (let*    (let*
# Line 2995  only after reaching the statement count Line 3444  only after reaching the statement count
3444                ((> arg 1)                ((> arg 1)
3445                 (format ",after=%d" arg))))                 (format ",after=%d" arg))))
3446         (condition (idlwave-shell-bp-get bp 'condition))         (condition (idlwave-shell-bp-get bp 'condition))
3447         (key (concat key         (key (concat key
3448                      (if condition (concat ",CONDITION=\"" condition "\""))))                      (if condition (concat ",CONDITION=\"" condition "\""))))
3449         (line (idlwave-shell-bp-get bp 'line)))         (line (idlwave-shell-bp-get bp 'line)))
3450      (idlwave-shell-send-command      (idlwave-shell-send-command
3451       (concat "breakpoint,'"       (concat "breakpoint,'"
3452               (idlwave-shell-sources-bp bp) "',"               (idlwave-shell-sources-bp bp) "',"
3453               (if (integerp line) (setq line (int-to-string line)))               (if (integerp line) (setq line (int-to-string line)))
3454               key)               key)
3455       ;; Check for failure and look for breakpoint in IDL's list       ;; Check for failure and look for breakpoint in IDL's list
3456       `(progn       `(progn
3457         (if (idlwave-shell-set-bp-check (quote ,bp))          (if (idlwave-shell-set-bp-check (quote ,bp))
3458             (idlwave-shell-set-bp3 (quote ,bp))))             (idlwave-shell-set-bp3 (quote ,bp) (quote ,no-show))))
3459       ;; hide output?       ;; hide output?
3460       (idlwave-shell-hide-p 'breakpoint)       (idlwave-shell-hide-p 'breakpoint)
3461       'preempt)))       'preempt t)))
3462    
3463  (defun idlwave-shell-set-bp3 (bp)  (defun idlwave-shell-set-bp3 (bp &optional no-show)
3464    "Find the breakpoint in IDL's internal list of breakpoints."    "Find the breakpoint in IDL's internal list of breakpoints."
3465    (idlwave-shell-send-command idlwave-shell-bp-query    (idlwave-shell-send-command idlwave-shell-bp-query
3466                                `(progn                                `(progn
3467                                  (idlwave-shell-filter-bp)                                   (idlwave-shell-filter-bp (quote ,no-show))
3468                                  (idlwave-shell-new-bp (quote ,bp)))                                   (idlwave-shell-new-bp (quote ,bp))
3469                                     (unless (quote ,no-show)
3470                                       (idlwave-shell-update-bp-overlays)))
3471                                'hide                                'hide
3472                                'preempt))                                'preempt))
3473    
# Line 3025  only after reaching the statement count Line 3476  only after reaching the statement count
3476  Returns nil if frame not found."  Returns nil if frame not found."
3477    (assoc frame idlwave-shell-bp-alist))    (assoc frame idlwave-shell-bp-alist))
3478    
3479    (defun idlwave-shell-find-current-bp ()
3480      "Find breakpoint here, or at halt location."
3481      (let ((bp (idlwave-shell-find-bp (idlwave-shell-current-frame))))
3482        (when (not bp)
3483          ;; Try moving to beginning of halted-at statement
3484          (save-excursion
3485            (idlwave-shell-goto-frame)
3486            (idlwave-beginning-of-statement)
3487            (setq bp (idlwave-shell-find-bp (idlwave-shell-current-frame))))
3488          (unless bp
3489            (beep)
3490            (message "Cannot identify breakpoint for this line")))
3491        bp))
3492    
3493  (defun idlwave-shell-new-bp (bp)  (defun idlwave-shell-new-bp (bp)
3494    "Find the new breakpoint in IDL's list and update with DATA.    "Find the new breakpoint in IDL's list and update with DATA.
3495  The actual line number for a breakpoint in IDL may be different than  The actual line number for a breakpoint in IDL may be different than
# Line 3052  considered the new breakpoint if the fil Line 3517  considered the new breakpoint if the fil
3517        (message "Failed to identify breakpoint in IDL"))))        (message "Failed to identify breakpoint in IDL"))))
3518    
3519  (defvar idlwave-shell-bp-overlays nil  (defvar idlwave-shell-bp-overlays nil
3520    "List of overlays marking breakpoints")    "Alist of overlays marking breakpoints")
3521    
3522  (defun idlwave-shell-update-bp-overlays ()  (defun idlwave-shell-update-bp-overlays ()
3523    "Update the overlays which mark breakpoints in the source code.    "Update the overlays which mark breakpoints in the source code.
3524  Existing overlays are recycled, in order to minimize consumption."  Existing overlays are recycled, in order to minimize consumption."
3525      ;(message "Updating Overlays")
3526    (when idlwave-shell-mark-breakpoints    (when idlwave-shell-mark-breakpoints
3527      (let ((bp-list idlwave-shell-bp-alist)      (let ((ov-alist (copy-alist idlwave-shell-bp-overlays))
3528            (ov-list idlwave-shell-bp-overlays)            (bp-list idlwave-shell-bp-alist)
3529            ov bp)            (use-glyph (and (memq idlwave-shell-mark-breakpoints '(t glyph))
3530                              idlwave-shell-bp-glyph))
3531              ov ov-list bp buf old-buffers win)
3532    
3533        ;; Delete the old overlays from their buffers        ;; Delete the old overlays from their buffers
3534        (while (setq ov (pop ov-list))        (if ov-alist
3535          (delete-overlay ov))            (while (setq ov-list (pop ov-alist))
3536        (setq ov-list idlwave-shell-bp-overlays              (while (setq ov (pop (cdr ov-list)))
3537              idlwave-shell-bp-overlays nil)                (add-to-list 'old-buffers (overlay-buffer ov))
3538                  (delete-overlay ov))))
3539          
3540          (setq ov-alist idlwave-shell-bp-overlays
3541                idlwave-shell-bp-overlays
3542                (if idlwave-shell-bp-glyph
3543                    (mapcar 'list (mapcar 'car idlwave-shell-bp-glyph))
3544                  (list (list 'bp))))
3545        (while (setq bp (pop bp-list))        (while (setq bp (pop bp-list))
3546          (save-excursion          (save-excursion
3547            (idlwave-shell-goto-frame (car bp))            (idlwave-shell-goto-frame (car bp))
3548            (let* ((end (progn (end-of-line 1) (point)))            (let* ((end (progn (end-of-line 1) (point)))
3549                   (beg (progn (beginning-of-line 1) (point)))                   (beg (progn (beginning-of-line 1) (point)))
3550                   (ov (or (pop ov-list)                   (condition (idlwave-shell-bp-get bp 'condition))
3551                           (idlwave-shell-make-new-bp-overlay))))                   (count (idlwave-shell-bp-get bp 'count))
3552                     (disabled (idlwave-shell-bp-get bp 'disabled))
3553                     (type (if idlwave-shell-bp-glyph
3554                               (cond
3555                                (condition 'bp-cond )
3556                                (count
3557                                 (cond
3558                                  ((<= count 0) 'bp)
3559                                  ((<= count 4)
3560                                   (intern
3561                                    (concat "bp-" (number-to-string count))))
3562                                  (t 'bp-n)))
3563                                (t 'bp))
3564                             'bp))
3565                     (help-list
3566                      (delq nil
3567                            (list
3568                             (if count
3569                                 (concat "n=" (int-to-string count)))
3570                             (if condition
3571                                 (concat "condition: " condition))
3572                             (if disabled "disabled"))))
3573                     (help-text (if help-list
3574                                    (mapconcat 'identity help-list ",")))
3575                     (full-type (if disabled
3576                                    (intern (concat (symbol-name type)
3577                                                    "-disabled"))
3578                                  type))
3579                     (ov-existing (assq full-type ov-alist))
3580                     (ov (or (and (cdr ov-existing)
3581                                  (pop (cdr ov-existing)))
3582                             (idlwave-shell-make-new-bp-overlay
3583                              type disabled help-text)))
3584                     match)
3585              (move-overlay ov beg end)              (move-overlay ov beg end)
3586              (push ov idlwave-shell-bp-overlays)))))))              (if (setq match (assq full-type idlwave-shell-bp-overlays))
3587                    (push ov (cdr match))
3588                  (nconc idlwave-shell-bp-overlays
3589                         (list (list full-type ov)))))
3590              ;; Take care of margins if using a glyph
3591              (when use-glyph
3592                (if old-buffers
3593                    (setq old-buffers (delq (current-buffer) old-buffers)))
3594                (if (fboundp 'set-specifier) ;; XEmacs
3595                    (set-specifier left-margin-width (cons (current-buffer) 2))
3596                  (setq left-margin-width 2))
3597                (if (setq win (get-buffer-window (current-buffer) t))
3598                    (set-window-buffer win (current-buffer))))))
3599          (if use-glyph
3600              (while (setq buf (pop old-buffers))
3601                (with-current-buffer buf
3602                  (if (fboundp 'set-specifier) ;; XEmacs
3603                      (set-specifier left-margin-width (cons (current-buffer) 0))
3604                    (setq left-margin-width 0))
3605                  (if (setq win (get-buffer-window buf t))
3606                      (set-window-buffer win buf))))))))
3607    
3608    
3609  (defvar idlwave-shell-bp-glyph)  (defvar idlwave-shell-bp-glyph)
3610  (defun idlwave-shell-make-new-bp-overlay ()  (defun idlwave-shell-make-new-bp-overlay (&optional type disabled help)
3611    "Make a new overlay for highlighting breakpoints.    "Make a new overlay for highlighting breakpoints.  
3612  This stuff is stringly dependant upon the version of Emacs."  
3613    (let ((ov (make-overlay 1 1)))  This stuff is strongly dependant upon the version of Emacs.  If TYPE
3614    is passed, make an overlay of that type ('bp or 'bp-cond, currently
3615    only for glyphs).  If HELP is set, use it to make a tooltip with that
3616    text popup."
3617      (let ((ov (make-overlay 1 1))
3618            (use-glyph (and (memq idlwave-shell-mark-breakpoints '(t glyph))
3619                            idlwave-shell-bp-glyph))
3620            (type (or type 'bp))
3621            (face (if disabled
3622                      idlwave-shell-disabled-breakpoint-face
3623                    idlwave-shell-breakpoint-face)))
3624      (if (featurep 'xemacs)      (if (featurep 'xemacs)
3625          ;; This is XEmacs          ;; This is XEmacs
3626          (progn          (progn
3627            (cond            (cond
3628               ;; tty's cannot display glyphs
3629             ((eq (console-type) 'tty)             ((eq (console-type) 'tty)
3630              ;; tty's cannot display glyphs              (set-extent-property ov 'face face))
3631              (set-extent-property ov 'face idlwave-shell-breakpoint-face))              
3632             ((and (memq idlwave-shell-mark-breakpoints '(t glyph))             ;; use the glyph
3633                   idlwave-shell-bp-glyph)             (use-glyph
3634              ;; use the glyph              (let ((glyph (cdr (assq type idlwave-shell-bp-glyph))))
3635              (set-extent-property ov 'begin-glyph idlwave-shell-bp-glyph))                (if disabled (setq glyph (car glyph)) (setq glyph (nth 1 glyph)))
3636                  (set-extent-property ov 'begin-glyph glyph)
3637                  (set-extent-property ov 'begin-glyph-layout 'outside-margin)))
3638    
3639               ;; use the face
3640             (idlwave-shell-mark-breakpoints             (idlwave-shell-mark-breakpoints
3641              ;; use the face              (set-extent-property ov 'face face))
3642              (set-extent-property ov 'face idlwave-shell-breakpoint-face))  
3643             (t             ;; no marking
3644              ;; no marking             (t nil))
             nil))  
3645            (set-extent-priority ov -1))  ; make stop line face prevail            (set-extent-priority ov -1))  ; make stop line face prevail
3646        ;; This is Emacs        ;; This is Emacs
3647        (cond        (cond
3648         (window-system         (window-system
3649          (if (and (memq idlwave-shell-mark-breakpoints '(t glyph))          (if use-glyph
3650                   idlwave-shell-bp-glyph)   ; this var knows if glyph's possible              (let ((image-props (cdr (assq type idlwave-shell-bp-glyph)))
3651              ;; use a glyph                    string)
3652              (let ((string "@"))                
3653                (put-text-property 0 1                (if disabled (setq image-props
3654                                   'display idlwave-shell-bp-glyph                                   (append image-props
3655                                   string)                                           (list :conversion 'disabled))))
3656                  (setq string
3657                       (propertize "@"
3658                                   'display
3659                                   (list (list 'margin 'left-margin)
3660                                         image-props)
3661                                   'mouse-face 'highlight
3662                                   'help-echo help))
3663                (overlay-put ov 'before-string string))                (overlay-put ov 'before-string string))
3664            (overlay-put ov 'face idlwave-shell-breakpoint-face)))            ;; just the face
3665              (overlay-put ov 'face face)))
3666    
3667           ;; use a face
3668         (idlwave-shell-mark-breakpoints         (idlwave-shell-mark-breakpoints
3669          ;; use a face          (overlay-put ov 'face face))
3670          (overlay-put ov 'face idlwave-shell-breakpoint-face))  
3671         (t         ;; No marking
3672          ;; No marking         (t nil)))
         nil)))  
3673      ov))      ov))
3674    
3675  (defun idlwave-shell-edit-default-command-line (arg)  (defun idlwave-shell-edit-default-command-line (arg)
# Line 3127  This stuff is stringly dependant upon th Line 3680  This stuff is stringly dependant upon th
3680    
3681  (defun idlwave-shell-execute-default-command-line (arg)  (defun idlwave-shell-execute-default-command-line (arg)
3682    "Execute a command line.  On first use, ask for the command.    "Execute a command line.  On first use, ask for the command.
3683  Also with prefix arg, ask for the command.  You can also uase the command  Also with prefix arg, ask for the command.  You can also use the command
3684  `idlwave-shell-edit-default-command-line' to edit the line."  `idlwave-shell-edit-default-command-line' to edit the line."
3685    (interactive "P")    (interactive "P")
3686    (if (or (not idlwave-shell-command-line-to-execute)    (cond
3687            arg)     ((equal arg '(16))
3688        (setq idlwave-shell-command-line-to-execute      (setq idlwave-shell-command-line-to-execute nil))
3689              (read-string "IDL> " idlwave-shell-command-line-to-execute)))     ((equal arg '(4))
3690        (setq idlwave-shell-command-line-to-execute
3691              (read-string "IDL> " idlwave-shell-command-line-to-execute))))
3692    (idlwave-shell-reset 'hidden)    (idlwave-shell-reset 'hidden)
3693    (idlwave-shell-send-command idlwave-shell-command-line-to-execute    (idlwave-shell-send-command
3694                                '(idlwave-shell-redisplay 'hide)))     (or idlwave-shell-command-line-to-execute
3695           (with-current-buffer (idlwave-shell-buffer)
3696             (ring-ref comint-input-ring 0)))
3697       '(idlwave-shell-redisplay 'hide)))
3698    
3699  (defun idlwave-shell-save-and-run ()  (defun idlwave-shell-save-and-run ()
3700    "Save file and run it in IDL.    "Save file and run it in IDL.
3701  Runs `save-buffer' and sends a '.RUN' command for the associated file to IDL.  Runs `save-buffer' and sends a '.RUN' command for the associated file to IDL.
3702  When called from the shell buffer, re-run the file which was last handled by  When called from the shell buffer, re-run the file which was last handled by
3703  one of the save-and-.. commands."  one of the save-and-.. commands."  
3704    (interactive)    (interactive)
3705    (idlwave-shell-save-and-action 'run))    (idlwave-shell-save-and-action 'run))
3706    
# Line 3158  one of the save-and-.. commands." Line 3716  one of the save-and-.. commands."
3716    "Save file and batch it in IDL.    "Save file and batch it in IDL.
3717  Runs `save-buffer' and sends a '@file' command for the associated file to IDL.  Runs `save-buffer' and sends a '@file' command for the associated file to IDL.
3718  When called from the shell buffer, re-batch the file which was last handled by  When called from the shell buffer, re-batch the file which was last handled by
3719  one of the save-and-.. commands."  one of the save-and-.. commands."  
3720    (interactive)    (interactive)
3721    (idlwave-shell-save-and-action 'batch))    (idlwave-shell-save-and-action 'batch))
3722    
# Line 3170  handled by this command." Line 3728  handled by this command."
3728    ;; Remove the stop overlay.    ;; Remove the stop overlay.
3729    (if idlwave-shell-stop-line-overlay    (if idlwave-shell-stop-line-overlay
3730        (delete-overlay idlwave-shell-stop-line-overlay))        (delete-overlay idlwave-shell-stop-line-overlay))
3731      (if idlwave-shell-is-stopped
3732          (idlwave-shell-electric-debug-all-off))
3733    (setq idlwave-shell-is-stopped nil)    (setq idlwave-shell-is-stopped nil)
3734    (setq overlay-arrow-string nil)    (setq overlay-arrow-string nil)
3735    (let (buf)    (let (buf)
# Line 3194  handled by this command." Line 3754  handled by this command."
3754                         (t (error "Unknown action %s" action)))                         (t (error "Unknown action %s" action)))
3755                   idlwave-shell-last-save-and-action-file)                   idlwave-shell-last-save-and-action-file)
3756           'idlwave-shell-maybe-update-routine-info           'idlwave-shell-maybe-update-routine-info
3757           (idlwave-shell-hide-p 'run))           (if (idlwave-shell-hide-p 'run) 'mostly) nil t)
3758          (idlwave-shell-bp-query))          (idlwave-shell-bp-query))
3759      (let ((msg (format "No such file %s"      (let ((msg (format "No such file %s"
3760                         idlwave-shell-last-save-and-action-file)))                         idlwave-shell-last-save-and-action-file)))
3761        (setq idlwave-shell-last-save-and-action-file nil)        (setq idlwave-shell-last-save-and-action-file nil)
3762        (error msg))))        (error msg))))
# Line 3208  handled by this command." Line 3768  handled by this command."
3768                 (memq 'compile-buffer idlwave-auto-routine-info-updates))                 (memq 'compile-buffer idlwave-auto-routine-info-updates))
3769             idlwave-query-shell-for-routine-info             idlwave-query-shell-for-routine-info
3770             idlwave-routines)             idlwave-routines)
3771        (idlwave-shell-update-routine-info t nil 'wait)))        (idlwave-shell-update-routine-info t nil wait)))
3772    
3773  (defvar idlwave-shell-sources-query "help,/source,/full"  (defvar idlwave-shell-sources-query "help,/source,/full"
3774    "IDL command to obtain source files for compiled procedures.")    "IDL command to obtain source files for compiled procedures.")
# Line 3222  Elements of the alist have the form: Line 3782  Elements of the alist have the form:
3782  (defun idlwave-shell-sources-query ()  (defun idlwave-shell-sources-query ()
3783    "Determine source files for IDL compiled procedures.    "Determine source files for IDL compiled procedures.
3784  Queries IDL using the string in `idlwave-shell-sources-query'."  Queries IDL using the string in `idlwave-shell-sources-query'."
3785    (interactive)  '  (interactive)
3786    (idlwave-shell-send-command idlwave-shell-sources-query    (idlwave-shell-send-command idlwave-shell-sources-query
3787                                'idlwave-shell-sources-filter                                'idlwave-shell-sources-filter
3788                                'hide))                                'hide))
3789    
3790  (defun idlwave-shell-sources-filter ()  (defun idlwave-shell-sources-filter ()
3791    "Get source files from `idlwave-shell-sources-query' output.    "Get source files from `idlwave-shell-sources-query' output.
3792  Create `idlwave-shell-sources-alist' consisting of  Create `idlwave-shell-sources-alist' consisting of
3793  list elements of the form:  list elements of the form:
3794   (module name . (source-file-truename idlwave-internal-filename))."   (module name . (source-file-truename idlwave-internal-filename))."
3795    (save-excursion    (save-excursion
# Line 3306  list elements of the form: Line 3866  list elements of the form:
3866      (save-excursion      (save-excursion
3867        (set-buffer idlwave-shell-error-buffer)        (set-buffer idlwave-shell-error-buffer)
3868        (goto-char idlwave-shell-error-last)        (goto-char idlwave-shell-error-last)
3869        (if (or (re-search-forward idlwave-shell-syntax-error nil t)        (if (or
3870                (re-search-forward idlwave-shell-other-error nil t))             (re-search-forward idlwave-shell-syntax-error nil t)
3871               (re-search-forward idlwave-shell-other-error nil t))
3872            (progn            (progn
3873              (setq frame              (setq frame
3874                    (list                    (list
3875                     (save-match-data                     (save-match-data
3876                       (idlwave-shell-file-name                       (idlwave-shell-file-name
3877                        (buffer-substring (match-beginning 1) (match-end 1))))                        (buffer-substring (match-beginning 1 )
3878                                            (match-end 1))))
3879                     (string-to-int                     (string-to-int
3880                      (buffer-substring (match-beginning 2)                      (buffer-substring (match-beginning 2)
3881                                        (match-end 2)))))                                        (match-end 2)))))
# Line 3326  list elements of the form: Line 3888  list elements of the form:
3888        (setq idlwave-shell-error-last (point)))        (setq idlwave-shell-error-last (point)))
3889      (if frame      (if frame
3890          (progn          (progn
3891            (idlwave-shell-display-line frame col))            (idlwave-shell-display-line frame col 'no-debug))
3892        (beep)        (beep)
3893        (message "No more errors."))))        (message "No more errors."))))
3894    
# Line 3340  Otherwise, just expand the file name." Line 3902  Otherwise, just expand the file name."
3902          (file-truename name def-dir)          (file-truename name def-dir)
3903        (expand-file-name name def-dir))))        (expand-file-name name def-dir))))
3904    
3905  ;; Keybindings --------------------------------------------------------------  ;; Keybindings ------------------------------------------------------------
3906    
3907  (defvar idlwave-shell-mode-map (copy-keymap comint-mode-map)  (defvar idlwave-shell-mode-map (copy-keymap comint-mode-map)
3908    "Keymap for idlwave-mode.")    "Keymap for idlwave-mode.")
3909    (defvar idlwave-shell-electric-debug-mode-map (make-sparse-keymap))
3910  (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap))  (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap))
3911  (fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map)  (fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map)
3912    (defvar idlwave-mode-prefix-map (make-sparse-keymap))
3913    (fset 'idlwave-mode-prefix-map idlwave-mode-prefix-map)
3914    
3915    (defun idlwave-shell-define-key-both (key hook)
3916      "Define a key in both the shell and buffer mode maps."
3917      (define-key idlwave-mode-map key hook)
3918      (define-key idlwave-shell-mode-map key hook))
3919    
3920  ;(define-key idlwave-shell-mode-map "\M-?" 'comint-dynamic-list-completions)  ;(define-key idlwave-shell-mode-map "\M-?" 'comint-dynamic-list-completions)
3921  ;(define-key idlwave-shell-mode-map "\t" 'comint-dynamic-complete)  ;(define-key idlwave-shell-mode-map "\t" 'comint-dynamic-complete)
# Line 3371  Otherwise, just expand the file name." Line 3941  Otherwise, just expand the file name."
3941    
3942  ;; The mouse bindings for PRINT and HELP  ;; The mouse bindings for PRINT and HELP
3943  (idlwave-shell-define-key-both  (idlwave-shell-define-key-both
3944   (if (featurep 'xemacs)   (if (featurep 'xemacs)
3945       [(shift button2)]       [(shift button2)]
3946     [(shift down-mouse-2)])     [(shift down-mouse-2)])
3947   'idlwave-shell-mouse-print)   'idlwave-shell-mouse-print)
3948  (idlwave-shell-define-key-both  (idlwave-shell-define-key-both
3949   (if (featurep 'xemacs)   (if (featurep 'xemacs)
3950       [(control meta button2)]       [(control meta button2)]
3951     [(control meta down-mouse-2)])     [(control meta down-mouse-2)])
3952    'idlwave-shell-mouse-help)    'idlwave-shell-mouse-help)
3953  (idlwave-shell-define-key-both  (idlwave-shell-define-key-both
# Line 3386  Otherwise, just expand the file name." Line 3956  Otherwise, just expand the file name."
3956     [(control shift down-mouse-2)])     [(control shift down-mouse-2)])
3957   'idlwave-shell-examine-select)   'idlwave-shell-examine-select)
3958  ;; Add this one from the idlwave-mode-map  ;; Add this one from the idlwave-mode-map
3959  (define-key idlwave-shell-mode-map  (define-key idlwave-shell-mode-map
3960    (if (featurep 'xemacs)    (if (featurep 'xemacs)
3961        [(shift button3)]        [(shift button3)]
3962      [(shift mouse-3)])      [(shift mouse-3)])
3963    'idlwave-mouse-context-help)    'idlwave-mouse-context-help)
3964    
3965  ;; For Emacs, we need to turn off the button release events.  ;; For Emacs, we need to turn off the button release events.
3966  (defun idlwave-shell-mouse-nop (event)  (defun idlwave-shell-mouse-nop (event)
3967    (interactive "e"))    (interactive "e"))
3968  (unless (featurep 'xemacs)  (unless (featurep 'xemacs)
3969    (idlwave-shell-define-key-both    (idlwave-shell-define-key-both
# Line 3403  Otherwise, just expand the file name." Line 3973  Otherwise, just expand the file name."
3973    (idlwave-shell-define-key-both    (idlwave-shell-define-key-both
3974     [(control meta mouse-2)] 'idlwave-shell-mouse-nop))     [(control meta mouse-2)] 'idlwave-shell-mouse-nop))
3975    
3976      
3977  ;; The following set of bindings is used to bind the debugging keys.  ;; The following set of bindings is used to bind the debugging keys.
3978  ;; If `idlwave-shell-activate-prefix-keybindings' is non-nil, the first key  ;; If `idlwave-shell-activate-prefix-keybindings' is non-nil, the
3979  ;; in the list gets bound the C-c C-d prefix map.  ;; first key in the list gets bound the C-c C-d prefix map.  If
3980  ;; If `idlwave-shell-debug-modifiers' is non-nil, the second key  ;; `idlwave-shell-debug-modifiers' is non-nil, the second key in the
3981  ;; in the list gets bound with the specified modifiers in both  ;; list gets bound with the specified modifiers in both
3982  ;; `idlwave-mode-map' and `idlwave-shell-mode-map'.  ;; `idlwave-mode-map' and `idlwave-shell-mode-map'.  The next list
3983    ;; item, if non-nil, means to bind this as a single key in the
3984  ;; Used keys:   abcdef hi klmnopqrs u wxyz  ;; electric-debug-mode-map.
3985  ;; Unused keys:       g  j         t v  ;;
3986    ;; [C-c C-d]-binding   debug-modifier-key command bind-electric-debug buf-only
3987    ;; Used keys:   abcdef hijklmnopqrstuvwxyz
3988    ;; Unused keys:       g            
3989  (let* ((specs  (let* ((specs
3990          '(([(control ?b)]   ?b   idlwave-shell-break-here)          '(([(control ?b)]   ?b   idlwave-shell-break-here t t)
3991            ([(control ?i)]   ?i   idlwave-shell-break-in)            ([(control ?i)]   ?i   idlwave-shell-break-in t t)
3992            ([(control ?d)]   ?d   idlwave-shell-clear-current-bp)            ([(control ?j)]   ?j   idlwave-shell-break-this-module t t)
3993            ([(control ?a)]   ?a   idlwave-shell-clear-all-bp)            ([(control ?d)]   ?d   idlwave-shell-clear-current-bp t)
3994            ([(control ?s)]   ?s   idlwave-shell-step)            ([(control ?a)]   ?a   idlwave-shell-clear-all-bp t)
3995            ([(control ?n)]   ?n   idlwave-shell-stepover)            ([(control ?\\)]  ?\\  idlwave-shell-toggle-enable-current-bp t)
3996            ([(control ?k)]   ?k   idlwave-shell-skip)            ([(control ?s)]   ?s   idlwave-shell-step t)
3997            ([(control ?u)]   ?u   idlwave-shell-up)            ([(control ?n)]   ?n   idlwave-shell-stepover t)
3998            ([(control ?o)]   ?o   idlwave-shell-out)            ([(control ?k)]   ?k   idlwave-shell-skip t)
3999            ([(control ?m)]   ?m   idlwave-shell-return)            ([(control ?u)]   ?u   idlwave-shell-up t)
4000            ([(control ?h)]   ?h   idlwave-shell-to-here)            ([(control ?o)]   ?o   idlwave-shell-out t)
4001            ([(control ?r)]   ?r   idlwave-shell-cont)            ([(control ?m)]   ?m   idlwave-shell-return t)
4002              ([(control ?h)]   ?h   idlwave-shell-to-here t t)
4003              ([(control ?r)]   ?r   idlwave-shell-cont t)
4004            ([(control ?y)]   ?y   idlwave-shell-execute-default-command-line)            ([(control ?y)]   ?y   idlwave-shell-execute-default-command-line)
4005            ([(control ?z)]   ?z   idlwave-shell-reset)            ([(control ?z)]   ?z   idlwave-shell-reset t)
4006            ([(control ?q)]   ?q   idlwave-shell-quit)            ([(control ?q)]   ?q   idlwave-shell-quit)
4007            ([(control ?p)]   ?p   idlwave-shell-print)            ([(control ?p)]   ?p   idlwave-shell-print t)
4008            ([(??)]           ??   idlwave-shell-help-expression)            ([(        ??)]   ??   idlwave-shell-help-expression t)
4009            ([(control ?c)]   ?c   idlwave-shell-save-and-run)            ([(control ?v)]   ?v   idlwave-shell-toggle-electric-debug-mode t t)
           ([(        ?@)]   ?@   idlwave-shell-save-and-batch)  
4010            ([(control ?x)]   ?x   idlwave-shell-goto-next-error)            ([(control ?x)]   ?x   idlwave-shell-goto-next-error)
4011              ([(control ?c)]   ?c   idlwave-shell-save-and-run t)
4012              ([(        ?@)]   ?@   idlwave-shell-save-and-batch)
4013            ([(control ?e)]   ?e   idlwave-shell-run-region)            ([(control ?e)]   ?e   idlwave-shell-run-region)
4014            ([(control ?w)]   ?w   idlwave-shell-resync-dirs)            ([(control ?w)]   ?w   idlwave-shell-resync-dirs)
4015            ([(control ?l)]   ?l   idlwave-shell-redisplay)            ([(control ?l)]   ?l   idlwave-shell-redisplay t)
4016            ([(control ?t)]   ?t   idlwave-shell-toggle-toolbar)            ([(control ?t)]   ?t   idlwave-shell-toggle-toolbar)
4017            ([(control up)]   up   idlwave-shell-stack-up)            ([(control up)]   up   idlwave-shell-stack-up)
4018            ([(control down)] down idlwave-shell-stack-down)            ([(control down)] down idlwave-shell-stack-down)
4019              ([(        ?[)]   ?[   idlwave-shell-goto-previous-bp t t)
4020              ([(        ?])]   ?]   idlwave-shell-goto-next-bp t t)
4021            ([(control ?f)]   ?f   idlwave-shell-window)))            ([(control ?f)]   ?f   idlwave-shell-window)))
4022         (mod (cond ((and idlwave-shell-debug-modifiers         (mod (cond ((and idlwave-shell-debug-modifiers
4023                          (listp idlwave-shell-debug-modifiers)                          (listp idlwave-shell-debug-modifiers)
# Line 3449  Otherwise, just expand the file name." Line 4027  Otherwise, just expand the file name."
4027                     '(alt))))                     '(alt))))
4028         (shift (memq 'shift mod))         (shift (memq 'shift mod))
4029         (mod-noshift (delete 'shift (copy-sequence mod)))         (mod-noshift (delete 'shift (copy-sequence mod)))
4030         s k1 c2 k2 cmd)         s k1 c2 k2 cmd cannotshift)
4031    (while (setq s (pop specs))    (while (setq s (pop specs))
4032      (setq k1  (nth 0 s)      (setq k1  (nth 0 s)
4033            c2  (nth 1 s)            c2  (nth 1 s)
4034            cmd (nth 2 s))            cmd (nth 2 s)
4035      (when idlwave-shell-activate-prefix-keybindings            electric (nth 3 s)
4036        (and k1 (define-key idlwave-shell-mode-prefix-map k1 cmd)))            only-buffer (nth 4 s)
4037              cannotshift (and shift (char-valid-p c2) (eq c2 (upcase c2))))
4038        
4039        ;; The regular prefix keymap.
4040        (when (and idlwave-shell-activate-prefix-keybindings k1)
4041          (unless only-buffer
4042            (define-key idlwave-shell-mode-prefix-map k1 cmd))
4043          (define-key idlwave-mode-prefix-map k1 cmd))
4044        ;; The debug modifier map
4045      (when (and mod window-system)      (when (and mod window-system)
4046        (if (char-or-string-p c2)        (if (char-or-string-p c2)
4047            (setq k2 (vector (append mod-noshift            (setq k2 (vector (append mod-noshift
4048                                     (list (if shift (upcase c2) c2)))))                                     (list (if shift (upcase c2) c2)))))
4049          (setq k2 (vector (append mod (list c2)))))          (setq k2 (vector (append mod (list c2)))))
4050        (define-key idlwave-mode-map       k2 cmd)        (unless cannotshift
4051        (define-key idlwave-shell-mode-map k2 cmd))))          (define-key idlwave-mode-map k2 cmd)
4052            (unless only-buffer (define-key idlwave-shell-mode-map k2 cmd))))
4053        ;; The electric debug single-keystroke map
4054        (if (and electric (char-or-string-p c2))
4055            (define-key idlwave-shell-electric-debug-mode-map (char-to-string c2)
4056              cmd))))
4057    
4058    ;; A few extras in the electric debug map
4059    (define-key idlwave-shell-electric-debug-mode-map " " 'idlwave-shell-step)
4060    (define-key idlwave-shell-electric-debug-mode-map "+" 'idlwave-shell-stack-up)
4061    (define-key idlwave-shell-electric-debug-mode-map "=" 'idlwave-shell-stack-up)
4062    (define-key idlwave-shell-electric-debug-mode-map "-"
4063      'idlwave-shell-stack-down)
4064    (define-key idlwave-shell-electric-debug-mode-map "_"
4065      'idlwave-shell-stack-down)
4066    (define-key idlwave-shell-electric-debug-mode-map "q" 'idlwave-shell-retall)
4067    (define-key idlwave-shell-electric-debug-mode-map "t"
4068      '(lambda () (interactive) (idlwave-shell-send-command "help,/TRACE")))
4069    (define-key idlwave-shell-electric-debug-mode-map [(control ??)]
4070      'idlwave-shell-electric-debug-help)
4071    (define-key idlwave-shell-electric-debug-mode-map "x"
4072      '(lambda (arg) (interactive "P")
4073         (idlwave-shell-print arg nil nil t)))
4074    
4075  ;; Enter the prefix map at the two places.  
4076  (fset 'idlwave-debug-map       idlwave-shell-mode-prefix-map)  ; Enter the prefix map in two places.
4077    (fset 'idlwave-debug-map       idlwave-mode-prefix-map)
4078  (fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map)  (fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map)
4079    
4080  ;; The Menus --------------------------------------------------------------  ;; The Electric Debug Minor Mode --------------------------------------------
4081    
4082    (defun idlwave-shell-toggle-electric-debug-mode ()
4083      "Toggle electric-debug-mode, suppressing re-entry into mode if turned off."
4084      (interactive)
4085      ;; If turning it off, make sure it stays off throughout the debug
4086      ;; session until we return or hit $MAIN$.  Cancel this suppression
4087      ;; if it's explicitly turned on.
4088      (if idlwave-shell-electric-debug-mode
4089          (setq idlwave-shell-suppress-electric-debug t)
4090        (setq idlwave-shell-suppress-electric-debug nil))
4091      (idlwave-shell-electric-debug-mode))
4092    
4093    (easy-mmode-define-minor-mode idlwave-shell-electric-debug-mode
4094      "Toggle Electric Debug mode.
4095    With no argument, this command toggles the mode.
4096    Non-null prefix argument turns on the mode.
4097    Null prefix argument turns off the mode.
4098    
4099    When Electric Debug mode is enabled, the many debugging commands are
4100    available as single key sequences."
4101    nil
4102    " *Debugging*"
4103    idlwave-shell-electric-debug-mode-map)
4104    
4105    (add-hook
4106     'idlwave-shell-electric-debug-mode-on-hook
4107     (lambda ()
4108       (set (make-local-variable 'idlwave-shell-electric-debug-read-only)
4109            buffer-read-only)
4110       (setq buffer-read-only t)
4111       (add-to-list 'idlwave-shell-electric-debug-buffers (current-buffer))
4112       (if idlwave-shell-stop-line-overlay
4113           (overlay-put idlwave-shell-stop-line-overlay 'face
4114                        idlwave-shell-electric-stop-line-face))
4115       (if (facep 'fringe)
4116           (set-face-foreground 'fringe idlwave-shell-electric-stop-color
4117                                (selected-frame)))))
4118    
4119    (add-hook
4120     'idlwave-shell-electric-debug-mode-off-hook
4121     (lambda ()
4122       ;; Return to previous read-only state
4123       (setq buffer-read-only (if (boundp 'idlwave-shell-electric-debug-read-only)
4124                                  idlwave-shell-electric-debug-read-only))
4125       (setq idlwave-shell-electric-debug-buffers
4126             (delq (current-buffer) idlwave-shell-electric-debug-buffers))
4127       (if idlwave-shell-stop-line-overlay
4128           (overlay-put idlwave-shell-stop-line-overlay 'face
4129                        idlwave-shell-stop-line-face)
4130         (if (facep 'fringe)
4131             (set-face-foreground 'fringe (face-foreground 'default))))))
4132    
4133    ;; easy-mmode defines electric-debug-mode for us, so we need to advise it.
4134    (defadvice idlwave-shell-electric-debug-mode (after print-enter activate)
4135      "Print out an entrance message"
4136      (when idlwave-shell-electric-debug-mode
4137        (message
4138         "Electric Debugging mode entered.  Press [C-?] for help, [q] to quit"))
4139      (force-mode-line-update))
4140    
4141    ;; Turn it off in all relevant buffers
4142    (defvar idlwave-shell-electric-debug-buffers nil)
4143    (defun idlwave-shell-electric-debug-all-off ()
4144      (setq idlwave-shell-suppress-electric-debug nil)
4145      (let ((buffers idlwave-shell-electric-debug-buffers)
4146            buf)
4147        (save-excursion
4148          (while (setq buf (pop buffers))
4149            (when (buffer-live-p buf)
4150              (set-buffer buf)
4151              (when (and (eq major-mode 'idlwave-mode)
4152                         buffer-file-name
4153                         idlwave-shell-electric-debug-mode)
4154                (idlwave-shell-electric-debug-mode))))))
4155      (setq idlwave-shell-electric-debug-buffers nil))
4156    
4157    ;; Show the help text
4158    (defun idlwave-shell-electric-debug-help ()
4159      (interactive)
4160      (with-output-to-temp-buffer "*IDLWAVE Electric Debug Help*"
4161        (princ idlwave-shell-electric-debug-help))
4162      (let* ((current-window (selected-window))
4163             (window (get-buffer-window "*IDLWAVE Electric Debug Help*"))
4164             (window-lines (window-height window)))
4165        (select-window window)
4166        (enlarge-window (1+ (- (count-lines 1 (point-max)) window-lines)))
4167        (select-window current-window)))
4168    
4169    
4170    ;; The Menus --------------------------------------------------------------
4171  (defvar idlwave-shell-menu-def  (defvar idlwave-shell-menu-def
4172    '("Debug"    `("Debug"
4173      ["Save and .RUN" idlwave-shell-save-and-run      ["Electric Debug Mode"
4174       (or (eq major-mode 'idlwave-mode)       idlwave-shell-electric-debug-mode
4175           idlwave-shell-last-save-and-action-file)]       :style toggle :selected idlwave-shell-electric-debug-mode
4176      ["Save and .COMPILE" idlwave-shell-save-and-compile       :included (eq major-mode 'idlwave-mode) :keys "C-c C-d C-v"]
      (or (eq major-mode 'idlwave-mode)  
          idlwave-shell-last-save-and-action-file)]  
     ["Save and @Batch" idlwave-shell-save-and-batch  
      (or (eq major-mode 'idlwave-mode)  
          idlwave-shell-last-save-and-action-file)]  
     ["Goto Next Error" idlwave-shell-goto-next-error t]  
     "--"  
     ["Execute Default Cmd" idlwave-shell-execute-default-command-line t]  
     ["Edit Default Cmd" idlwave-shell-edit-default-command-line t]  
     "--"  
     ["Set Breakpoint" idlwave-shell-break-here  
      (eq major-mode 'idlwave-mode)]  
     ["Break in Module" idlwave-shell-break-in t]  
     ["Clear Breakpoint" idlwave-shell-clear-current-bp t]  
     ["Clear All Breakpoints" idlwave-shell-clear-all-bp t]  
     ["List  All Breakpoints" idlwave-shell-list-all-bp t]  
     "--"  
     ["Step (into)" idlwave-shell-step t]  
     ["Step (over)" idlwave-shell-stepover t]  
     ["Skip One Statement" idlwave-shell-skip t]  
     ["Continue" idlwave-shell-cont t]  
     ("Continue to"  
      ["End of Block" idlwave-shell-up t]  
      ["End of Subprog" idlwave-shell-return t]  
      ["End of Subprog+1" idlwave-shell-out t]  
      ["Here (Cursor Line)" idlwave-shell-to-here  
       (eq major-mode 'idlwave-mode)])  
4177      "--"      "--"
     ["Print expression" idlwave-shell-print t]  
     ["Help on expression" idlwave-shell-help-expression t]  
     ["Evaluate Region" idlwave-shell-evaluate-region  
      (eq major-mode 'idlwave-mode)]  
     ["Run Region" idlwave-shell-run-region (eq major-mode 'idlwave-mode)]  
     "--"  
     ["Redisplay" idlwave-shell-redisplay t]  
     ["Stack Up" idlwave-shell-stack-up t]  
     ["Stack Down" idlwave-shell-stack-down t]  
     "--"  
     ["Update Working Dir" idlwave-shell-resync-dirs t]  
     ["Reset IDL" idlwave-shell-reset t]  
     "--"  
     ["Toggle Toolbar" idlwave-shell-toggle-toolbar t]  
     ["Exit IDL" idlwave-shell-quit t]))  
   
 (setq idlwave-shell-menu-def  
   '("Debug"  
4178      ("Compile & Run"      ("Compile & Run"
4179       ["Save and .RUN" idlwave-shell-save-and-run       ["Save and .RUN" idlwave-shell-save-and-run
4180        (or (eq major-mode 'idlwave-mode)        (or (eq major-mode 'idlwave-mode)
# Line 3532  Otherwise, just expand the file name." Line 4185  Otherwise, just expand the file name."
4185       ["Save and @Batch" idlwave-shell-save-and-batch       ["Save and @Batch" idlwave-shell-save-and-batch
4186        (or (eq major-mode 'idlwave-mode)        (or (eq major-mode 'idlwave-mode)
4187            idlwave-shell-last-save-and-action-file)]            idlwave-shell-last-save-and-action-file)]
4188         "--"
4189       ["Goto Next Error" idlwave-shell-goto-next-error t]       ["Goto Next Error" idlwave-shell-goto-next-error t]
4190       "--"       "--"
4191       ["Run Region" idlwave-shell-run-region (eq major-mode 'idlwave-mode)]       ["Compile and Run Region" idlwave-shell-run-region
4192          (eq major-mode 'idlwave-mode)]
4193         ["Evaluate Region" idlwave-shell-evaluate-region
4194          (eq major-mode 'idlwave-mode)]
4195       "--"       "--"
4196       ["Execute Default Cmd" idlwave-shell-execute-default-command-line t]       ["Execute Default Cmd" idlwave-shell-execute-default-command-line t]
4197       ["Edit Default Cmd" idlwave-shell-edit-default-command-line t])       ["Edit Default Cmd" idlwave-shell-edit-default-command-line t])
4198      ("Breakpoints"      ("Breakpoints"
4199       ["Set Breakpoint" idlwave-shell-break-here       ["Set Breakpoint" idlwave-shell-break-here
4200        (eq major-mode 'idlwave-mode)]        :keys "C-c C-d C-c" :active (eq major-mode 'idlwave-mode)]
4201       ["Break in Module" idlwave-shell-break-in t]       ("Set Special Breakpoint"
4202          ["Set After Count Breakpoint"
4203           (progn
4204            (let ((count (string-to-int (read-string "Break after count: "))))
4205                  (if (integerp count) (idlwave-shell-break-here count))))
4206           :active (eq major-mode 'idlwave-mode)]
4207          ["Set Condition Breakpoint"
4208           (idlwave-shell-break-here '(4))
4209           :active (eq major-mode 'idlwave-mode)])
4210         ["Break in Module" idlwave-shell-break-in
4211          :keys "C-c C-d C-i" :active (eq major-mode 'idlwave-mode)]
4212         ["Break in this Module" idlwave-shell-break-this-module
4213          :keys "C-c C-d C-j" :active (eq major-mode 'idlwave-mode)]
4214       ["Clear Breakpoint" idlwave-shell-clear-current-bp t]       ["Clear Breakpoint" idlwave-shell-clear-current-bp t]
4215       ["Clear All Breakpoints" idlwave-shell-clear-all-bp t]       ["Clear All Breakpoints" idlwave-shell-clear-all-bp t]
4216       ["List  All Breakpoints" idlwave-shell-list-all-bp t])       ["Disable/Enable Breakpoint" idlwave-shell-toggle-enable-current-bp t]
4217         ["Goto Previous Breakpoint" idlwave-shell-goto-previous-bp
4218          :keys "C-c C-d [" :active (eq major-mode 'idlwave-mode)]
4219         ["Goto Next Breakpoint" idlwave-shell-goto-next-bp
4220          :keys "C-c C-d ]" :active (eq major-mode 'idlwave-mode)]
4221         ["List All Breakpoints" idlwave-shell-list-all-bp t]
4222         ["Resync Breakpoints" idlwave-shell-bp-query t])
4223      ("Continue/Step"      ("Continue/Step"
4224       ["Step (into)" idlwave-shell-step t]       ["Step (into)" idlwave-shell-step t]
4225       ["Step (over)" idlwave-shell-stepover t]       ["Step (over)" idlwave-shell-stepover t]
# Line 3554  Otherwise, just expand the file name." Line 4229  Otherwise, just expand the file name."
4229       ["... to End of Subprog" idlwave-shell-return t]       ["... to End of Subprog" idlwave-shell-return t]
4230       ["... to End of Subprog+1" idlwave-shell-out t]       ["... to End of Subprog+1" idlwave-shell-out t]
4231       ["... to Here (Cursor Line)" idlwave-shell-to-here       ["... to Here (Cursor Line)" idlwave-shell-to-here
4232        (eq major-mode 'idlwave-mode)])        :keys "C-c C-d C-h" :active (eq major-mode 'idlwave-mode)])
4233      ("Print Expression"      ("Examine Expressions"
4234       ["Print expression" idlwave-shell-print t]       ["Print expression" idlwave-shell-print t]
4235       ["Help on expression" idlwave-shell-help-expression t]       ["Help on expression" idlwave-shell-help-expression t]
4236       ["Evaluate Region" idlwave-shell-evaluate-region       ("Examine nearby expression with"
4237        (eq major-mode 'idlwave-mode)]        ,@(mapcar (lambda(x)
4238       "--"                    `[ ,(car x) (idlwave-shell-print nil ',x) t ])
4239       ["Redisplay" idlwave-shell-redisplay t]                  idlwave-shell-examine-alist))
4240         ("Examine region with"
4241          ,@(mapcar (lambda(x)
4242                      `[ ,(car x) (idlwave-shell-print '(4) ',x) t ])
4243                    idlwave-shell-examine-alist)))
4244        ("Call Stack"
4245       ["Stack Up" idlwave-shell-stack-up t]       ["Stack Up" idlwave-shell-stack-up t]
4246       ["Stack Down" idlwave-shell-stack-down t])       ["Stack Down" idlwave-shell-stack-down t]
4247         "--"
4248         ["Redisplay and Sync" idlwave-shell-redisplay t])
4249        ("Show Commands"
4250         ["Everything" (if (eq idlwave-shell-show-commands 'everything)
4251                           (progn
4252                             (setq idlwave-shell-show-commands
4253                                   (get 'idlwave-shell-show-commands 'last-val))
4254                             (put 'idlwave-shell-show-commands 'last-val nil))
4255                         (put 'idlwave-shell-show-commands 'last-val
4256                              idlwave-shell-show-commands)
4257                         (setq idlwave-shell-show-commands 'everything))
4258          :style toggle :selected (and (not (listp idlwave-shell-show-commands))
4259                                       (eq idlwave-shell-show-commands
4260                                           'everything))]
4261         "--"
4262         ["Compiling Commands" (idlwave-shell-add-or-remove-show 'run)
4263          :style toggle
4264          :selected (not (idlwave-shell-hide-p
4265                          'run
4266                          (get 'idlwave-shell-show-commands 'last-val)))
4267          :active (not (eq idlwave-shell-show-commands 'everything))]
4268         ["Breakpoint Commands" (idlwave-shell-add-or-remove-show 'breakpoint)
4269          :style toggle
4270          :selected (not (idlwave-shell-hide-p
4271                          'breakpoint
4272                          (get 'idlwave-shell-show-commands 'last-val)))
4273          :active (not (eq idlwave-shell-show-commands 'everything))]
4274         ["Debug Commands" (idlwave-shell-add-or-remove-show 'debug)
4275          :style toggle
4276          :selected (not (idlwave-shell-hide-p
4277                          'debug
4278                          (get 'idlwave-shell-show-commands 'last-val)))
4279          :active (not (eq idlwave-shell-show-commands 'everything))]
4280         ["Miscellaneous Commands" (idlwave-shell-add-or-remove-show 'misc)
4281          :style toggle
4282          :selected (not (idlwave-shell-hide-p
4283                          'misc
4284                          (get 'idlwave-shell-show-commands 'last-val)))
4285          :active (not (eq idlwave-shell-show-commands 'everything))])
4286      ("Input Mode"      ("Input Mode"
4287       ["Send one char" idlwave-shell-send-char t]       ["Send one char" idlwave-shell-send-char t]
4288       ["Temporary Character Mode" idlwave-shell-char-mode-loop t]       ["Temporary Character Mode" idlwave-shell-char-mode-loop t]
# Line 3574  Otherwise, just expand the file name." Line 4293  Otherwise, just expand the file name."
4293        :style toggle :selected idlwave-shell-use-input-mode-magic])        :style toggle :selected idlwave-shell-use-input-mode-magic])
4294      "--"      "--"
4295      ["Update Working Dir" idlwave-shell-resync-dirs t]      ["Update Working Dir" idlwave-shell-resync-dirs t]
4296        ["Save Path Info"
4297         (idlwave-shell-send-command idlwave-shell-path-query
4298                                     'idlwave-shell-get-path-info
4299                                     'hide)
4300         t]
4301      ["Reset IDL" idlwave-shell-reset t]      ["Reset IDL" idlwave-shell-reset t]
4302      "--"      "--"
4303      ["Toggle Toolbar" idlwave-shell-toggle-toolbar t]      ["Toggle Toolbar" idlwave-shell-toggle-toolbar t]
# Line 3581  Otherwise, just expand the file name." Line 4305  Otherwise, just expand the file name."
4305    
4306  (if (or (featurep 'easymenu) (load "easymenu" t))  (if (or (featurep 'easymenu) (load "easymenu" t))
4307      (progn      (progn
4308        (easy-menu-define        (easy-menu-define
4309         idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"         idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"
4310         idlwave-shell-menu-def)         idlwave-shell-menu-def)
4311        (easy-menu-define        (easy-menu-define
4312         idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"         idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"
4313         idlwave-shell-menu-def)         idlwave-shell-menu-def)
4314        (save-excursion        (save-excursion
4315          (mapcar (lambda (buf)          (mapcar (lambda (buf)
# Line 3599  Otherwise, just expand the file name." Line 4323  Otherwise, just expand the file name."
4323  ;; The Breakpoint Glyph -------------------------------------------------------  ;; The Breakpoint Glyph -------------------------------------------------------
4324    
4325  (defvar idlwave-shell-bp-glyph nil  (defvar idlwave-shell-bp-glyph nil
4326    "The glyph to mark breakpoint lines in the source code.")    "The glyphs to mark breakpoint lines in the source code.")
4327    
4328  (let ((image-string "/* XPM */  (let ((image-alist
4329           '((bp . "/* XPM */
4330  static char * file[] = {  static char * file[] = {
4331  \"14 12 3 1\",  \"14 12 3 1\",
4332  \"      c None s backgroundColor\",  \"      c None s backgroundColor\",
4333  \".     c #4B4B4B4B4B4B\",  \".     c #4B4B4B4B4B4B\",
4334  \"R     c #FFFF00000000\",  \"R     c #FFFF00000000\",
4335  \"              \",  \"              \",
4336    \"     ....     \",
4337    \"    .RRRR.    \",
4338    \"   .RRRRRR.   \",
4339    \"  .RRRRRRRR.  \",
4340    \"  .RRRRRRRR.  \",
4341    \"  .RRRRRRRR.  \",
4342    \"  .RRRRRRRR.  \",
4343    \"   .RRRRRR.   \",
4344    \"    .RRRR.    \",
4345    \"     ....     \",
4346    \"              \"};")
4347             (bp-cond . "/* XPM */
4348    static char * file[] = {
4349    \"14 12 4 1\",
4350    \"      c None s backgroundColor\",
4351    \".     c #4B4B4B4B4B4B\",
4352    \"R     c #FFFF00000000\",
4353    \"B     c #000000000000\",
4354    \"              \",
4355    \"     ....     \",
4356    \"    .RRRR.    \",
4357    \"   .RRRRRR.   \",
4358    \"  .RRRRRRRR.  \",
4359    \"  .RRBBBBRR.  \",
4360    \"  .RRRRRRRR.  \",
4361    \"  .RRBBBBRR.  \",
4362    \"   .RRRRRR.   \",
4363    \"    .RRRR.    \",
4364    \"     ....     \",
4365    \"              \"};")
4366             (bp-1 . "/* XPM */
4367    static char * file[] = {
4368    \"14 12 4 1\",
4369    \"      c None s backgroundColor\",
4370    \".     c #4B4B4B4B4B4B\",
4371    \"X     c #FFFF00000000\",
4372    \"o     c #000000000000\",
4373  \"              \",  \"              \",
4374  \"    RRRR      \",  \"     ....     \",
4375  \"   RRRRRR     \",  \"    .XXXX.    \",
4376  \"  RRRRRRRR    \",  \"   .XXooXX.   \",
4377  \"  RRRRRRRR    \",  \"  .XXoooXXX.  \",
4378  \"  RRRRRRRR    \",  \"  .XXXooXXX.  \",
4379  \"  RRRRRRRR    \",  \"  .XXXooXXX.  \",
4380  \"   RRRRRR     \",  \"  .XXooooXX.  \",
4381  \"    RRRR      \",  \"   .XooooX.   \",
4382    \"    .XXXX.    \",
4383    \"     ....     \",
4384    \"              \"};")
4385             (bp-2 . "/* XPM */
4386    static char * file[] = {
4387    \"14 12 4 1\",
4388    \"      c None s backgroundColor\",
4389    \".     c #4B4B4B4B4B4B\",
4390    \"X     c #FFFF00000000\",
4391    \"o     c #000000000000\",
4392  \"              \",  \"              \",
4393  \"              \"};"))  \"     ....     \",
4394    \"    .XXXX.    \",
4395    (setq idlwave-shell-bp-glyph  \"   .XoooXX.   \",
4396          (cond ((and (featurep 'xemacs)  \"  .XXoXooXX.  \",
4397                      (featurep 'xpm))  \"  .XXXXooXX.  \",
4398                 (make-glyph image-string))  \"  .XXXooXXX.  \",
4399                ((and (not (featurep 'xemacs))  \"  .XXooXXXX.  \",
4400                      (fboundp 'image-type-available-p)  \"   .XooooX.   \",
4401                      (image-type-available-p 'xpm))  \"    .XXXX.    \",
4402                 (list 'image :type 'xpm :data image-string :ascent 'center))  \"     ....     \",
4403                (t nil))))  \"              \"};")
4404             (bp-3 . "/* XPM */
4405    static char * file[] = {
4406    \"14 12 4 1\",
4407    \"      c None s backgroundColor\",
4408    \".     c #4B4B4B4B4B4B\",
4409    \"X     c #FFFF00000000\",
4410    \"o     c #000000000000\",
4411    \"              \",
4412    \"     ....     \",
4413    \"    .XXXX.    \",
4414    \"   .XoooXX.   \",
4415    \"  .XXXXooXX.  \",
4416    \"  .XXXooXXX.  \",
4417    \"  .XXXXooXX.  \",
4418    \"  .XXoXooXX.  \",
4419    \"   .XoooXX.   \",
4420    \"    .XXXX.    \",
4421    \"     ....     \",
4422    \"              \"};")
4423             (bp-4 . "/* XPM */
4424    static char * file[] = {
4425    \"14 12 4 1\",
4426    \"      c None s backgroundColor\",
4427    \".     c #4B4B4B4B4B4B\",
4428    \"X     c #FFFF00000000\",
4429    \"o     c #000000000000\",
4430    \"              \",
4431    \"     ....     \",
4432    \"    .XXXX.    \",
4433    \"   .XoXXoX.   \",
4434    \"  .XXoXXoXX.  \",
4435    \"  .XXooooXX.  \",
4436    \"  .XXXXooXX.  \",
4437    \"  .XXXXooXX.  \",
4438    \"   .XXXooX.   \",
4439    \"    .XXXX.    \",
4440    \"     ....     \",
4441    \"              \"};")
4442             (bp-n . "/* XPM */
4443    static char * file[] = {
4444    \"14 12 4 1\",
4445    \"      c None s backgroundColor\",
4446    \".     c #4B4B4B4B4B4B\",
4447    \"X     c #FFFF00000000\",
4448    \"o     c #000000000000\",
4449    \"              \",
4450    \"     ....     \",
4451    \"    .XXXX.    \",
4452    \"   .XXXXXX.   \",
4453    \"  .XXoXoXXX.  \",
4454    \"  .XXooXoXX.  \",
4455    \"  .XXoXXoXX.  \",
4456    \"  .XXoXXoXX.  \",
4457    \"   .XoXXoX.   \",
4458    \"    .XXXX.    \",
4459    \"     ....     \",
4460    \"              \"};"))) im-cons im)
4461      
4462      (while (setq im-cons (pop image-alist))
4463        (setq im (cond ((and (featurep 'xemacs)
4464                             (featurep 'xpm))
4465                        (list
4466                         (let ((data (cdr im-cons)))
4467                           (string-match "#FFFF00000000" data)
4468                           (setq data (replace-match "#8F8F8F8F8F8F" t t data))
4469                           (make-glyph data))
4470                         (make-glyph (cdr im-cons))))
4471                       ((and (not (featurep 'xemacs))
4472                             (fboundp 'image-type-available-p)
4473                             (image-type-available-p 'xpm))
4474                        (list 'image :type 'xpm :data (cdr im-cons)
4475                              :ascent 'center))
4476                       (t nil)))
4477        (if im (push (cons (car im-cons) im) idlwave-shell-bp-glyph))))
4478    
4479  (provide 'idlw-shell)  (provide 'idlw-shell)
4480  (provide 'idlwave-shell)  (provide 'idlwave-shell)
4481    
4482  ;;; Load the toolbar when wanted by the user.  ;;; Load the toolbar when wanted by the user.
4483    
4484  (autoload 'idlwave-toolbar-toggle "idlw-toolbar"  (autoload 'idlwave-toolbar-toggle "idlw-toolbar"
4485    "Toggle the IDLWAVE toolbar")    "Toggle the IDLWAVE toolbar")
4486  (autoload 'idlwave-toolbar-add-everywhere "idlw-toolbar"  (autoload 'idlwave-toolbar-add-everywhere "idlw-toolbar"
4487    "Add IDLWAVE toolbar")    "Add IDLWAVE toolbar")
# Line 3647  static char * file[] = { Line 4493  static char * file[] = {
4493  (if idlwave-shell-use-toolbar  (if idlwave-shell-use-toolbar
4494      (add-hook 'idlwave-shell-mode-hook 'idlwave-toolbar-add-everywhere))      (add-hook 'idlwave-shell-mode-hook 'idlwave-toolbar-add-everywhere))
4495    
4496  ;;; arch-tag: 20c2e8ce-0709-41d8-a5b6-bb039148440a  ;; arch-tag: 20c2e8ce-0709-41d8-a5b6-bb039148440a
4497  ;;; idlw-shell.el ends here  ;;; idlw-shell.el ends here

Legend:
Removed from v.3.15.2.6  
changed lines
  Added in v.3.15.2.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26