X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5e72c6b20edf9a6ea3316f9d71a4fdda34654381..bdaf8a62d53cf8d5a0dc4f0dc530ecd6fc1f44fe:/lisp/progmodes/idlw-shell.el diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index bd1e9b5518..f903d49056 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1,18 +1,20 @@ ;; idlw-shell.el --- run IDL as an inferior process of Emacs. -;; Copyright (c) 1999, 2000, 2001 Free Software Foundation -;; Author: Carsten Dominik -;; Chris Chase +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 +;; Free Software Foundation, Inc. + +;; Authors: J.D. Smith +;; Carsten Dominik +;; Chris Chase ;; Maintainer: J.D. Smith -;; Version: 4.14 -;; Date: $Date: 2002/06/14 19:05:30 $ +;; Version: 6.1_em22 ;; Keywords: processes ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -22,15 +24,15 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; ;; This mode is for IDL version 5 or later. It should work on ;; Emacs>20.3 or XEmacs>20.4. ;; -;; Runs IDL as an inferior process of Emacs, much like the emacs +;; Runs IDL as an inferior process of Emacs, much like the Emacs ;; `shell' or `telnet' commands. Provides command history and ;; searching. Provides debugging commands available in buffers ;; visiting IDL procedure files, e.g., breakpoint setting, stepping, @@ -72,12 +74,6 @@ ;; KNOWN PROBLEMS ;; ============== ;; -;; I don't plan on implementing directory tracking by watching the IDL -;; commands entered at the prompt, since too often an IDL procedure -;; will change the current directory. If you want the idl process -;; buffer to match the IDL current working just execute `M-x -;; idlwave-shell-resync-dirs' (bound to "\C-c\C-d\C-w" by default.) -;; ;; Under XEmacs the Debug menu in the shell does not display the ;; keybindings in the prefix map. There bindings are available anyway - so ;; it is a bug in XEmacs. @@ -117,16 +113,18 @@ ;;; Customizations: idlwave-shell group +;; General/Misc. customizations (defgroup idlwave-shell-general-setup nil "General setup of the Shell interaction for IDLWAVE/Shell." :prefix "idlwave-shell" :group 'idlwave) -(defcustom idlwave-shell-prompt-pattern "^ ?IDL> " +(defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> " "*Regexp to match IDL prompt at beginning of a line. -For example, \"^IDL> \" or \"^WAVE> \". -The \"^\" means beginning of line. -This variable is used to initialise `comint-prompt-regexp' in the +For example, \"^\r?IDL> \" or \"^\r?WAVE> \". +The \"^\r?\" is needed, to indicate the beginning of the line, with +optional return character (which IDL seems to output randomly). +This variable is used to initialize `comint-prompt-regexp' in the process buffer. This is a fine thing to set in your `.emacs' file." @@ -141,29 +139,11 @@ process output is made by surrounding this name with `*'s." ;; (defcustom idlwave-shell-automatic-start...) See idlwave.el -(defcustom idlwave-shell-initial-commands "!more=0" - "Initial commands, separated by newlines, to send to IDL. -This string is sent to the IDL process by `idlwave-shell-mode' which is -invoked by `idlwave-shell'." - :group 'idlwave-shell-general-setup - :type 'string) - -(defcustom idlwave-shell-save-command-history t - "Non-nil means preserve command history between sessions. -The file `idlwave-shell-command-history-file' is used to save and restore -the history." +(defcustom idlwave-shell-use-dedicated-window nil + "*Non-nil means, never replace the shell frame with another buffer." :group 'idlwave-shell-general-setup - :type 'boolean) + :type 'boolean) -(defcustom idlwave-shell-command-history-file "~/.idlwhist" - "The file in which the command history of the idlwave shell is saved. -In order to change the size of the history, see the variable -`comint-input-ring-size'. -The history is only saved if the variable `idlwave-shell-save-command-history' -is non-nil." - :group 'idlwave-shell-general-setup - :type 'file) - (defcustom idlwave-shell-use-dedicated-frame nil "*Non-nil means, IDLWAVE should use a special frame to display shell buffer." :group 'idlwave-shell-general-setup @@ -198,19 +178,6 @@ t Arrows force the cursor back to the current command line and (const :tag "in command line only" cmdline))) ;; FIXME: add comint-input-ring-size? -(defcustom idlwave-shell-comint-settings - '((comint-scroll-to-bottom-on-input . t) - (comint-scroll-to-bottom-on-output . nil) - (comint-scroll-show-maximum-output . t) - ) - "Alist of special settings for the comint variables in the IDLWAVE Shell. -Each entry is a cons cell with the name of a variable and a value. -The function `idlwave-shell-mode' will make local variables out of each entry. -Changes to this variable will only be active when the shell buffer is -newly created." - :group 'idlwave-shell-general-setup - :type '(repeat - (cons variable sexp))) (defcustom idlwave-shell-use-toolbar t "*Non-nil means, use the debugging toolbar in all IDL related buffers. @@ -250,6 +217,24 @@ So by default setting a breakpoint will be on C-c C-d C-b." :group 'idlwave-shell-general-setup :type 'boolean) +(defcustom idlwave-shell-automatic-electric-debug 'breakpoint + "Enter the electric-debug minor mode automatically. +This occurs at a breakpoint or any other halt. The mode is exited +upon return to the main level. Can be set to 'breakpoint to enter +electric debug mode only when breakpoints are tripped." + :group 'idlwave-shell-general-setup + :type '(choice + (const :tag "never" nil) + (const :tag "always" t) + (const :tag "for breakpoints only" breakpoint))) + +(defcustom idlwave-shell-electric-zap-to-file t + "When entering electric debug mode, select the window displaying the +file at which point is stopped. This takes point away from the shell +window, but is useful for stepping, etc." + :group 'idlwave-shell-general-setup + :type 'boolean) + ;; (defcustom idlwave-shell-debug-modifiers... See idlwave.el (defvar idlwave-shell-activate-alt-keybindings nil @@ -268,7 +253,7 @@ to set this option to nil." :group 'idlwave-shell-general-setup :type 'boolean) -(defcustom idlwave-shell-file-name-chars "~/A-Za-z0-9+@:_.$#%={}\\-" +(defcustom idlwave-shell-file-name-chars "~/A-Za-z0-9+:_.$#%={}\\- " "The characters allowed in file names, as a string. Used for file name completion. Must not contain `'', `,' and `\"' because these are used as separators by IDL." @@ -280,11 +265,69 @@ because these are used as separators by IDL." :group 'idlwave-shell-general-setup :type 'hook) -(defvar idlwave-shell-print-expression-function nil - "*OBSOLETE VARIABLE, is no longer used.") +(defcustom idlwave-shell-graphics-window-size '(500 400) + "Size of IDL graphics windows popped up by special IDLWAVE command. +The command is `C-c C-d C-f' and accepts as a prefix the window nr. +A command like `WINDOW,N,xsize=XX,ysize=YY' is sent to IDL." + :group 'idlwave-shell-general-setup + :type '(list + (integer :tag "x size") + (integer :tag "y size"))) + + +;; Commands Sent to Shell... etc. +(defgroup idlwave-shell-command-setup nil + "Setup for command parameters of the Shell interaction for IDLWAVE." + :prefix "idlwave-shell" + :group 'idlwave) + +(defcustom idlwave-shell-initial-commands "!more=0 & defsysv,'!ERROR_STATE',EXISTS=__e & if __e then begin & !ERROR_STATE.MSG_PREFIX=\"% \" & delvar,__e & endif" + "Initial commands, separated by newlines, to send to IDL. +This string is sent to the IDL process by `idlwave-shell-mode' which is +invoked by `idlwave-shell'." + :group 'idlwave-shell-command-setup + :type 'string) + +(defcustom idlwave-shell-save-command-history t + "Non-nil means preserve command history between sessions. +The file `idlwave-shell-command-history-file' is used to save and restore +the history." + :group 'idlwave-shell-command-setup + :type 'boolean) + +(defcustom idlwave-shell-command-history-file "idlwhist" + "The file in which the command history of the idlwave shell is saved. +In order to change the size of the history, see the variable +`comint-input-ring-size'. +The history is only saved if the variable `idlwave-shell-save-command-history' +is non-nil." + :group 'idlwave-shell-command-setup + :type 'file) + +(defcustom idlwave-shell-show-commands + '(run misc breakpoint) + "*A list of command types to show output from in the shell. +Possibilities are 'run, 'debug, 'breakpoint, and 'misc. Unselected +types are not displayed in the shell. The type 'everything causes all +the copious shell traffic to be displayed." + :group 'idlwave-shell-command-setup + :type '(choice + (const everything) + (set :tag "Checklist" :greedy t + (const :tag "All .run and .compile commands" run) + (const :tag "All breakpoint commands" breakpoint) + (const :tag "All debug and stepping commands" debug) + (const :tag "Close, window, retall, etc. commands" misc)))) + +(defcustom idlwave-shell-max-print-length 200 + "Maximum number of array elements to print when examining." + :group 'idlwave-shell-command-setup + :type 'integer) (defcustom idlwave-shell-examine-alist - '(("Print" . "print,___") + `(("Print" . ,(concat "idlwave_print_safe,___," + (number-to-string + idlwave-shell-max-print-length))) ("Help" . "help,___") ("Structure Help" . "help,___,/STRUCTURE") ("Dimensions" . "print,size(___,/DIMENSIONS)") @@ -292,6 +335,7 @@ because these are used as separators by IDL." ("N_Elements" . "print,n_elements(___)") ("All Size Info" . "help,(__IWsz__=size(___,/STRUCTURE)),/STRUCTURE & print,__IWsz__.DIMENSIONS") ("Ptr Valid" . "print,ptr_valid(___)") + ("Arg Present" . "print,arg_present(___)") ("Widget Valid" . "print,widget_info(___,/VALID)") ("Widget Geometry" . "help,widget_info(___,/GEOMETRY)")) "Alist of special examine commands for popup selection. @@ -299,31 +343,54 @@ The keys are used in the selection popup created by `idlwave-shell-examine-select', and the corresponding value is sent as a command to the shell, with special sequence `___' replaced by the expression being examined." - :group 'idlwave-shell-general-setup + :group 'idlwave-shell-command-setup :type '(repeat (cons (string :tag "Label ") (string :tag "Command")))) +(defvar idlwave-shell-print-expression-function nil + "*OBSOLETE VARIABLE, is no longer used.") + (defcustom idlwave-shell-separate-examine-output t "*Non-nil mean, put output of examine commands in their own buffer." - :group 'idlwave-shell-general-setup + :group 'idlwave-shell-command-setup :type 'boolean) +(defcustom idlwave-shell-comint-settings + '((comint-scroll-to-bottom-on-input . t) + (comint-scroll-to-bottom-on-output . t) + (comint-scroll-show-maximum-output . nil) + (comint-prompt-read-only . t)) + + "Alist of special settings for the comint variables in the IDLWAVE Shell. +Each entry is a cons cell with the name of a variable and a value. +The function `idlwave-shell-mode' will make local variables out of each entry. +Changes to this variable will only be active when the shell buffer is +newly created." + :group 'idlwave-shell-command-setup + :type '(repeat + (cons variable sexp))) + +(defcustom idlwave-shell-query-for-class t + "*Non-nil means query the shell for object class on object completions." + :group 'idlwave-shell-command-setup + :type 'boolean) + (defcustom idlwave-shell-use-input-mode-magic nil "*Non-nil means, IDLWAVE should check for input mode spells in output. The spells are strings printed by your IDL program and matched by the regular expressions in `idlwave-shell-input-mode-spells'. When these expressions match, IDLWAVE switches to character input mode and back, respectively. See `idlwave-shell-input-mode-spells' for details." - :group 'idlwave-shell-general-setup + :group 'idlwave-shell-command-setup :type 'boolean) (defcustom idlwave-shell-input-mode-spells '("^$" "^$" "^$") "The three regular expressions which match the magic spells for input modes. -When the first regexp matches in the output streem of IDL, IDLWAVE +When the first regexp matches in the output stream of IDL, IDLWAVE prompts for a single character and sends it immediately to IDL, similar to the command \\[idlwave-shell-send-char]. @@ -360,7 +427,7 @@ Usage: ====== idlwave_char_input ; Make IDLWAVE send one character idlwave_char_input,/on ; Start the loop to send characters -idlwave_char_input,/off ; End the loop to send chracters +idlwave_char_input,/off ; End the loop to send characters pro idlwave_char_input,on=on,off=off @@ -372,23 +439,24 @@ pro idlwave_char_input,on=on,off=off else print,'' endif end" - :group 'idlwave-shell-general-setup + :group 'idlwave-shell-command-setup :type '(list (regexp :tag "One-char regexp") (regexp :tag "Char-mode regexp") (regexp :tag "Line-mode regexp"))) -(defcustom idlwave-shell-graphics-window-size '(500 400) - "Size of IDL graphics windows popped up by special IDLWAVE command. -The command is `C-c C-d C-f' and accepts as a prefix the window nr. -A command like `WINDOW,N,xsize=XX,ysize=YY' is sent to IDL." - :group 'idlwave-shell-general-setup - :type '(list - (integer :tag "x size") - (integer :tag "y size"))) +(defcustom idlwave-shell-breakpoint-popup-menu t + "*If non-nil, provide a menu on mouse-3 on breakpoint lines, and +popup help text on the line." + :group 'idlwave-shell-command-setup + :type 'boolean) -;;; Breakpoint Overlays etc +(defcustom idlwave-shell-reset-no-prompt nil + "If non-nil, skip the yes/no prompt when resetting the IDL session." + :group 'idlwave-shell-command-setup + :type 'boolean) +;; Breakpoint Overlays etc (defgroup idlwave-shell-highlighting-and-faces nil "Highlighting and Faces used by the IDLWAVE Shell mode." :prefix "idlwave-shell" @@ -396,7 +464,7 @@ A command like `WINDOW,N,xsize=XX,ysize=YY' is sent to IDL." (defcustom idlwave-shell-mark-stop-line t "*Non-nil means, mark the source code line where IDL is currently stopped. -Value decides about the method which is used to mark the line. Legal values +Value decides about the method which is used to mark the line. Valid values are: nil Do not mark the line @@ -432,9 +500,28 @@ line where IDL is stopped. See also `idlwave-shell-mark-stop-line'." :group 'idlwave-shell-highlighting-and-faces :type 'symbol) +(defcustom idlwave-shell-electric-stop-color "Violet" + "*The color for the default face or overlay arrow when stopped." + :group 'idlwave-shell-highlighting-and-faces + :type 'string) + +(defcustom idlwave-shell-electric-stop-line-face + (prog1 + (copy-face 'modeline 'idlwave-shell-electric-stop-line) + (set-face-background 'idlwave-shell-electric-stop-line + idlwave-shell-electric-stop-color) + (condition-case nil + (set-face-foreground 'idlwave-shell-electric-stop-line nil) + (error nil))) + "*The face for `idlwave-shell-stop-line-overlay' when in electric debug mode. +Allows you to choose the font, color and other properties for the line +where IDL is stopped, when in Electric Debug Mode." + :group 'idlwave-shell-highlighting-and-faces + :type 'symbol) + (defcustom idlwave-shell-mark-breakpoints t "*Non-nil means, mark breakpoints in the source files. -Legal values are: +Valid values are: nil Do not mark breakpoints. 'face Highlight line with `idlwave-shell-breakpoint-face'. 'glyph Red dot at the beginning of line. If the display does not @@ -448,24 +535,43 @@ t Glyph when possible, otherwise face (same effect as 'glyph)." (const :tag "Glyph or face." t))) (defvar idlwave-shell-use-breakpoint-glyph t - "Obsolete variable. See `idlwave-shell-mark-breakpoints.") + "Obsolete variable. See `idlwave-shell-mark-breakpoints.") -(defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp-face +(defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp "*The face for breakpoint lines in the source code. Allows you to choose the font, color and other properties for lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'." :group 'idlwave-shell-highlighting-and-faces :type 'symbol) -(if idlwave-shell-have-new-custom - ;; We have the new customize - use it to define a customizable face - (defface idlwave-shell-bp-face - '((((class color)) (:foreground "Black" :background "Pink")) - (t (:underline t))) - "Face for highlighting lines-with-breakpoints." - :group 'idlwave-shell-highlighting-and-faces) - ;; Just copy the underline face to be on the safe side. - (copy-face 'underline 'idlwave-shell-bp-face)) +(if (not idlwave-shell-have-new-custom) + ;; Just copy the underline face to be on the safe side. + (copy-face 'underline 'idlwave-shell-bp) + ;; We have the new customize - use it to define a customizable face + (defface idlwave-shell-bp + '((((class color)) (:foreground "Black" :background "Pink")) + (t (:underline t))) + "Face for highlighting lines with breakpoints." + :group 'idlwave-shell-highlighting-and-faces)) + +(defcustom idlwave-shell-disabled-breakpoint-face + 'idlwave-shell-disabled-bp + "*The face for disabled breakpoint lines in the source code. +Allows you to choose the font, color and other properties for +lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'." + :group 'idlwave-shell-highlighting-and-faces + :type 'symbol) + +(if (not idlwave-shell-have-new-custom) + ;; Just copy the underline face to be on the safe side. + (copy-face 'underline 'idlwave-shell-disabled-bp) + ;; We have the new customize - use it to define a customizable face + (defface idlwave-shell-disabled-bp + '((((class color)) (:foreground "Black" :background "gray")) + (t (:underline t))) + "Face for highlighting lines with breakpoints." + :group 'idlwave-shell-highlighting-and-faces)) + (defcustom idlwave-shell-expression-face 'secondary-selection "*The face for `idlwave-shell-expression-overlay'. @@ -487,11 +593,20 @@ the expression output by IDL." (defvar comint-last-input-start) (defvar comint-last-input-end) +;; Other variables +(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.") + (defun idlwave-shell-temp-file (type) "Return a temp file, creating it if necessary. -TYPE is either 'pro or 'rinfo, and idlwave-shell-temp-pro-file or -idlwave-shell-temp-rinfo-save-file is set (respectively)." +TYPE is either 'pro' or 'rinfo', and `idlwave-shell-temp-pro-file' or +`idlwave-shell-temp-rinfo-save-file' is set (respectively)." (cond ((eq type 'rinfo) (or idlwave-shell-temp-rinfo-save-file @@ -529,25 +644,14 @@ idlwave-shell-temp-rinfo-save-file is set (respectively)." nil) file))) -;; Other variables -(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.") - -(defvar idlwave-shell-dirstack-query "printd" +(defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur" "Command used by `idlwave-shell-resync-dirs' to query IDL for the directory stack.") -(defvar idlwave-shell-wd-is-synched nil) +(defvar idlwave-shell-path-query "print,'PATH:<'+transpose(expand_path(!PATH,/ARRAY))+'>' & print,'SYSDIR:<'+!dir+'>'" -(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+'>'" - "The command which gets !PATH and !DIR infor from the shell.") + "The command which gets !PATH and !DIR info from the shell.") (defvar idlwave-shell-mode-line-info nil "Additional info displayed in the mode line") @@ -568,7 +672,7 @@ the directory stack.") "The overlay for where IDL is currently stopped.") (defvar idlwave-shell-is-stopped nil) (defvar idlwave-shell-expression-overlay nil - "The overlay for where IDL is currently stopped.") + "The overlay for the examined expression.") (defvar idlwave-shell-output-overlay nil "The overlay for the last IDL output.") @@ -616,10 +720,21 @@ the directory stack.") (setq idlwave-shell-expression-overlay (make-overlay 1 1)) (overlay-put idlwave-shell-expression-overlay 'face idlwave-shell-expression-face) +(overlay-put idlwave-shell-expression-overlay + 'priority 1) (setq idlwave-shell-output-overlay (make-overlay 1 1)) (overlay-put idlwave-shell-output-overlay 'face idlwave-shell-output-face) +(copy-face idlwave-shell-stop-line-face + 'idlwave-shell-pending-stop) +(copy-face idlwave-shell-electric-stop-line-face + 'idlwave-shell-pending-electric-stop) +(set-face-background 'idlwave-shell-pending-stop "gray70") +(set-face-background 'idlwave-shell-pending-electric-stop "gray70") + + + (defvar idlwave-shell-bp-query "help,/breakpoints" "Command to obtain list of breakpoints") @@ -636,7 +751,11 @@ This is evaluated if it is a list or called with funcall.") (defvar idlwave-shell-hide-output nil "If non-nil the process output is not inserted into the output - buffer.") +buffer.") + +(defvar idlwave-shell-show-if-error nil + "If non-nil the process output is inserted into the output buffer if +it contains an error message, even if hide-output is non-nil.") (defvar idlwave-shell-accumulation nil "Accumulate last line of output.") @@ -675,26 +794,25 @@ with `*'s." "The frame associated with trace messages.") (defconst idlwave-shell-halt-messages - '("^% Execution halted at" - "^% Interrupted at:" + '("^% Interrupted at:" "^% Stepped to:" - "^% At " + "^% Skipped to:" "^% Stop encountered:" ) "*A list of regular expressions matching IDL messages. These are the messages containing file and line information where IDL is currently stopped.") + (defconst idlwave-shell-halt-messages-re (mapconcat 'identity idlwave-shell-halt-messages "\\|") "The regular expression computed from idlwave-shell-halt-messages") -(defconst idlwave-shell-trace-messages - '("^% At " ;; First line of a trace message - ) - "*A list of regular expressions matching IDL trace messages. -These are the messages containing file and line information where -IDL will begin looking for the next statement to execute.") +(defconst idlwave-shell-trace-message-re + "^% At " ;; First line of a trace message + "*A regular expression matching IDL trace messages. These are the +messages containing file and line information of a current +traceback.") (defconst idlwave-shell-step-messages '("^% Stepped to:" @@ -706,6 +824,44 @@ IDL has currently stepped.") (defvar idlwave-shell-break-message "^% Breakpoint at:" "*Regular expression matching an IDL breakpoint message line.") +(defconst idlwave-shell-electric-debug-help + " ==> IDLWAVE Electric Debug Mode Help <== + + Break Point Setting and Clearing: + b Set breakpoint ([C-u b] for conditional, [C-n b] nth hit, etc.). + d Clear nearby breakpoint. + a Clear all breakpoints. + i Set breakpoint in routine named here. + j Set breakpoint at beginning of containing routine. + \\ Toggle breakpoint disable + ] Go to next breakpoint in file. + [ Go to previous breakpoint in file. + + Stepping, Continuing, and the Stack: + s or SPACE Step, into function calls. + n Step, over function calls. + k Skip one statement. + m Continue to end of function. + o Continue past end of function. + u Continue to end of block. + h Continue to line at cursor position. + r Continue execution to next breakpoint, if any. + + or = Show higher level in calling stack. + - or _ Show lower level in calling stack. + + Examining Expressions (with prefix for examining the region): + p Print expression near point or in region ([C-u p]). + ? Help on expression near point or in region ([C-u ?]). + x Examine expression near point or in region ([C-u x]) with + letter completion of the examine type. + e Prompt for an expression to print. + + Miscellaneous: + q Quit - end debugging session and return to the Shell's main level. + v Turn Electric Debugging Mode off (C-c C-d C-v to return). + t Print a calling-level traceback in the shell. + z Reset IDL. + C-? Show this help menu.") (defvar idlwave-shell-bp-alist) ;(defvar idlwave-shell-post-command-output) @@ -721,6 +877,8 @@ IDL has currently stepped.") (defvar idlwave-shell-sources-query) (defvar idlwave-shell-mode-map) (defvar idlwave-shell-calling-stack-index) +(defvar idlwave-shell-only-prompt-pattern nil) +(defvar tool-bar-map) (defun idlwave-shell-mode () "Major mode for interacting with an inferior IDL process. @@ -775,12 +933,24 @@ IDL has currently stepped.") \\[idlwave-shell-resync-dirs] queries IDL in order to change Emacs current directory to correspond to the IDL process current directory. -5. Hooks +5. Expression Examination + ---------------------- + + Expressions near point can be examined with print, + \\[idlwave-shell-print] or \\[idlwave-shell-mouse-print] with the + mouse, help, \\[idlwave-shell-help-expression] or + \\[idlwave-shell-mouse-help] with the mouse, or with a + configureable set of custom examine commands using + \\[idlwave-shell-examine-select]. The mouse examine commands can + also work by click and drag, to select an expression for + examination. + +6. Hooks ----- Turning on `idlwave-shell-mode' runs `comint-mode-hook' and `idlwave-shell-mode-hook' (in that order). -6. Documentation and Customization +7. Documentation and Customization ------------------------------- Info documentation for this package is available. Use \\[idlwave-info] to display (complain to your sysadmin if that does not work). @@ -788,15 +958,22 @@ IDL has currently stepped.") homepage at `http://idlwave.org'. IDLWAVE has customize support - see the group `idlwave'. -7. Keybindings +8. Keybindings ----------- \\{idlwave-shell-mode-map}" (interactive) + (idlwave-setup) ; Make sure config files and paths, etc. are available. + (unless (file-name-absolute-p idlwave-shell-command-history-file) + (setq idlwave-shell-command-history-file + (expand-file-name idlwave-shell-command-history-file + idlwave-config-directory))) + ;; We don't do `kill-all-local-variables' here, because this is done by - ;; comint - idlwave-shell-mode only add on top of that. + ;; comint (setq comint-prompt-regexp idlwave-shell-prompt-pattern) (setq comint-process-echoes t) + ;; Can not use history expansion because "!" is used for system variables. (setq comint-input-autoexpand nil) ; (setq comint-input-ring-size 64) @@ -832,6 +1009,15 @@ IDL has currently stepped.") idlwave-shell-step-frame nil) (idlwave-shell-display-line nil) (setq idlwave-shell-calling-stack-index 0) + (setq idlwave-shell-only-prompt-pattern + (concat "\\`[ \t\n]*" + (substring idlwave-shell-prompt-pattern 1) + "[ \t\n]*\\'")) + + (when idlwave-shell-query-for-class + (add-to-list (make-local-variable 'idlwave-determine-class-special) + 'idlwave-shell-get-object-class) + (setq idlwave-store-inquired-class t)) ;; Make sure comint-last-input-end does not go to beginning of ;; buffer (in case there were other processes already in this buffer). @@ -840,12 +1026,13 @@ IDL has currently stepped.") (setq idlwave-shell-ready nil) (setq idlwave-shell-bp-alist nil) (idlwave-shell-update-bp-overlays) ; Throw away old overlays - (setq idlwave-shell-sources-alist nil) + (setq idlwave-shell-post-command-hook nil ;clean up any old stuff + idlwave-shell-sources-alist nil) (setq idlwave-shell-default-directory default-directory) (setq idlwave-shell-hide-output nil) ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility - (make-local-hook 'kill-buffer-hook) + ;; (make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm nil 'local) (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local) @@ -859,6 +1046,29 @@ IDL has currently stepped.") (while (setq entry (pop list)) (set (make-local-variable (car entry)) (cdr entry))))) + + (unless (memq 'comint-carriage-motion + (default-value 'comint-output-filter-functions)) + ;; Strip those pesky ctrl-m's. + (add-hook 'comint-output-filter-functions + (lambda (string) + (when (string-match "\r" string) + (let ((pmark (process-mark (get-buffer-process + (current-buffer))))) + (save-excursion + ;; bare CR -> delete preceding line + (goto-char comint-last-output-start) + (while (search-forward "\r" pmark t) + (delete-region (point) (line-beginning-position))))))) + 'append 'local) + (add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m nil 'local)) + + ;; Python-mode, bundled with many Emacs installs, quite cavalierly + ;; adds this function to the global default hook. It interferes + ;; with overlay-arrows. + (remove-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file) + + ;; IDLWAVE syntax, and turn on abbreviations (setq local-abbrev-table idlwave-mode-abbrev-table) (set-syntax-table idlwave-mode-syntax-table) @@ -866,7 +1076,7 @@ IDL has currently stepped.") (setq abbrev-mode t) ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility - (make-local-hook 'post-command-hook) + ;; make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'idlwave-command-hook nil t) ;; Read the command history? @@ -877,26 +1087,54 @@ IDL has currently stepped.") (if (file-regular-p idlwave-shell-command-history-file) (comint-read-input-ring))) + ;; Turn off the non-debug toolbar buttons (open,save,etc.) + (set (make-local-variable 'tool-bar-map) nil) + ;; Run the hooks. - (run-hooks 'idlwave-shell-mode-hook) + (run-mode-hooks 'idlwave-shell-mode-hook) (idlwave-shell-send-command idlwave-shell-initial-commands nil 'hide) - ;; Define a system variable which knows the version of IDLWAVE + ;; Turn off IDL's ^d interpreting, and define a system + ;; variable which knows the version of IDLWAVE (idlwave-shell-send-command (format "defsysv,'!idlwave_version','%s',1" idlwave-mode-version) nil 'hide) - (if (and (not idlwave-path-alist) - (not idlwave-sys-dir)) - (idlwave-shell-send-command idlwave-shell-path-query - 'idlwave-shell-get-path-info - 'hide))) + ;; Read the paths, and save if they changed + (idlwave-shell-send-command idlwave-shell-path-query + 'idlwave-shell-get-path-info + 'hide)) -(defun idlwave-shell-get-path-info () +(defvar idlwave-system-directory) +(defun idlwave-shell-get-path-info (&optional no-write) + "Get the path lists, writing to file unless NO-WRITE is set." (let* ((rpl (idlwave-shell-path-filter)) (sysdir (car rpl)) - (dirs (cdr rpl))) - (setq idlwave-sys-dir sysdir) - (setq idlwave-path-alist (mapcar (lambda(x) (cons x nil)) - dirs)))) + (dirs (cdr rpl)) + (old-path-alist idlwave-path-alist) + (old-sys-dir idlwave-system-directory) + path-changed sysdir-changed) + (when sysdir + (setq idlwave-system-directory sysdir) + (if (setq sysdir-changed + (not (string= idlwave-system-directory old-sys-dir))) + (put 'idlwave-system-directory 'from-shell t))) + ;; Preserve any existing flags + (setq idlwave-path-alist + (mapcar (lambda (x) + (let ((old-entry (assoc x old-path-alist))) + (if old-entry + (cons x (cdr old-entry)) + (list x)))) + dirs)) + (if (setq path-changed (not (equal idlwave-path-alist old-path-alist))) + (put 'idlwave-path-alist 'from-shell t)) + (if idlwave-path-alist + (if (and (not no-write) + idlwave-auto-write-paths + (or sysdir-changed path-changed) + (not idlwave-library-path)) + (idlwave-write-paths)) + ;; Fall back + (setq idlwave-path-alist old-path-alist)))) (if (not (fboundp 'idl-shell)) (fset 'idl-shell 'idlwave-shell)) @@ -1002,12 +1240,22 @@ See also the variable `idlwave-shell-prompt-pattern'. (current-window (selected-window))) (select-window window) (goto-char (point-max)) + (if idlwave-shell-use-dedicated-window + (set-window-dedicated-p window t)) (select-window current-window) (if idlwave-shell-ready (raise-frame (window-frame window))) (if (eq (selected-frame) (window-frame window)) - (select-window window)) - ))) + (select-window window)))) + ;; Save the paths at the end, if they are from the Shell and new. + (add-hook 'idlwave-shell-sentinel-hook + (lambda () + (if (and + idlwave-auto-write-paths + idlwave-path-alist + (not idlwave-library-path) + (get 'idlwave-path-alist 'from-shell)) + (idlwave-write-paths))))) (defun idlwave-shell-recenter-shell-window (&optional arg) "Run `idlwave-shell', but make sure the current window stays selected." @@ -1016,24 +1264,60 @@ See also the variable `idlwave-shell-prompt-pattern'. (idlwave-shell arg) (select-window window))) -(defun idlwave-shell-send-command (&optional cmd pcmd hide preempt) +(defun idlwave-shell-hide-p (type &optional list) + "Whether to hide this type of command. +Return either nil or 'hide." + (let ((list (or list idlwave-shell-show-commands))) + (if (listp list) + (if (not (memq type list)) 'hide)))) + +(defun idlwave-shell-add-or-remove-show (type) + "Add or remove a show command from the list." + (if (listp idlwave-shell-show-commands) + (setq idlwave-shell-show-commands + (if (memq type idlwave-shell-show-commands) + (delq type idlwave-shell-show-commands) + (add-to-list'idlwave-shell-show-commands type))) + (setq idlwave-shell-show-commands (list type)))) + + +(defun idlwave-shell-send-command (&optional cmd pcmd hide preempt + show-if-error) "Send a command to IDL process. -\(CMD PCMD HIDE\) are placed at the end of `idlwave-shell-pending-commands'. -If IDL is ready the first command, CMD, in -`idlwave-shell-pending-commands' is sent to the IDL process. If optional -second argument PCMD is non-nil it will be placed on -`idlwave-shell-post-command-hook' when CMD is executed. If the optional -third argument HIDE is non-nil, then hide output from CMD. -If optional fourth argument PREEMPT is non-nil CMD is put at front of -`idlwave-shell-pending-commands'. +\(CMD PCMD HIDE\) are placed at the end of ` +idlwave-shell-pending-commands'. If IDL is ready the first command, +CMD, in `idlwave-shell-pending-commands' is sent to the IDL process. -IDL is considered ready if the prompt is present -and if `idlwave-shell-ready' is non-nil." +If optional second argument PCMD is non-nil it will be placed on +`idlwave-shell-post-command-hook' when CMD is executed. - ;(setq hide nil) ; FIXME: turn this on for debugging only -; (message "SENDING %s|||%s" cmd pcmd) ;?????????????????????? - (let (buf proc) +If the optional third argument HIDE is non-nil, then hide output from +CMD, unless it is the symbol 'mostly, in which case only output +beginning with \"%\" is hidden, and all other output (i.e., the +results of a PRINT command), is shown. This helps with, e.g., +stepping through code with output. + +If optional fourth argument PREEMPT is non-nil CMD is put at front of +`idlwave-shell-pending-commands'. If PREEMPT is 'wait, wait for all +output to complete and the next prompt to arrive before returning +\(useful if you need an answer now\). IDL is considered ready if the +prompt is present and if `idlwave-shell-ready' is non-nil. + +If SHOW-IF-ERROR is non-nil, show the output if it contains an error +message, independent of what HIDE is set to." + +; (setq hide nil) ; FIXME: turn this on for debugging only +; (if (null cmd) +; (progn +; (message "SENDING Pending commands: %s" +; (prin1-to-string idlwave-shell-pending-commands))) +; (message "SENDING %s|||%s" cmd pcmd)) + (if (and (symbolp idlwave-shell-show-commands) + (eq idlwave-shell-show-commands 'everything)) + (setq hide nil)) + (let ((save-buffer (current-buffer)) + buf proc) ;; Get or make the buffer and its process (if (or (not (setq buf (get-buffer (idlwave-shell-buffer)))) (not (setq proc (get-buffer-process buf)))) @@ -1047,56 +1331,63 @@ and if `idlwave-shell-ready' is non-nil." (not (setq proc (get-buffer-process buf)))) ;; Still nothing (error "Problem with autostarting IDL shell")))) - - (save-excursion + (when (or cmd idlwave-shell-pending-commands) (set-buffer buf) - (goto-char (process-mark proc)) ;; To make this easy, always push CMD onto pending commands (if cmd - (setq idlwave-shell-pending-commands - (if preempt - ;; Put at front. - (append (list (list cmd pcmd hide)) - idlwave-shell-pending-commands) - ;; Put at end. - (append idlwave-shell-pending-commands - (list (list cmd pcmd hide)))))) + (setq idlwave-shell-pending-commands + (if preempt + ;; Put at front. + (append (list (list cmd pcmd hide show-if-error)) + idlwave-shell-pending-commands) + ;; Put at end. + (append idlwave-shell-pending-commands + (list (list cmd pcmd hide show-if-error)))))) ;; Check if IDL ready - (if (and idlwave-shell-ready - ;; Check for IDL prompt - (save-excursion - (forward-line 0) - ;; (beginning-of-line) ; Changed for Emacs 21 - (looking-at idlwave-shell-prompt-pattern))) - ;; IDL ready for command - (if idlwave-shell-pending-commands - ;; execute command - (let* ((lcmd (car idlwave-shell-pending-commands)) - (cmd (car lcmd)) - (pcmd (nth 1 lcmd)) - (hide (nth 2 lcmd))) - ;; If this is an executive command, reset the stack pointer - (if (eq (string-to-char cmd) ?.) - (setq idlwave-shell-calling-stack-index 0)) - ;; Set post-command - (setq idlwave-shell-post-command-hook pcmd) - ;; Output hiding -;;; Debug code -;;; (setq idlwave-shell-hide-output nil) - (setq idlwave-shell-hide-output hide) - ;; Pop command - (setq idlwave-shell-pending-commands - (cdr idlwave-shell-pending-commands)) - ;; Send command for execution - (set-marker comint-last-input-start (point)) - (set-marker comint-last-input-end (point)) - (comint-simple-send proc cmd) - (setq idlwave-shell-ready nil))))))) - -(defun idlwave-shell-send-char (c &optional no-error) + (let ((save-point (point-marker))) + (goto-char (process-mark proc)) + (if (and idlwave-shell-ready + ;; Check for IDL prompt + (prog2 + (forward-line 0) + ;; (beginning-of-line) ; Changed for Emacs 21 + (looking-at idlwave-shell-prompt-pattern) + (goto-char (process-mark proc)))) + ;; IDL ready for command, execute it + (let* ((lcmd (car idlwave-shell-pending-commands)) + (cmd (car lcmd)) + (pcmd (nth 1 lcmd)) + (hide (nth 2 lcmd)) + (show-if-error (nth 3 lcmd))) + ;; If this is an executive command, reset the stack pointer + (if (eq (string-to-char cmd) ?.) + (setq idlwave-shell-calling-stack-index 0)) + ;; Set post-command + (setq idlwave-shell-post-command-hook pcmd) + ;; Output hiding + (setq idlwave-shell-hide-output hide) + ;;Showing errors + (setq idlwave-shell-show-if-error show-if-error) + ;; Pop command + (setq idlwave-shell-pending-commands + (cdr idlwave-shell-pending-commands)) + ;; Send command for execution + (set-marker comint-last-input-start (point)) + (set-marker comint-last-input-end (point)) + (comint-simple-send proc cmd) + (setq idlwave-shell-ready nil) + (if (equal preempt 'wait) ; Get all the output at once + (while (not idlwave-shell-ready) + (when (not (accept-process-output proc 6)) ; long wait + (setq idlwave-shell-pending-commands nil) + (error "Process timed out")))))) + (goto-char save-point)) + (set-buffer save-buffer)))) + +(defun idlwave-shell-send-char (c &optional error) "Send one character to the shell, without a newline." - (interactive "cChar to send to IDL: ") - (let ((errf (if (interactive-p) 'error 'message)) + (interactive "cChar to send to IDL: \np") + (let ((errf (if error 'error 'message)) buf proc) (if (or (not (setq buf (get-buffer (idlwave-shell-buffer)))) (not (setq proc (get-buffer-process buf)))) @@ -1172,38 +1463,33 @@ when the IDL prompt gets displayed again after the current IDL command." (and (eq idlwave-shell-char-mode-active 'exit) (throw 'exit "Single char loop exited")))))))) -(defun idlwave-shell-up-or-history (&optional arg) +(defun idlwave-shell-move-or-history (up &optional arg) "When in last line of process buffer, do `comint-previous-input'. -Otherwise just do `previous-line'." +Otherwise just move the line. Move down unless UP is non-nil." + (let* ((proc-pos (marker-position + (process-mark (get-buffer-process (current-buffer))))) + (arg (or arg 1)) + (arg (if up arg (- arg)))) + (if (eq t idlwave-shell-arrows-do-history) (goto-char proc-pos)) + (if (and idlwave-shell-arrows-do-history + (>= (1+ (save-excursion (end-of-line) (point))) proc-pos)) + (comint-previous-input arg) + (previous-line arg)))) + +(defun idlwave-shell-up-or-history (&optional arg) +"When in last line of process buffer, move to previous input. + Otherwise just go up one line." (interactive "p") - (if (eq t idlwave-shell-arrows-do-history) (goto-char (point-max))) - (if (and idlwave-shell-arrows-do-history - (>= (1+ (save-excursion (end-of-line) (point))) - (marker-position - (process-mark (get-buffer-process (current-buffer)))))) - (progn - (and (not (eolp)) (kill-line nil)) - (comint-previous-input arg)) - (previous-line arg))) + (idlwave-shell-move-or-history t arg)) (defun idlwave-shell-down-or-history (&optional arg) - "When in last line of process buffer, do `comint-next-input'. - Otherwise just do `next-line'." +"When in last line of process buffer, move to next input. + Otherwise just go down one line." (interactive "p") - (if (eq t idlwave-shell-arrows-do-history) (goto-char (point-max))) - (if (and idlwave-shell-arrows-do-history - (>= (1+ (save-excursion (end-of-line) (point))) - (marker-position - (process-mark (get-buffer-process (current-buffer)))))) - (progn - (and (not (eolp)) (kill-line nil)) - (comint-next-input arg)) - (next-line arg))) - -;; There was a report that a newer version of comint.el changed the -;; name of comint-filter to comint-output-filter. Unfortunately, we -;; have yet to upgrade. + (idlwave-shell-move-or-history nil arg)) +;; Newer versions of comint.el changed the name of comint-filter to +;; comint-output-filter. (defun idlwave-shell-comint-filter (process string) nil) (if (fboundp 'comint-output-filter) (fset 'idlwave-shell-comint-filter (symbol-function 'comint-output-filter)) @@ -1213,119 +1499,134 @@ Otherwise just do `previous-line'." "Return t if the shell process is running." (eq (process-status idlwave-shell-process-name) 'run)) +(defun idlwave-shell-filter-hidden-output (output) + "Filter hidden output, leaving the good stuff. + +Remove everything to the first newline, and all lines with % in front +of them, with optional follow-on lines starting with two spaces. This +works well enough, since any print output typically arrives before +error messages, etc." + (setq output (substring output (string-match "\n" output))) + (while (string-match "\\(\n\\|\\`\\)%.*\\(\n .*\\)*" output) + (setq output (replace-match "" nil t output))) + (unless + (string-match idlwave-shell-only-prompt-pattern output) + output)) + (defvar idlwave-shell-hidden-output-buffer " *idlwave-shell-hidden-output*" "Buffer containing hidden output from IDL commands.") +(defvar idlwave-shell-current-state nil) (defun idlwave-shell-filter (proc string) - "Replace Carriage returns in output. Watch for prompt. + "Watch for IDL prompt and filter incoming text. When the IDL prompt is received executes `idlwave-shell-post-command-hook' and then calls `idlwave-shell-send-command' for any pending commands." ;; We no longer do the cleanup here - this is done by the process sentinel - (when (eq (process-status idlwave-shell-process-name) 'run) - ;; OK, process is still running, so we can use it. - (setq idlwave-shell-wd-is-synched nil) ;; something might have changed cwd - (let ((data (match-data)) p) - (unwind-protect - (progn - ;; May change the original match data. - (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. - (while (setq p (string-match "\C-G" string)) - (ding) - (aset string p ?\C-j )) - (if idlwave-shell-hide-output - (save-excursion - (set-buffer - (get-buffer-create idlwave-shell-hidden-output-buffer)) - (goto-char (point-max)) - (insert string)) - (idlwave-shell-comint-filter proc string)) - ;; Watch for magic - need to accumulate the current line - ;; since it may not be sent all at once. - (if (string-match "\n" string) - (progn - (if idlwave-shell-use-input-mode-magic - (idlwave-shell-input-mode-magic - (concat idlwave-shell-accumulation string))) - (setq idlwave-shell-accumulation - (substring string - (progn (string-match "\\(.*\n\\)*" string) - (match-end 0))))) - (setq idlwave-shell-accumulation - (concat idlwave-shell-accumulation string))) - - + (if (eq (process-status idlwave-shell-process-name) 'run) + ;; OK, process is still running, so we can use it. + (let ((data (match-data)) p full-output) + (unwind-protect + (progn + ;; Ring the bell if necessary + (while (setq p (string-match "\C-G" string)) + (ding) + (aset string p ?\C-j )) + (if idlwave-shell-hide-output + (save-excursion + (while (setq p (string-match "\C-M" string)) + (aset string p ?\ )) + (set-buffer + (get-buffer-create idlwave-shell-hidden-output-buffer)) + (goto-char (point-max)) + (insert string)) + (idlwave-shell-comint-filter proc string)) + ;; Watch for magic - need to accumulate the current line + ;; since it may not be sent all at once. + (if (string-match "\n" string) + (progn + (if idlwave-shell-use-input-mode-magic + (idlwave-shell-input-mode-magic + (concat idlwave-shell-accumulation string))) + (setq idlwave-shell-accumulation + (substring string + (progn (string-match "\\(.*[\n\r]+\\)*" + string) + (match-end 0))))) + (setq idlwave-shell-accumulation + (concat idlwave-shell-accumulation string))) + + ;;; Test/Debug code -; (save-excursion (set-buffer -; (get-buffer-create "*idlwave-shell-output*")) -; (goto-char (point-max)) -; (insert "\nSTRING===>\n" string "\n<====\n")) + ;(with-current-buffer + ; (get-buffer-create "*idlwave-shell-output*") + ; (goto-char (point-max)) + ; (insert "\nReceived STRING\n===>\n" string "\n<====\n")) - ;; Check for prompt in current accumulating line - (if (setq idlwave-shell-ready - (string-match idlwave-shell-prompt-pattern - idlwave-shell-accumulation)) - (progn - (if idlwave-shell-hide-output - (save-excursion - (set-buffer idlwave-shell-hidden-output-buffer) -; (goto-char (point-min)) -; (re-search-forward idlwave-shell-prompt-pattern nil t) - (goto-char (point-max)) - (re-search-backward idlwave-shell-prompt-pattern nil t) - (goto-char (match-end 0)) - (setq idlwave-shell-command-output - (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")) - - (delete-region (point-min) (point))) - (setq idlwave-shell-command-output - (save-excursion - (set-buffer - (process-buffer proc)) - (buffer-substring - (progn - (goto-char (process-mark proc)) - (beginning-of-line nil) - (point)) - comint-last-input-end)))) - ;; Scan for state and do post command - bracket them - ;; with idlwave-shell-ready=nil since they - ;; may call idlwave-shell-send-command. - (let ((idlwave-shell-ready nil)) - (idlwave-shell-scan-for-state) - ;; Unset idlwave-shell-ready to prevent sending - ;; commands to IDL while running hook. - (if (listp idlwave-shell-post-command-hook) - (eval idlwave-shell-post-command-hook) - (funcall idlwave-shell-post-command-hook)) - ;; Reset to default state for next command. - ;; Also we do not want to find this prompt again. - (setq idlwave-shell-accumulation nil - idlwave-shell-command-output nil - idlwave-shell-post-command-hook nil - idlwave-shell-hide-output nil)) - ;; Done with post command. Do pending command if - ;; any. - (idlwave-shell-send-command)))) - (store-match-data data))))) + ;; Check for prompt in current accumulating output + (when (setq idlwave-shell-ready + (string-match idlwave-shell-prompt-pattern + idlwave-shell-accumulation)) + ;; Gather the command output + (if idlwave-shell-hide-output + (save-excursion + (set-buffer idlwave-shell-hidden-output-buffer) + (setq full-output (buffer-string)) + (goto-char (point-max)) + (re-search-backward idlwave-shell-prompt-pattern nil t) + (goto-char (match-end 0)) + (setq idlwave-shell-command-output + (buffer-substring-no-properties + (point-min) (point))) + (delete-region (point-min) (point))) + (setq idlwave-shell-command-output + (with-current-buffer (process-buffer proc) + (buffer-substring-no-properties + (save-excursion + (goto-char (process-mark proc)) + (forward-line 0) ; Emacs 21 (beginning-of-line nil) + (point)) + comint-last-input-end)))) + + ;; Scan for state and do post commands - bracket + ;; them with idlwave-shell-ready=nil since they may + ;; call idlwave-shell-send-command themselves. + (let ((idlwave-shell-ready nil)) + (idlwave-shell-scan-for-state) + ;; Show the output in the shell if it contains an error + (if idlwave-shell-hide-output + (if (and idlwave-shell-show-if-error + (eq idlwave-shell-current-state 'error)) + (idlwave-shell-comint-filter proc full-output) + ;; If it's only *mostly* hidden, filter % lines, + ;; and show anything that remains + (if (eq idlwave-shell-hide-output 'mostly) + (let ((filtered + (idlwave-shell-filter-hidden-output + full-output))) + (if filtered + (idlwave-shell-comint-filter + proc filtered)))))) + + ;; Call the post-command hook + (if (listp idlwave-shell-post-command-hook) + (progn + ;;(message "Calling list") + ;;(prin1 idlwave-shell-post-command-hook) + (eval idlwave-shell-post-command-hook)) + ;;(message "Calling command function") + (funcall idlwave-shell-post-command-hook)) + + ;; Reset to default state for next command. + ;; Also we do not want to find this prompt again. + (setq idlwave-shell-accumulation nil + idlwave-shell-command-output nil + idlwave-shell-post-command-hook nil + idlwave-shell-hide-output nil + idlwave-shell-show-if-error nil)) + ;; Done with post command. Do pending command if + ;; any. + (idlwave-shell-send-command))) + (store-match-data data))))) (defun idlwave-shell-sentinel (process event) "The sentinel function for the IDLWAVE shell process." @@ -1358,103 +1659,35 @@ and then calls `idlwave-shell-send-command' for any pending commands." (run-hooks 'idlwave-shell-sentinel-hook)) (run-hooks 'idlwave-shell-sentinel-hook)))) -(defun idlwave-shell-scan-for-state () - "Scan for state info. -Looks for messages in output from last IDL command indicating where -IDL has stopped. The types of messages we are interested in are -execution halted, stepped, breakpoint, interrupted at and trace -messages. We ignore error messages otherwise. -For breakpoint messages process any attached count or command -parameters. -Update the windows if a message is found." - (let (update) - (cond - ;; Make sure we have output - ((not idlwave-shell-command-output)) - - ;; Various types of HALT messages. - ((string-match idlwave-shell-halt-messages-re - 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))) - update t)) - - ;; Handle breakpoints separately - ((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))) - update t) - ;; We used to to counting 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))))) - - ;; Handle compilation errors in addition to the above - (if (and idlwave-shell-command-output - (or (string-match - idlwave-shell-syntax-error idlwave-shell-command-output) - (string-match - idlwave-shell-other-error idlwave-shell-command-output))) - (progn - (save-excursion - (set-buffer - (get-buffer-create idlwave-shell-error-buffer)) - (erase-buffer) - (insert idlwave-shell-command-output) - (goto-char (point-min)) - (setq idlwave-shell-error-last (point))) - (idlwave-shell-goto-next-error))) - - ;; Do update - (when update - (idlwave-shell-display-line (idlwave-shell-pc-frame))))) - - (defvar idlwave-shell-error-buffer " *idlwave-shell-errors*" "Buffer containing syntax errors from IDL compilations.") - ;; FIXME: the following two variables do not currently allow line breaks ;; in module and file names. I am not sure if it will be necessary to ;; change this. Currently it seems to work the way it is. (defvar idlwave-shell-syntax-error - "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)" - "A regular expression to match an IDL syntax error. -The first \(..\) pair should match the file name. The second pair -should match the line number.") + "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)" + "A regular expression to match an IDL syntax error. +The 1st pair matches the file name, the second pair matches the line +number.") (defvar idlwave-shell-other-error "^% .*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)" - "A regular expression to match any IDL error. -The first \(..\) pair should match the file name. The second pair -should match the line number.") + "A regular expression to match any IDL error.") + +(defvar idlwave-shell-halting-error + "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+\\s-*.*\\)\n" + "A regular expression to match errors which halt execution.") + +(defvar idlwave-shell-cant-continue-error + "^% Can't continue from this point.\n" + "A regular expression to match errors stepping errors.") (defvar idlwave-shell-file-line-message (concat "\\(" ; program name group (1) - "\\<[a-zA-Z][a-zA-Z0-9_$:]*" ; start with a letter, followed by [..] + "\\$MAIN\\$\\|" ; main level routine + "\\<[a-zA-Z][a-zA-Z0-9_$:]*" ; start with a letter followed by [..] "\\([ \t]*\n[ \t]*[a-zA-Z0-9_$:]+\\)*"; continuation lines program name (2) "\\)" ; end program name group (1) "[ \t\n]+" ; white space @@ -1475,30 +1708,131 @@ The 5th group is the file name. All parts may contain linebreaks surrounded by spaces. This is important in IDL5 which inserts random linebreaks in long module and file names.") -(defun idlwave-shell-parse-line (string) - "Parse IDL message for the subroutine, file name and line number. -We need to work hard here to remove the stupid line breaks inserted by -IDL5. These line breaks can be right in the middle of procedure -or file names. -It is very difficult to come up with a robust solution. This one seems -to be pretty good though. +(defvar idlwave-shell-electric-debug-mode) ; defined by easy-mmode -Here is in what ways it improves over the previous solution: - -1. The procedure name can be split and will be restored. -2. The number can be split. I have never seen this, but who knows. -3. We do not require the `.pro' extension for files. - -This function can still break when the file name ends on a end line -and the message line contains an additional line with garbage. Then -the first part of that garbage will be added to the file name. -However, the function checks the existence of the files with and -without this last part - thus the function only breaks if file name -plus garbage match an existing regular file. This is hopefully very -unlikely." +(defun idlwave-shell-scan-for-state () + "Scan for state info. Looks for messages in output from last IDL +command indicating where IDL has stopped. The types of messages we are +interested in are execution halted, stepped, breakpoint, interrupted +at and trace messages. For breakpoint messages process any attached +count or command parameters. Update the stop line if a message is +found. The variable `idlwave-shell-current-state' is set to 'error, +'halt, or 'breakpoint, which describes the status, or nil for none of +the above." + (let (trace) + (cond + ;; Make sure we have output + ((not idlwave-shell-command-output)) + + ;; First Priority: Syntax and other errors + ((or + (string-match idlwave-shell-syntax-error + idlwave-shell-command-output) + (string-match idlwave-shell-other-error + idlwave-shell-command-output)) + (with-current-buffer + (get-buffer-create idlwave-shell-error-buffer) + (erase-buffer) + (insert idlwave-shell-command-output) + (goto-char (point-min)) + (setq idlwave-shell-error-last (point))) + (setq idlwave-shell-current-state 'error) + (idlwave-shell-goto-next-error)) + + ;; Second Priority: Halting errors + ((string-match idlwave-shell-halting-error + 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-beginning 2))) + idlwave-shell-current-state 'error) + (idlwave-shell-display-line (idlwave-shell-pc-frame))) + + ;; Third Priority: Various types of innocuous HALT and + ;; TRACEBACK messages. + ((or (setq trace (string-match idlwave-shell-trace-message-re + idlwave-shell-command-output)) + (string-match idlwave-shell-halt-messages-re + 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)))) + (setq idlwave-shell-current-state 'halt) + ;; Don't debug trace messages + (idlwave-shell-display-line + (idlwave-shell-pc-frame) nil + (if trace 'disable + (if idlwave-shell-electric-debug-mode 'force)))) + + ;; Fourth 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))) + ;(message "Scanning with %s" bp) + (if bp + (let ((cmd (idlwave-shell-bp-get bp 'cmd))) + (if cmd ;; Execute any breakpoint command + (if (listp cmd) (eval cmd) (funcall cmd)))) + ;; A breakpoint that we did not know about - perhaps it was + ;; set by the user... Let's update our list. + (idlwave-shell-bp-query))) + (setq idlwave-shell-current-state 'breakpoint) + (idlwave-shell-display-line (idlwave-shell-pc-frame))) + + ;; Last Priority: Can't Step errors + ((string-match idlwave-shell-cant-continue-error + idlwave-shell-command-output) + (setq idlwave-shell-current-state 'breakpoint)) + + ;; Otherwise, no particular state + (t (setq idlwave-shell-current-state nil))))) + + +(defun idlwave-shell-parse-line (string &optional skip-main) + "Parse IDL message for the subroutine, file name and line number." +;We need to work hard here to remove the stupid line breaks inserted by +;IDL5. These line breaks can be right in the middle of procedure +;or file names. +;It is very difficult to come up with a robust solution. This one seems +;to be pretty good though. +; +;Here is in what ways it improves over the previous solution: +; +;1. The procedure name can be split and will be restored. +;2. The number can be split. I have never seen this, but who knows. +;3. We do not require the `.pro' extension for files. +; +;This function can still break when the file name ends on an end line +;and the message line contains an additional line with garbage. Then +;the first part of that garbage will be added to the file name. +;However, the function checks the existence of the files with and +;without this last part - thus the function only breaks if file name +;plus garbage match an existing regular file. This is hopefully very +;unlikely. +; +;If optional arg SKIP-MAIN is non-nil, don't parse $MAIN$ routine stop +;statements. (let (number procedure file) - (when (string-match idlwave-shell-file-line-message string) + (when (and (not (if skip-main (string-match ":\\s-*\\$MAIN" string))) + (string-match idlwave-shell-file-line-message string)) (setq procedure (match-string 1 string) number (match-string 3 string) file (match-string 5 string)) @@ -1511,7 +1845,7 @@ unlikely." ;; If we have a file, return the frame list (if file (list (idlwave-shell-file-name file) - (string-to-int number) + (string-to-number number) procedure) ;; No success finding a file nil)))) @@ -1585,27 +1919,35 @@ The size is given by `idlwave-shell-graphics-window-size'." (let ((n (if n (prefix-numeric-value n) 0))) (idlwave-shell-send-command (apply 'format "window,%d,xs=%d,ys=%d" - n idlwave-shell-graphics-window-size)))) + n idlwave-shell-graphics-window-size) + nil (idlwave-shell-hide-p 'misc) nil t))) (defun idlwave-shell-resync-dirs () - "Resync the buffer's idea of the current directory stack. -This command queries IDL with the command bound to -`idlwave-shell-dirstack-query' (default \"printd\"), reads the -output for the new directory stack." + "Resync the buffer's idea of the current directory. +This command queries IDL with the command bound to +`idlwave-shell-dirstack-query', reads the output for the new +directory." (interactive) (idlwave-shell-send-command idlwave-shell-dirstack-query 'idlwave-shell-filter-directory - 'hide)) + 'hide 'wait)) (defun idlwave-shell-retall (&optional arg) - "Return from the entire calling stack." + "Return from the entire calling stack. +Also get rid of widget events in the queue." (interactive "P") - (idlwave-shell-send-command "retall")) + (save-selected-window + ;;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 & + (idlwave-shell-send-command "retall" nil + (if (idlwave-shell-hide-p 'misc) 'mostly) + nil t) + (idlwave-shell-display-line nil))) (defun idlwave-shell-closeall (&optional arg) "Close all open files." (interactive "P") - (idlwave-shell-send-command "close,/all")) + (idlwave-shell-send-command "close,/all" nil + (idlwave-shell-hide-p 'misc) nil t)) (defun idlwave-shell-quit (&optional arg) "Exit the idl process after confirmation. @@ -1619,7 +1961,7 @@ With prefix ARG, exit without confirmation." (error nil))))) (defun idlwave-shell-reset (&optional hidden) - "Reset IDL. Return to main level and destroy the leaftover variables. + "Reset IDL. Return to main level and destroy the leftover variables. This issues the following commands: RETALL WIDGET_CONTROL,/RESET @@ -1627,14 +1969,17 @@ CLOSE, /ALL HEAP_GC, /VERBOSE" ;; OBJ_DESTROY, OBJ_VALID() FIXME: should this be added? (interactive "P") - (message "Resetting IDL") - (setq idlwave-shell-calling-stack-index 0) - (idlwave-shell-send-command "retall" nil hidden) - (idlwave-shell-send-command "widget_control,/reset" nil hidden) - (idlwave-shell-send-command "close,/all" nil hidden) - ;; (idlwave-shell-send-command "obj_destroy, obj_valid()" nil hidden) - (idlwave-shell-send-command "heap_gc,/verbose" nil hidden) - (idlwave-shell-display-line nil)) + (when (or idlwave-shell-reset-no-prompt + (yes-or-no-p "Really Reset IDL and discard current session? ")) + (message "Resetting IDL") + (setq idlwave-shell-calling-stack-index 0) + ;; Give widget exit handlers a chance + (idlwave-shell-send-command "retall" nil hidden) + (idlwave-shell-send-command "widget_control,/reset" nil hidden) + (idlwave-shell-send-command "close,/all" nil hidden) + ;; (idlwave-shell-send-command "obj_destroy, obj_valid()" nil hidden) + (idlwave-shell-send-command "heap_gc,/verbose" nil hidden) + (idlwave-shell-display-line nil))) (defun idlwave-shell-path-filter () ;; Convert the output of the path query into a list of directories @@ -1656,7 +2001,7 @@ HEAP_GC, /VERBOSE" (let ((text idlwave-shell-command-output) (start 0) sep sep-re file type spec specs name cs key keys class entry) -; (message "GOT: %s" text) ;?????????????????????? + ;; (message "GOT: %s" text) ;?????????????????????? ;; Initialize variables (setq idlwave-compiled-routines nil idlwave-unresolved-routines nil) @@ -1669,15 +2014,16 @@ HEAP_GC, /VERBOSE" text (substring text (match-end 0))) ;; Set dummy values and kill the text (setq sep "@" sep-re "@ *" text "") - (message "Routine Info warning: No match for BEGIN line in \n>>>>\n%s\n<<<<\n" - idlwave-shell-command-output)) + (if idlwave-idlwave_routine_info-compiled + (message + "Routine Info warning: No match for BEGIN line in \n>>>\n%s\n<<<\n" + idlwave-shell-command-output))) (if (string-match "^>>>END OF IDLWAVE ROUTINE INFO.*" text) (setq text (substring text 0 (match-beginning 0))) - (message "Routine Info warning: No match for END line in \n>>>>\n%s\n<<<<\n" - idlwave-shell-command-output)) - (if (string-match "\\S-" text) - ;; Obviously, the pro worked. Make a note that we have it now. - (setq idlwave-idlwave_routine_info-compiled t)) + (if idlwave-idlwave_routine_info-compiled + (message + "Routine Info warning: No match for END line in \n>>>\n%s\n<<<\n" + idlwave-shell-command-output))) ;; Match the output lines (while (string-match "^IDLWAVE-\\(PRO\\|FUN\\): \\(.*\\)" text start) (setq start (match-end 0)) @@ -1698,23 +2044,15 @@ HEAP_GC, /VERBOSE" file (if (equal file "") nil file) keys (mapcar (lambda (x) (list (idlwave-sintern-keyword (car x) t))) keys)) - ;; 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)) - + ;; In the following ignore routines already defined in buffers, ;; assuming that if the buffer stuff differs, it is a "new" - ;; version. + ;; version, not yet compiled, and should take precedence. ;; We could do the same for the library to avoid duplicates - ;; but I think frequently a user might have several versions of ;; the same function in different programs, and in this case the - ;; compiled one will be the best guess of all version. + ;; compiled one will be the best guess of all versions. ;; Therefore, we leave duplicates of library routines in. - (cond ((string= name "$MAIN$")) ; ignore this one ((and (string= type "PRO") ;; FIXME: is it OK to make the buffer routines dominate? @@ -1725,11 +2063,18 @@ HEAP_GC, /VERBOSE" ;;(not (idlwave-rinfo-assq name 'pro class ;; idlwave-library-routines)) ) - (setq entry (list name 'pro class (cons 'compiled file) cs keys)) + (setq entry (list name 'pro class + (cons 'compiled + (if file + (list + (file-name-nondirectory file) + (idlwave-sintern-dir + (file-name-directory file))))) + cs (cons nil keys))) (if file (push entry idlwave-compiled-routines) (push entry idlwave-unresolved-routines))) - + ((and (string= type "FUN") ;; FIXME: is it OK to make the buffer routines dominate? (or t (not file) @@ -1739,7 +2084,14 @@ HEAP_GC, /VERBOSE" ;; (not (idlwave-rinfo-assq name 'fun class ;; idlwave-library-routines)) ) - (setq entry (list name 'fun class (cons 'compiled file) cs keys)) + (setq entry (list name 'fun class + (cons 'compiled + (if file + (list + (file-name-nondirectory file) + (idlwave-sintern-dir + (file-name-directory file))))) + cs (cons nil keys))) (if file (push entry idlwave-compiled-routines) (push entry idlwave-unresolved-routines)))))) @@ -1752,75 +2104,127 @@ HEAP_GC, /VERBOSE" Change the default directory for the process buffer to concur." (save-excursion (set-buffer (idlwave-shell-buffer)) - (if (string-match "Current Directory: *\\(\\S-*\\) *$" + (if (string-match ",___cur[\n\r ]+\\([^\n\r]+\\)[\n\r]" idlwave-shell-command-output) (let ((dir (substring idlwave-shell-command-output (match-beginning 1) (match-end 1)))) - (message "Setting Emacs wd to %s" dir) +; (message "Setting Emacs working dir to %s" dir) (setq idlwave-shell-default-directory dir) (setq default-directory (file-name-as-directory dir)))))) +(defvar idlwave-shell-get-object-class nil) +(defun idlwave-shell-get-object-class (apos) + "Query the shell for the class of the object before point." + (let ((bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) + (bol (save-excursion (forward-line 0) (point))) + expression) + (save-excursion + (goto-char apos) + (setq expression (buffer-substring + (catch 'exit + (while t + (if (not (re-search-backward + "[^][.A-Za-z0-9_() ]" bos t)) + (throw 'exit bos)) ;ran into bos + (if (not (idlwave-is-pointer-dereference bol)) + (throw 'exit (1+ (point)))))) + apos))) + (when (not (string= expression "")) + (setq idlwave-shell-get-object-class nil) + (idlwave-shell-send-command + (concat "if obj_valid(" expression ") then print,obj_class(" + expression ")") + 'idlwave-shell-parse-object-class + 'hide 'wait) + ;; If we don't know anything about the class, update shell routines + (if (and idlwave-shell-get-object-class + (not (assoc-string idlwave-shell-get-object-class + (idlwave-class-alist) t))) + (idlwave-shell-maybe-update-routine-info)) + idlwave-shell-get-object-class))) + +(defun idlwave-shell-parse-object-class () + "Parse the output of the obj_class command." + (let ((match "obj_class([^\n\r]+[\n\r ]")) + (if (string-match (concat match "\\([A-Za-z_0-9]+\\) *[\n\r]\\(" + idlwave-shell-prompt-pattern "\\)") + idlwave-shell-command-output) + (setq idlwave-shell-get-object-class + (match-string 1 idlwave-shell-command-output))))) + +(defvar idlwave-sint-sysvars nil) +(idlwave-new-sintern-type 'execcomm) + (defun idlwave-shell-complete (&optional arg) "Do completion in the idlwave-shell buffer. Calls `idlwave-shell-complete-filename' after some executive commands or in strings. Otherwise, calls `idlwave-complete' to complete modules and keywords." -;;FIXME: batch files? (interactive "P") - (let (cmd) + (let (exec-cmd) (cond - ((setq cmd (idlwave-shell-executive-command)) + ((and + (setq exec-cmd (idlwave-shell-executive-command)) + (cdr exec-cmd) + (member (upcase (cdr exec-cmd)) + '(".R" ".RU" ".RUN" ".RN" ".RNE" ".RNEW" + ".COM" ".COMP" ".COMPI" ".COMPIL" ".COMPILE"))) ;; We are in a command line with an executive command - (if (member (upcase cmd) - '(".R" ".RU" ".RUN" ".RN" ".RNE" ".RNEW" - ".COM" ".COMP" ".COMPI" ".COMPIL" ".COMPILE")) - ;; This command expects file names - (idlwave-shell-complete-filename))) + (idlwave-shell-complete-filename)) + + ((car-safe exec-cmd) + (setq idlwave-completion-help-info + '(idlwave-shell-complete-execcomm-help)) + (idlwave-complete-in-buffer 'execcomm 'execcomm + idlwave-executive-commands-alist nil + "Select an executive command" + "system variable")) + + ((idlwave-shell-batch-command) + (idlwave-shell-complete-filename)) + + ((idlwave-shell-shell-command) + (idlwave-shell-complete-filename)) + ((and (idlwave-shell-filename-string) (save-excursion (beginning-of-line) (let ((case-fold-search t)) - (not (looking-at ".*obj_new")))) - ;; In a string, could be a file name to here - (idlwave-shell-complete-filename))) + (not (looking-at ".*obj_new"))))) + (idlwave-shell-complete-filename)) + (t ;; Default completion of modules and keywords (idlwave-complete arg))))) +;; Get rid of opaque dynamic variable passing of link? +(defvar link) ;dynamic variable +(defun idlwave-shell-complete-execcomm-help (mode word) + (let ((word (or (nth 1 idlwave-completion-help-info) word)) + (entry (assoc-string word idlwave-executive-commands-alist t))) + (cond + ((eq mode 'test) + (and (stringp word) entry (cdr entry))) + ((eq mode 'set) + (if entry (setq link (cdr entry)))) ;; setting dynamic variable!!! + (t (error "This should not happen"))))) + (defun idlwave-shell-complete-filename (&optional arg) "Complete a file name at point if after a file name. We assume that we are after a file name when completing one of the -args of an executive .run, .rnew or .compile. Also, in a string -constant we complete file names. Otherwise return nil, so that -other completion functions can do their work." - ;; Comint does something funny with the default directory, - ;; so we set it here from out safe own variable - (setq default-directory - (file-name-as-directory idlwave-shell-default-directory)) - (if (not idlwave-shell-wd-is-synched) - ;; Some IDL stuff has been executed since last update, so we need to - ;; do it again. - (idlwave-shell-send-command - idlwave-shell-dirstack-query - `(progn - (idlwave-shell-filter-directory) - (setq idlwave-shell-wd-is-synched t) - (switch-to-buffer (idlwave-shell-buffer)) - (goto-char ,(point)) ;; This is necesary on Emacs, don't know why - ;; after the update, we immediately redo the completion, so the - ;; user will hardly notice we did the update. - (idlwave-shell-complete-filename)) - 'hide) - (let* ((comint-file-name-chars idlwave-shell-file-name-chars) - (completion-ignore-case (default-value 'completion-ignore-case))) - (comint-dynamic-complete-filename)))) +args of an executive .run, .rnew or .compile." + ;; CWD might have changed, resync, to set default directory + (idlwave-shell-resync-dirs) + (let ((comint-file-name-chars idlwave-shell-file-name-chars)) + (comint-dynamic-complete-as-filename))) (defun idlwave-shell-executive-command () "Return the name of the current executive command, if any." (save-excursion (idlwave-beginning-of-statement) - (if (looking-at "[ \t]*\\([.][^ \t\n\r]*\\)") - (match-string 1)))) + (cons (looking-at "[ \t]*\\.") + (if (looking-at "[ \t]*[.]\\([^ \t\n\r]+\\)[ \t]") + (match-string 1))))) (defun idlwave-shell-filename-string () "Return t if in a string and after what could be a file name." @@ -1831,9 +2235,22 @@ other completion functions can do their work." ;; Check of the next char is a string delimiter (memq (preceding-char) '(?\' ?\"))))) -;;; -;;; This section contains code for debugging IDL programs. -------------------- -;;; +(defun idlwave-shell-batch-command () + "Returns t if we're in a batch command statement like @foo" + (let ((limit (save-excursion (beginning-of-line) (point)))) + (save-excursion + ;; Skip backwards over filename + (skip-chars-backward idlwave-shell-file-name-chars limit) + (skip-chars-backward " \t" limit) + (and (eq (preceding-char) ?@) (not (idlwave-in-quote)))))) + +(defun idlwave-shell-shell-command () + "Returns t if we're in a shell command statement like $ls" + (save-excursion + (idlwave-beginning-of-statement) + (looking-at "\\$"))) + +;; Debugging Commands ------------------------------------------------------ (defun idlwave-shell-redisplay (&optional hide) "Tries to resync the display with where execution has stopped. @@ -1883,12 +2300,15 @@ overlays." (- nmin))))) (setq idlwave-shell-calling-stack-routine (nth 2 (nth idlwave-shell-calling-stack-index stack))) + + ;; force edebug for this frame if we're in that mode already (idlwave-shell-display-line - (nth idlwave-shell-calling-stack-index stack)) - (message (or message - (format "In routine %s (stack level %d)" - idlwave-shell-calling-stack-routine - (- idlwave-shell-calling-stack-index)))))) + (nth idlwave-shell-calling-stack-index stack) nil + (if idlwave-shell-electric-debug-mode 'force)) + (message "%s" (or message + (format "In routine %s (stack level %d)" + idlwave-shell-calling-stack-routine + (- idlwave-shell-calling-stack-index)))))) (defun idlwave-shell-stack-up () "Display the source code one step up the calling stack." @@ -1924,23 +2344,38 @@ used. Does nothing if the resulting frame is nil." "Check that frame is for an existing file." (file-readable-p (car frame))) -(defun idlwave-shell-display-line (frame &optional col) - "Display FRAME file in other window with overlay arrow. - -FRAME is a list of file name, line number, and subroutine name. -If FRAME is nil then remove overlay." +(defun idlwave-shell-stop-line-pending () + ;; Temporarily change the color of the stop line overlay + (if idlwave-shell-stop-line-overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + (if idlwave-shell-electric-debug-mode + 'idlwave-shell-pending-electric-stop + 'idlwave-shell-pending-stop)))) + +(defvar idlwave-shell-suppress-electric-debug nil) +(defun idlwave-shell-display-line (frame &optional col debug) + "display frame file in other window with overlay arrow. + +frame is a list of file name, line number, and subroutine name. if +frame is nil then remove overlay. if col is set, move point to that +column in the line. if debug is non-nil, enable the electric debug +mode. if it is 'disable, do not enable no matter what the setting of +'idlwave-shell-automatic-electric-debug'. if it is 'force, enable no +matter what the settings of that variable." (if (not frame) - ;; Remove stop-line overlay from old position + ;; remove stop-line overlay from old position (progn (setq overlay-arrow-string nil) (setq idlwave-shell-mode-line-info nil) (setq idlwave-shell-is-stopped nil) (if idlwave-shell-stop-line-overlay - (delete-overlay idlwave-shell-stop-line-overlay))) + (delete-overlay idlwave-shell-stop-line-overlay)) + ;; turn off electric debug everywhere, if it's on + (idlwave-shell-electric-debug-all-off)) (if (not (idlwave-shell-valid-frame frame)) - ;; FIXME: errors are dangerous in shell filters. But I think I + ;; fixme: errors are dangerous in shell filters. but i think i ;; have never encountered this one. - (error (concat "Invalid frame - unable to access file: " (car frame))) + (error (concat "invalid frame - unable to access file: " (car frame))) ;;; ;;; buffer : the buffer to display a line in. ;;; select-shell: current buffer is the shell. @@ -1952,53 +2387,77 @@ If FRAME is nil then remove overlay." (nth 2 frame)))) (let* ((buffer (idlwave-find-file-noselect (car frame) 'shell)) (select-shell (equal (buffer-name) (idlwave-shell-buffer))) - window pos) + window pos electric) - ;; First make sure the shell window is visible + ;; first make sure the shell window is visible (idlwave-display-buffer (idlwave-shell-buffer) nil (idlwave-shell-shell-frame)) - ;; Now display the buffer and remember which window it is. + ;; now display the buffer and remember which window it is. (setq window (idlwave-display-buffer buffer nil (idlwave-shell-source-frame))) - ;; Enter the buffer and mark the line + ;; enter the buffer and mark the line (save-excursion (set-buffer buffer) (save-restriction (widen) (goto-line (nth 1 frame)) + (forward-line 0) (setq pos (point)) (setq idlwave-shell-is-stopped t) + (if idlwave-shell-stop-line-overlay - ;; Move overlay - (move-overlay idlwave-shell-stop-line-overlay - (point) (save-excursion (end-of-line) (point)) - (current-buffer)) - ;; Use the arrow instead, but only if marking is wanted. + (progn + ;; restore face and move overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + (if idlwave-shell-electric-debug-mode + idlwave-shell-electric-stop-line-face + idlwave-shell-stop-line-face)) + (move-overlay idlwave-shell-stop-line-overlay + (point) (save-excursion (end-of-line) (point)) + (current-buffer))) + ;; use the arrow instead, but only if marking is wanted. (if idlwave-shell-mark-stop-line (setq overlay-arrow-string idlwave-shell-overlay-arrow)) (or overlay-arrow-position ; create the marker if necessary (setq overlay-arrow-position (make-marker))) - (set-marker overlay-arrow-position (point) buffer))) - - ;; If the point is outside the restriction, widen the buffer. + (set-marker overlay-arrow-position (point) buffer))) + + ;; if the point is outside the restriction, widen the buffer. (if (or (< pos (point-min)) (> pos (point-max))) (progn (widen) (goto-char pos))) - ;; If we have the column of the error, move the cursor there. + ;; if we have the column of the error, move the cursor there. (if col (move-to-column col)) - (setq pos (point))) - + (setq pos (point)) + + ;; enter electric debug mode, if not prohibited and not in + ;; it already + (when (and (not idlwave-shell-electric-debug-mode) + (or (eq debug 'force) + (and + (not (eq debug 'disable)) ;; explicitly disabled + (or + (eq idlwave-shell-automatic-electric-debug t) + (and + (eq idlwave-shell-automatic-electric-debug + 'breakpoint) + (not (eq idlwave-shell-current-state 'error)))) + (not idlwave-shell-suppress-electric-debug)))) + (idlwave-shell-electric-debug-mode t)) + (setq electric idlwave-shell-electric-debug-mode)) + ;; Make sure pos is really displayed in the window. - (set-window-point window pos) - + (set-window-point window pos) + ;; If we came from the shell, go back there. Otherwise select - ;; the window where the error is displayed. - (if (and (equal (buffer-name) (idlwave-shell-buffer)) - (not select-shell)) + ;; the window where the error/halt is displayed. + (if (or (and idlwave-shell-electric-zap-to-file electric) + (and (equal (buffer-name) (idlwave-shell-buffer)) + (not select-shell))) (select-window window)))))) @@ -2007,8 +2466,10 @@ If FRAME is nil then remove overlay." (interactive "p") (or (not arg) (< arg 1) (setq arg 1)) + (idlwave-shell-stop-line-pending) (idlwave-shell-send-command - (concat ".s " (if (integerp arg) (int-to-string arg) arg)))) + (concat ".s " (if (integerp arg) (int-to-string arg) arg)) + nil (if (idlwave-shell-hide-p 'debug) 'mostly) nil t)) (defun idlwave-shell-stepover (arg) "Stepover one source line. @@ -2017,10 +2478,13 @@ Uses IDL's stepover executive command which does not enter called functions." (interactive "p") (or (not arg) (< arg 1) (setq arg 1)) + (idlwave-shell-stop-line-pending) (idlwave-shell-send-command - (concat ".so " (if (integerp arg) (int-to-string arg) arg)))) + (concat ".so " (if (integerp arg) (int-to-string arg) arg)) + nil (if (idlwave-shell-hide-p 'debug) 'mostly) nil t)) -(defun idlwave-shell-break-here (&optional count cmd) +(defun idlwave-shell-break-here (&optional count cmd condition disabled + no-show) "Set breakpoint at current line. If Count is nil then an ordinary breakpoint is set. We treat a count @@ -2028,17 +2492,20 @@ of 1 as a temporary breakpoint using the ONCE keyword. Counts greater than 1 use the IDL AFTER=count keyword to break only after reaching the statement count times. -Optional argument CMD is a list or function to evaluate upon reaching -the breakpoint." - +Optional argument CMD is a list or function to evaluate upon reaching +the breakpoint. CONDITION is a break condition, and DISABLED, if +non-nil disables the breakpoint" (interactive "P") - (if (listp count) - (setq count nil)) + (when (listp count) + (if (equal (car count) 4) + (setq condition (read-string "Break Condition: "))) + (setq count nil)) (idlwave-shell-set-bp ;; Create breakpoint (idlwave-shell-bp (idlwave-shell-current-frame) - (list count cmd) - (idlwave-shell-current-module)))) + (list count cmd condition disabled) + (idlwave-shell-current-module)) + no-show)) (defun idlwave-shell-set-bp-check (bp) "Check for failure to set breakpoint. @@ -2046,31 +2513,36 @@ This is run on `idlwave-shell-post-command-hook'. Offers to recompile the procedure if we failed. This usually fixes the problem with not being able to set the breakpoint." ;; Scan for message - (if (and idlwave-shell-command-output - (string-match "% BREAKPOINT: *Unable to find code" - idlwave-shell-command-output)) - ;; Offer to recompile - (progn + (if idlwave-shell-command-output + (cond + ((string-match "% BREAKPOINT: *Unable to find code" + idlwave-shell-command-output) + ;; Offer to recompile (if (progn (beep) (y-or-n-p (concat "Okay to recompile file " - (idlwave-shell-bp-get bp 'file) " "))) + (idlwave-shell-bp-get bp 'file) "?"))) ;; Recompile (progn ;; Clean up before retrying (idlwave-shell-command-failure) (idlwave-shell-send-command - (concat ".run " (idlwave-shell-bp-get bp 'file)) nil nil) + (concat ".run \"" (idlwave-shell-bp-get bp 'file) "\"") nil + (if (idlwave-shell-hide-p 'run) 'mostly) nil t) ;; Try setting breakpoint again (idlwave-shell-set-bp bp)) (beep) (message "Unable to set breakpoint.") - (idlwave-shell-command-failure) - ) - ;; return non-nil if no error found - nil) - 'okay)) + (idlwave-shell-command-failure)) + nil) + + ((string-match "% Syntax error" idlwave-shell-command-output) + (message "Syntax error in condition.") + (idlwave-shell-command-failure) + nil) + + (t 'okay)))) (defun idlwave-shell-command-failure () "Do any necessary clean up when an IDL command fails. @@ -2081,36 +2553,49 @@ breakpoint can not be set." ;; Clear pending commands (setq idlwave-shell-pending-commands nil)) -(defun idlwave-shell-cont () +(defun idlwave-shell-cont (&optional no-show) "Continue executing." (interactive) - (idlwave-shell-send-command ".c" '(idlwave-shell-redisplay 'hide))) + (idlwave-shell-stop-line-pending) + (idlwave-shell-send-command ".c" (unless no-show + '(idlwave-shell-redisplay 'hide)) + (if (idlwave-shell-hide-p 'debug) 'mostly) + nil t)) (defun idlwave-shell-go () "Run .GO. This starts the main program of the last compiled file." (interactive) - (idlwave-shell-send-command ".go" '(idlwave-shell-redisplay 'hide))) + (idlwave-shell-stop-line-pending) + (idlwave-shell-send-command ".go" '(idlwave-shell-redisplay 'hide) + (if (idlwave-shell-hide-p 'debug) 'mostly) + nil t)) (defun idlwave-shell-return () "Run .RETURN (continue to next return, but stay in subprogram)." (interactive) - (idlwave-shell-send-command ".return" '(idlwave-shell-redisplay 'hide))) + (idlwave-shell-stop-line-pending) + (idlwave-shell-send-command ".return" '(idlwave-shell-redisplay 'hide) + (if (idlwave-shell-hide-p 'debug) 'mostly) + nil t)) (defun idlwave-shell-skip () "Run .SKIP (skip one line, then step)." (interactive) - (idlwave-shell-send-command ".skip" '(idlwave-shell-redisplay 'hide))) + (idlwave-shell-stop-line-pending) + (idlwave-shell-send-command ".skip" '(idlwave-shell-redisplay 'hide) + (if (idlwave-shell-hide-p 'debug) 'mostly) + nil t)) -(defun idlwave-shell-clear-bp (bp) +(defun idlwave-shell-clear-bp (bp &optional no-query) "Clear breakpoint BP. Clears in IDL and in `idlwave-shell-bp-alist'." (let ((index (idlwave-shell-bp-get bp))) (if index (progn (idlwave-shell-send-command - (concat "breakpoint,/clear," - (if (integerp index) (int-to-string index) index))) - (idlwave-shell-bp-query))))) + (concat "breakpoint,/clear," (int-to-string index)) + nil (idlwave-shell-hide-p 'breakpoint) nil t) + (unless no-query (idlwave-shell-bp-query)))))) (defun idlwave-shell-current-frame () "Return a list containing the current file name and line point is in. @@ -2137,57 +2622,100 @@ Returns nil if unable to obtain a module name." (widen) (save-excursion (if (idlwave-prev-index-position) - (upcase (idlwave-unit-name))))))) + (let* ((module (idlwave-what-module)) + (name (idlwave-make-full-name (nth 2 module) (car module))) + (type (nth 1 module))) + (list (upcase name) type))))))) (defun idlwave-shell-clear-current-bp () "Remove breakpoint at current line. This command can be called from the shell buffer if IDL is currently stopped at a breakpoint." (interactive) - (let ((bp (idlwave-shell-find-bp (idlwave-shell-current-frame)))) - (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")))))) + (let ((bp (idlwave-shell-find-current-bp))) + (if bp (idlwave-shell-clear-bp bp)))) + +(defun idlwave-shell-toggle-enable-current-bp (&optional bp force + no-update) + "Disable or enable current breakpoint or a breakpoint passed in BP. +If FORCE is 'disable or 'enable, for that condition instead of +toggling. If NO-UPDATE is non-nil, don't update the breakpoint +list after toggling." + (interactive) + (let* ((bp (or bp (idlwave-shell-find-current-bp))) + (disabled (idlwave-shell-bp-get bp 'disabled))) + (cond ((eq force 'disable) (setq disabled nil)) + ((eq force 'enable) (setq disabled t))) + (when bp + (setf (nth 3 (cdr (cdr bp))) (not disabled)) + (idlwave-shell-send-command + (concat "breakpoint," + (if disabled "/enable," "/disable,") + (int-to-string (idlwave-shell-bp-get bp))) + nil (idlwave-shell-hide-p 'breakpoint) nil t) + (unless no-update (idlwave-shell-bp-query))))) + +(defun idlwave-shell-enable-all-bp (&optional enable no-update bpl) + "Disable all breakpoints we know about which need disabling. +If ENABLE is non-nil, enable them instead." + (let ((bpl (or bpl idlwave-shell-bp-alist)) disabled modified) + (while bpl + (setq disabled (idlwave-shell-bp-get (car bpl) 'disabled)) + (when (idlwave-xor (not disabled) (eq enable 'enable)) + (idlwave-shell-toggle-enable-current-bp + (car bpl) (if (eq enable 'enable) 'enable 'disable) no-update) + (push (car bpl) modified)) + (setq bpl (cdr bpl))) + (unless no-update (idlwave-shell-bp-query)) + modified)) + (defun idlwave-shell-to-here () "Set a breakpoint with count 1 then continue." (interactive) - (idlwave-shell-break-here 1) - (idlwave-shell-cont)) + ;; temporarily disable all other breakpoints + (let ((disabled (idlwave-shell-enable-all-bp 'disable 'no-update))) + (idlwave-shell-break-here 1 nil nil nil 'no-show) + (idlwave-shell-cont 'no-show) + (idlwave-shell-enable-all-bp 'enable 'no-update disabled)) + (idlwave-shell-redisplay)) ; sync up everything at the end + +(defun idlwave-shell-break-this-module (&optional arg) + (interactive "P") + (save-excursion + (idlwave-beginning-of-subprogram) + (idlwave-shell-break-here arg))) -(defun idlwave-shell-break-in (&optional module) +(defun idlwave-shell-break-in () "Look for a module name near point and set a break point for it. The command looks for an identifier near point and sets a breakpoint -for the first line of the corresponding module." +for the first line of the corresponding module. If MODULE is `t', set +in the current routine." (interactive) - ;; get the identifier - (let (module) - (save-excursion - (skip-chars-backward "a-zA-Z0-9_$") - (if (looking-at idlwave-identifier) - (setq module (match-string 0)) - (error "No identifier at point"))) - (idlwave-shell-send-command - idlwave-shell-sources-query - `(progn - (idlwave-shell-sources-filter) - (idlwave-shell-set-bp-in-module ,module)) - 'hide))) - -(defun idlwave-shell-set-bp-in-module (module) + (let* ((module (idlwave-fix-module-if-obj_new (idlwave-what-module))) + (type (nth 1 module)) + (name (car module)) + (class (nth 2 module))) + (if module + (progn + (setq module (idlwave-make-full-name class name)) + (idlwave-shell-module-source-query module type) + (idlwave-shell-set-bp-in-module name type class)) + (error "No identifier at point")))) + + +(defun idlwave-shell-set-bp-in-module (name type class) "Set breakpoint in module. Assumes that `idlwave-shell-sources-alist' contains an entry for that module." - (let ((source-file (car-safe - (cdr-safe - (assoc (upcase module) - idlwave-shell-sources-alist)))) - buf) + (let* ((module (idlwave-make-full-name class name)) + (source-file + (car-safe (cdr-safe + (or + (assoc (upcase module) + idlwave-shell-sources-alist) + (nth 3 (idlwave-best-rinfo-assoc name type class + (idlwave-routines))))))) + buf) (if (or (not source-file) (not (file-regular-p source-file)) (not (setq buf @@ -2244,7 +2772,40 @@ Sets a breakpoint with count 1 at end of block, then continues." "Attempt to run until this procedure exits. Runs to the last statement and then steps 1 statement. Use the .out command." (interactive) - (idlwave-shell-send-command (concat ".o"))) + (idlwave-shell-send-command ".o" nil + (if (idlwave-shell-hide-p 'debug) 'mostly) + nil t)) + +(defun idlwave-shell-goto-previous-bp () + "Move to the previous breakpoint in the buffer." + (interactive) + (idlwave-shell-move-to-bp -1)) +(defun idlwave-shell-goto-next-bp () + "Move to the next breakpoint in the buffer." + (interactive) + (idlwave-shell-move-to-bp 1)) + +(defun idlwave-shell-move-to-bp (dir) + "Move to the next or previous breakpoint, depending on direction DIR." + (let* ((frame (idlwave-shell-current-frame)) + (file (car frame)) + (orig-bp-line (nth 1 frame)) + (bp-alist idlwave-shell-bp-alist) + (orig-func (if (> dir 0) '> '<)) + (closer-func (if (> dir 0) '< '>)) + bp got-bp bp-line cur-line) + (while (setq bp (pop bp-alist)) + (when (string= file (car (car bp))) + (setq got-bp 1) + (setq cur-line (nth 1 (car bp))) + (if (and + (funcall orig-func cur-line orig-bp-line) + (or (not bp-line) (funcall closer-func cur-line bp-line))) + (setq bp-line cur-line)))) + (unless bp-line (error "No further breakpoints")) + (goto-line bp-line))) + +;; Examine Commands ------------------------------------------------------ (defun idlwave-shell-help-expression (arg) "Print help on current expression. See `idlwave-shell-print'." @@ -2256,14 +2817,39 @@ Runs to the last statement and then steps 1 statement. Use the .out command." `(lambda (event) "Expansion function for expression examination." (interactive "e") - (let ((transient-mark-mode t) - (zmacs-regions t) - (tracker (if (featurep 'xemacs) 'mouse-track - 'mouse-drag-region))) + (let* ((drag-track (fboundp 'mouse-drag-track)) + (transient-mark-mode t) + (zmacs-regions t) + (tracker (if (featurep 'xemacs) + (if (fboundp + 'default-mouse-track-event-is-with-button) + 'idlwave-xemacs-hack-mouse-track + 'mouse-track) + ;; Emacs 22 no longer completes the drag with + ;; mouse-drag-region, without an additional + ;; event. mouse-drag-track does so. + (if drag-track 'mouse-drag-track 'mouse-drag-region)))) (funcall tracker event) - (idlwave-shell-print (if (idlwave-region-active-p) '(16) nil) + (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil) ,help ,ev)))) +;;; Begin terrible hack section -- XEmacs tests for button2 explicitly +;;; on drag events, calling drag-n-drop code if detected. Ughhh... +(defun idlwave-default-mouse-track-event-is-with-button (event n) + t) + +(defun idlwave-xemacs-hack-mouse-track (event) + (if (featurep 'xemacs) + (let ((oldfunc (symbol-function + 'default-mouse-track-event-is-with-button))) + (unwind-protect + (progn + (fset 'default-mouse-track-event-is-with-button + 'idlwave-default-mouse-track-event-is-with-button) + (mouse-track event)) + (fset 'default-mouse-track-event-is-with-button oldfunc))))) +;;; End terrible hack section + (defun idlwave-shell-mouse-print (event) "Print value of variable at the mouse position, with `help'" (interactive "e") @@ -2285,15 +2871,11 @@ Runs to the last statement and then steps 1 statement. Use the .out command." (interactive) (idlwave-shell-print nil ,help))) -(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)) - (defvar idlwave-shell-examine-label nil - "Label to include with examine text if separate.") + "Label to include with examine text if in a separate buffer.") +(defvar idlwave-shell-examine-completion-list nil) -(defun idlwave-shell-print (arg &optional help ev) +(defun idlwave-shell-print (arg &optional help ev complete-help-type) "Print current expression. With HELP non-nil, show help on expression. If HELP is a string, @@ -2301,6 +2883,9 @@ the expression will be put in place of ___, e.g.: print,size(___,/DIMENSIONS) +HELP can also be a cons cell ( NAME . STRING ) in which case NAME will +be used to label the help print-out. + Otherwise, print is called on the expression. An expression is an identifier plus 1 pair of matched parentheses @@ -2311,13 +2896,21 @@ identifier. If point is at the beginning or within an expression return the inner-most containing expression, otherwise, return the preceding expression. -With prefix arg ARG prompt for an expression. +With prefix arg, or if transient mode set and the region is defined, +use the current region as the expression. -With double prefix arg, use the current region. +With double prefix arg ARG prompt for an expression. If EV is a valid event passed, pop-up a list from -idlw-shell-examine-alist from which to select the help command text." +idlw-shell-examine-alist from which to select the help command text. +If instead COMPLETE-HELP-TYPE is non-nil, choose from +idlw-shell-examine-alist via mini-buffer shortcut key." (interactive "P") + + ;; For speed: assume the helper routine hasn't been lost, e.g. with + ;; .FULL_RESET_SESSION. We'll recover if necessary + (unless idlwave-idlwave_routine_info-compiled + (idlwave-shell-compile-helper-routines)) (save-excursion (let* ((process (get-buffer-process (current-buffer))) (process-mark (if process (process-mark process))) @@ -2327,16 +2920,16 @@ idlw-shell-examine-alist from which to select the help command text." (format " [-%d:%s]" idlwave-shell-calling-stack-index idlwave-shell-calling-stack-routine))) - expr beg end cmd examine-hook) + expr beg end cmd) (cond - ((and (equal arg '(16)) + ((equal arg '(16)) + (setq expr (read-string "Expression: "))) + ((and (or arg (idlwave-region-active-p)) (< (- (region-end) (region-beginning)) 2000)) (setq beg (region-beginning) end (region-end))) - (arg - (setq expr (read-string "Expression: "))) (t - (idlwave-with-special-syntax1 + (idlwave-with-special-syntax ;; Move to beginning of current or previous expression (if (looking-at "\\<\\|(") ;; At beginning of expression, don't move backwards unless @@ -2370,10 +2963,6 @@ idlw-shell-examine-alist from which to select the help command text." (current-buffer)) (add-hook 'pre-command-hook 'idlwave-shell-delete-expression-overlay)) - (setq examine-hook - (if idlwave-shell-separate-examine-output - 'idlwave-shell-examine-display - 'idlwave-shell-examine-highlight)) (add-hook 'pre-command-hook 'idlwave-shell-delete-output-overlay) @@ -2381,50 +2970,79 @@ idlw-shell-examine-alist from which to select the help command text." (while (string-match "\n[ \t]*\\(;.*\\)?\r*\n" expr) (setq expr (replace-match "\n" t t expr))) ;; Concatenate continuation lines - (while (string-match "[ \t]*\\$.*\\(;.*\\)?\\(\n[ \t]*\\|$\\)" expr) + (while (string-match "[ \t]*\\$[ \t]*\\(;.*\\)?\\(\n[ \t]*\\|$\\)" expr) (setq expr (replace-match "" t t expr))) ;; Remove final newline (if (string-match "\n[ \t\r]*\\'" expr) (setq expr (replace-match "" t t expr))) - ;; Pop-up the examine selection list, if appropriate - (if (and ev idlwave-shell-examine-alist) - (let* ((help-cons - (assoc - (idlwave-popup-select - ev (mapcar 'car idlwave-shell-examine-alist) - "Examine with") - idlwave-shell-examine-alist))) - (setq help (cdr help-cons)) - (if idlwave-shell-separate-examine-output - (setq idlwave-shell-examine-label - (concat - (format "==>%s<==\n%s:" expr (car help-cons)) - stack-label "\n")))) - (setq idlwave-shell-examine-label - (concat - (format "==>%s<==\n%s:" expr - (cond ((null help) "print") - ((stringp help) help) - (t (symbol-name help)))) - stack-label "\n"))) - - ;; Send the command - (if stack-label - (setq cmd (idlwave-retrieve-expression-from-level - expr - idlwave-shell-calling-stack-index - idlwave-shell-calling-stack-routine - help)) - (setq cmd (idlwave-shell-help-statement help expr))) - ;(idlwave-shell-recenter-shell-window) - (idlwave-shell-send-command - cmd - examine-hook - (if idlwave-shell-separate-examine-output 'hide))))) + + (catch 'exit + ;; Pop-up or complete on the examine selection list, if appropriate + (if (or + complete-help-type + (and ev idlwave-shell-examine-alist) + (consp help)) + (let ((help-cons + (if (consp help) help + (assoc + ;; A cons from either a pop-up or mini-buffer completion + (if complete-help-type + (idlwave-one-key-select 'idlwave-shell-examine-alist + "Examine with: " 1.5) +;; (idlwave-completing-read +;; "Examine with: " +;; idlwave-shell-examine-alist nil nil nil +;; 'idlwave-shell-examine-completion-list +;; "Print") + (idlwave-popup-select + ev + (mapcar 'car idlwave-shell-examine-alist) + "Examine with")) + idlwave-shell-examine-alist)))) + (setq help (cdr help-cons)) + (if (null help) (throw 'exit nil)) + (if idlwave-shell-separate-examine-output + (setq idlwave-shell-examine-label + (concat + (format "==>%s<==\n%s:" expr (car help-cons)) + stack-label "\n")))) + ;; The regular help label (no popups, cons cells, etc.) + (setq idlwave-shell-examine-label + (concat + (format "==>%s<==\n%s:" expr + (cond ((null help) "print") + ((stringp help) help) + (t (symbol-name help)))) + stack-label "\n"))) + + ;; Send the command + (if stack-label + (setq expr (idlwave-retrieve-expression-from-level + expr + idlwave-shell-calling-stack-index))) + (setq cmd (idlwave-shell-help-statement help expr)) + ;;(idlwave-shell-recenter-shell-window) + (idlwave-shell-send-command + cmd + 'idlwave-shell-check-compiled-and-display + (if idlwave-shell-separate-examine-output 'hide)))))) (defvar idlwave-shell-examine-window-alist nil "Variable to hold the win/height pairs for all *Examine* windows.") +(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) + + +(defun idlwave-shell-check-compiled-and-display () + "Check examine output for warning about undefined procedure/function." + (if (string-match "% Attempt to call undefined" idlwave-shell-command-output) + (idlwave-shell-compile-helper-routines)) + (if idlwave-shell-separate-examine-output + (idlwave-shell-examine-display) + (idlwave-shell-examine-highlight))) + (defun idlwave-shell-examine-display () "View the examine command output in a separate buffer." (let (win cur-beg cur-end) @@ -2505,10 +3123,6 @@ idlw-shell-examine-alist from which to select the help command text." (skip-chars-backward "\n") (recenter -1))))) -(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) - (defun idlwave-shell-examine-display-quit () (interactive) (let ((win (selected-window))) @@ -2526,60 +3140,73 @@ idlw-shell-examine-alist from which to select the help command text." (erase-buffer) (setq buffer-read-only t))))) -(defun idlwave-retrieve-expression-from-level (expr level routine help) +(defun idlwave-retrieve-expression-from-level (expr level) "Return IDL command to print the expression EXPR from stack level LEVEL. -It does not seem possible to evaluate an expression on a differnt -level than the current. Therefore, this function retrieves *copies* of -the variables involved in the expression from the desired level in the -calling stack. The copies are given some unlikely names on the -*current* level, and the expression is then evaluated on the *current* -level. - -Since this function depends upon the undocumented IDL routine routine_names, -there is no guarantee that this will work with future versions of IDL." - (let ((prefix "___") ;; No real variables should starts with this. - (fetch (- 0 level)) +It does not seem possible to evaluate an expression on a different +level than the current. Therefore, this function retrieves variables +by reference from other levels, and then includes that variable in +place of the chosen one. + +Since this function depends upon the undocumented IDL routine +routine_names, there is no guarantee that this will work with future +versions of IDL." + (let ((fetch (- 0 level)) (start 0) - var tvar fetch-vars pre post) + var fetch-start fetch-end pre post) - ;; FIXME: In the following we try to find the variables in expression + ;; FIXME: In the following we try to find the variables in expression ;; This is quite empirical - I don't know in what situations this will ;; break. We will look for identifiers and exclude cases where we ;; know it is not a variable. To distinguish array references from ;; function calls, we require that arrays use [] instead of () (while (string-match - "\\(\\`\\|[^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) (setq var (match-string 2 expr) - tvar (concat prefix var) - start (match-beginning 2) + start (match-end 2) pre (substring expr 0 (match-beginning 2)) post (substring expr (match-end 2))) - (cond - ;; Exclude identifiers which are not variables - ((string-match ",[ \t]*/\\'" pre)) ;; a `/' KEYWORD - ((and (string-match "[,(][ \t]*\\'" pre) - (string-match "\\`[ \t]*=" post))) ;; a `=' KEYWORD - ((string-match "\\`(" post)) ;; a function - ((string-match "->[ \t]*\\'" pre)) ;; a method - ((string-match "\\.\\'" pre)) ;; structure member - (t ;; seems to be a variable - arrange to get it and replace - ;; its name in the expression with the temproary name. - (push (cons var tvar) fetch-vars) - (setq expr (concat pre tvar post)))) - (if (= start 0) (setq start 1))) - ;; Make a command line that first copies the relevant variables - ;; and then prints the expression. - (concat - (mapconcat - (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)))) + (cond + ((or + ;; Exclude identifiers which are not variables + (string-match ",[ \t$\n]*/\\'" pre) ;; a `/' KEYWORD + (and (string-match "[,(][ \t\n]*\\'" pre) + (string-match "\\`[ \t]*=" post)) ;; a `=' KEYWORD + (string-match "\\`(" post) ;; a function + (string-match "->[ \t]*\\'" pre) ;; a method + (string-match "\\.\\'" pre))) ;; structure member + + ;; Skip over strings + ((and (string-match "\\([\"\']\\)[^\1]*$" pre) + (string-match (concat "^[^" (match-string 1 pre) "]*" + (match-string 1 pre)) post)) + (setq start (+ start (match-end 0)))) + + + ;; seems to be a variable - delimit its name + (t + (put-text-property start (- start (length var)) 'fetch t expr)))) + + (setq start 0) + (while (setq fetch-start + (next-single-property-change start 'fetch expr)) + (if (get-text-property start 'fetch expr) ; it's on in range + (setq fetch-end fetch-start ;it's off in range + fetch-start start) + (setq fetch-end (next-single-property-change fetch-start 'fetch expr))) + (unless fetch-end (setq fetch-end (length expr))) + (remove-text-properties fetch-start fetch-end '(fetch) expr) + (setq expr (concat (substring expr 0 fetch-start) + (format "(routine_names('%s',fetch=%d))" + (substring expr fetch-start fetch-end) + fetch) + (substring expr fetch-end))) + (setq start fetch-end)) + (if (get-text-property 0 'fetch expr) ; Full expression, left over + (setq expr (format "(routine_names('%s',fetch=%d))" expr fetch))) + expr)) + (defun idlwave-shell-help-statement (help expr) "Construct a help statement for printing expression EXPR. @@ -2588,13 +3215,16 @@ HELP can be non-nil for `help,', nil for 'print,' or any string into which to insert expression in place of the marker ___, e.g.: print, size(___,/DIMENSIONS)" (cond - ((null help) (concat "print, " expr)) + ((null help) + (concat "idlwave_print_safe, " expr "," + (number-to-string idlwave-shell-max-print-length))) ((stringp help) (if (string-match "\\(^\\|[^_]\\)\\(___\\)\\([^_]\\|$\\)" help) (concat (substring help 0 (match-beginning 2)) expr (substring help (match-end 2))))) - (t (concat "help, " expr)))) + (t + (concat "help, " expr)))) (defun idlwave-shell-examine-highlight () @@ -2620,8 +3250,8 @@ size(___,/DIMENSIONS)" output-begin output-end buffer)))) (defun idlwave-shell-delete-output-overlay () - (if (eq this-command 'idlwave-shell-mouse-nop) - nil + (unless (or (eq this-command 'idlwave-shell-mouse-nop) + (eq this-command 'handle-switch-frame)) (condition-case nil (if idlwave-shell-output-overlay (delete-overlay idlwave-shell-output-overlay)) @@ -2629,8 +3259,8 @@ size(___,/DIMENSIONS)" (remove-hook 'pre-command-hook 'idlwave-shell-delete-output-overlay))) (defun idlwave-shell-delete-expression-overlay () - (if (eq this-command 'idlwave-shell-mouse-nop) - nil + (unless (or (eq this-command 'idlwave-shell-mouse-nop) + (eq this-command 'handle-switch-frame)) (condition-case nil (if idlwave-shell-expression-overlay (delete-overlay idlwave-shell-expression-overlay)) @@ -2641,7 +3271,7 @@ size(___,/DIMENSIONS)" "Alist of breakpoints. A breakpoint is a cons cell \(\(file line\) . \(\(index module\) data\)\) -The car is the frame for the breakpoint: +The car is the `frame' for the breakpoint: file - full path file name. line - line number of breakpoint - integer. @@ -2651,13 +3281,18 @@ module - the module for breakpoint internal to IDL. Remaining elements of the cdr: data - Data associated with the breakpoint by idlwave-shell currently -contains two items: +contains four items: count - number of times to execute breakpoint. When count reaches 0 -the breakpoint is cleared and removed from the alist. + the breakpoint is cleared and removed from the alist. + command - command to execute when breakpoint is reached, either a -lisp function to be called with `funcall' with no arguments or a -list to be evaluated with `eval'.") + lisp function to be called with `funcall' with no arguments or a + list to be evaluated with `eval'. + +condition - any condition to apply to the breakpoint. + +disabled - whether the bp is disabled") (defun idlwave-shell-run-region (beg end &optional n) "Compile and run the region using the IDL process. @@ -2683,7 +3318,11 @@ If there is a prefix argument, display IDL process." (idlwave-look-at "\\"))) (insert "\nend\n")) (save-buffer 0))) - (idlwave-shell-send-command (concat ".run " idlwave-shell-temp-pro-file)) + (idlwave-shell-send-command (concat ".run \"" + idlwave-shell-temp-pro-file "\"") + nil + (if (idlwave-shell-hide-p 'run) 'mostly) + nil t) (if n (idlwave-display-buffer (idlwave-shell-buffer) nil (idlwave-shell-shell-frame)))) @@ -2715,26 +3354,47 @@ Does not work for a region with multiline blocks - use (error nil)))) (defun idlwave-display-buffer (buf not-this-window-p &optional frame) - (if (not (frame-live-p frame)) (setq frame nil)) - (display-buffer buf not-this-window-p frame)) + (if (featurep 'xemacs) + ;; The XEmacs version enforces the frame + (display-buffer buf not-this-window-p frame) + ;; For Emacs, we need to force the frame ourselves. + (let ((this-frame (selected-frame))) + (save-excursion ;; make sure we end up in the same buffer + (if (frame-live-p frame) + (select-frame frame)) + (if (eq this-frame (selected-frame)) + ;; same frame: use display buffer, to make sure the current + ;; window stays. + (display-buffer buf) + ;; different frame + (if (one-window-p) + ;; only window: switch + (progn + (switch-to-buffer buf) + (selected-window)) ; must return the window. + ;; several windows - use display-buffer + (display-buffer buf not-this-window-p))))))) +; (if (not (frame-live-p frame)) (setq frame nil)) +; (display-buffer buf not-this-window-p frame)) (defvar idlwave-shell-bp-buffer " *idlwave-shell-bp*" "Scratch buffer for parsing IDL breakpoint lists and other stuff.") -(defun idlwave-shell-bp-query () +(defun idlwave-shell-bp-query (&optional no-show) "Reconcile idlwave-shell's breakpoint list with IDL's. Queries IDL using the string in `idlwave-shell-bp-query'." (interactive) (idlwave-shell-send-command idlwave-shell-bp-query - 'idlwave-shell-filter-bp + `(progn + (idlwave-shell-filter-bp (quote ,no-show))) 'hide)) (defun idlwave-shell-bp-get (bp &optional item) - "Get a value for a breakpoint. -BP has the form of elements in idlwave-shell-bp-alist. -Optional second arg ITEM is the particular value to retrieve. -ITEM can be 'file, 'line, 'index, 'module, 'count, 'cmd, or 'data. -'data returns a list of 'count and 'cmd. + "Get a value for a breakpoint. BP has the form of elements in +idlwave-shell-bp-alist. Optional second arg ITEM is the +particular value to retrieve. ITEM can be 'file, 'line, 'index, +'module, 'count, 'cmd, 'condition, 'disabled, 'type, or +'data. 'data returns a list of 'count, 'cmd and 'condition. Defaults to 'index." (cond ;; Frame @@ -2744,15 +3404,23 @@ Defaults to 'index." ((eq item 'data) (cdr (cdr bp))) ((eq item 'count) (nth 0 (cdr (cdr bp)))) ((eq item 'cmd) (nth 1 (cdr (cdr bp)))) + ((eq item 'condition) (nth 2 (cdr (cdr bp)))) + ((eq item 'disabled) (nth 3 (cdr (cdr bp)))) ;; IDL breakpoint info - ((eq item 'module) (nth 1 (car (cdr bp)))) + ((eq item 'module) + (let ((module (nth 1 (car (cdr bp))))) + (if (listp module) (car module) module))) + ((eq item 'type) + (let ((module (nth 1 (car (cdr bp))))) + (if (listp module) (nth 1 module)))) ;; index - default (t (nth 0 (car (cdr bp)))))) -(defun idlwave-shell-filter-bp () - "Get the breakpoints from `idlwave-shell-command-output'. -Create `idlwave-shell-bp-alist' updating breakpoint count and command data -from previous breakpoint list." +(defun idlwave-shell-filter-bp (&optional no-show) + "Get the breakpoints from `idlwave-shell-command-output'. Create +`idlwave-shell-bp-alist' updating breakpoint count and command data +from previous breakpoint list. If NO-SHOW is set, don't update the +breakpoint overlays." (save-excursion (set-buffer (get-buffer-create idlwave-shell-bp-buffer)) (erase-buffer) @@ -2762,54 +3430,71 @@ from previous breakpoint list." ;; Searching the breakpoints ;; In IDL 5.5, the breakpoint reporting format changed. (bp-re54 "^[ \t]*\\([0-9]+\\)[ \t]+\\(\\S-+\\)?[ \t]+\\([0-9]+\\)[ \t]+\\(\\S-+\\)") - (bp-re55 "^\\s-*\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\(Uncompiled\\|Func=\\|Pro=\\)\\(\\S-+\\)?\\s-+\\(\\S-+\\)") - file line index module + (bp-re55 + (concat + "^\\s-*\\([0-9]+\\)" ; 1 index + "\\s-+\\([0-9]+\\)" ; 2 line number + "\\s-+\\(Uncompiled\\|" ; 3-6 either uncompiled or routine name + "\\(\\(Func=\\|Pro=\\)\\(\\$?[a-zA-Z][a-zA-Z0-9$_:]*\\$?\\)\\)\\)" + "\\(\\s-*,\\s-*After=[0-9]+/\\([0-9]+\\)?\\)?" ; 7-8 After part + "\\(\\s-*,\\s-*\\(BreakOnce\\)\\)?" ; 9-10 BreakOnce + "\\(\\s-*,\\s-*\\(Condition='\\(.*\\)'\\)\n?\\)?" ; 11-13 Condition + "\\(\\s-*,\\s-*\\(Disabled\\)\n?\\)?" ; 14-15 Disabled + "\\s-+\\(\\S-+\\)")) ; 16 File name + file line index module + count condition disabled bp-re indmap) (setq idlwave-shell-bp-alist (list nil)) ;; Search for either header type, and set the correct regexp (when (or (if (re-search-forward "^\\s-*Index.*\n\\s-*-" nil t) (setq bp-re bp-re54 ; versions <= 5.4 - indmap '(1 2 3 4))) + indmap '(1 2 3 4))) ;index module line file (if (re-search-forward "^\\s-*Index\\s-*Line\\s-*Attributes\\s-*File" nil t) (setq bp-re bp-re55 ; versions >= 5.5 - indmap '(1 4 2 5)))) - ;; There seems to be a breakpoint listing here. - ;; 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) + indmap '(1 6 2 16)))) ; index module line file + ;; There seems to be a breakpoint listing here, parse breakpoint lines. (while (re-search-forward bp-re nil t) - (setq index (match-string (nth 0 indmap)) + (setq index (string-to-number (match-string (nth 0 indmap))) module (match-string (nth 1 indmap)) - line (string-to-int (match-string (nth 2 indmap))) + line (string-to-number (match-string (nth 2 indmap))) file (idlwave-shell-file-name (match-string (nth 3 indmap)))) + (if (eq bp-re bp-re55) + (setq count (if (match-string 10) 1 + (if (match-string 8) + (string-to-number (match-string 8)))) + condition (match-string 13) + disabled (not (null (match-string 15))))) + ;; Add the breakpoint info to the list (nconc idlwave-shell-bp-alist (list (cons (list file line) (list (list index module) - ;; idlwave-shell data: count, command - nil nil)))))) + ;; bp data: count, command, condition, disabled + count nil condition disabled)))))) (setq idlwave-shell-bp-alist (cdr idlwave-shell-bp-alist)) - ;; Update count, commands of breakpoints - (mapcar 'idlwave-shell-update-bp old-bp-alist))) + ;; Update breakpoint data + (if (eq bp-re bp-re54) + (mapcar 'idlwave-shell-update-bp old-bp-alist) + (mapcar 'idlwave-shell-update-bp-command-only old-bp-alist)))) ;; Update the breakpoint overlays - (idlwave-shell-update-bp-overlays) + (unless no-show (idlwave-shell-update-bp-overlays)) ;; Return the new list idlwave-shell-bp-alist) -(defun idlwave-shell-update-bp (bp) +(defun idlwave-shell-update-bp-command-only (bp) + (idlwave-shell-update-bp bp t)) + +(defun idlwave-shell-update-bp (bp &optional command-only) "Update BP data in breakpoint list. If BP frame is in `idlwave-shell-bp-alist' updates the breakpoint data." (let ((match (assoc (car bp) idlwave-shell-bp-alist))) - (if match (setcdr (cdr match) (cdr (cdr bp)))))) + (if match + (if command-only + (setf (nth 1 (cdr (cdr match))) (nth 1 (cdr (cdr match)))) + (setcdr (cdr match) (cdr (cdr bp))))))) (defun idlwave-shell-set-bp-data (bp data) "Set the data of BP to DATA." @@ -2820,7 +3505,9 @@ If BP frame is in `idlwave-shell-bp-alist' updates the breakpoint data." and third args, DATA and MODULE, are optional. Returns a breakpoint of the format used in `idlwave-shell-bp-alist'. Can be used in commands attempting match a breakpoint in `idlwave-shell-bp-alist'." - (cons frame (cons (list nil module) data))) + (cons frame ;; (file line) + (cons (list nil module) ;; (index_id (module type) | module) + data))) ;; (count command condition disabled) (defvar idlwave-shell-old-bp nil "List of breakpoints previous to setting a new breakpoint.") @@ -2832,80 +3519,93 @@ Otherwise return the filename in bp." (let* ((bp-file (idlwave-shell-bp-get bp 'file)) (bp-module (idlwave-shell-bp-get bp 'module)) - (internal-file-list (cdr (assoc bp-module idlwave-shell-sources-alist)))) + (internal-file-list + (if bp-module + (cdr (assoc bp-module idlwave-shell-sources-alist))))) (if (and internal-file-list (equal bp-file (nth 0 internal-file-list))) (nth 1 internal-file-list) bp-file))) -(defun idlwave-shell-set-bp (bp) - "Try to set a breakpoint BP. - +(defun idlwave-shell-set-bp (bp &optional no-show) + "Try to set a breakpoint BP. The breakpoint will be placed at the beginning of the statement on the line specified by BP or at the next IDL statement if that line is not -a statement. -Determines IDL's internal representation for the breakpoint, which may -have occurred at a different line than used with the breakpoint -command." - +a statement. Determines IDL's internal representation for the +breakpoint, which may have occurred at a different line than +specified. If NO-SHOW is non-nil, don't do any updating." ;; Get and save the old breakpoints (idlwave-shell-send-command idlwave-shell-bp-query - '(progn - (idlwave-shell-filter-bp) - (setq idlwave-shell-old-bp idlwave-shell-bp-alist)) - 'hide) - ;; Get sources for IDL compiled procedures followed by setting - ;; breakpoint. - (idlwave-shell-send-command - idlwave-shell-sources-query `(progn - (idlwave-shell-sources-filter) - (idlwave-shell-set-bp2 (quote ,bp))) - 'hide)) + (idlwave-shell-filter-bp (quote ,no-show)) + (setq idlwave-shell-old-bp idlwave-shell-bp-alist)) + 'hide) -(defun idlwave-shell-set-bp2 (bp) - "Use results of breakpoint and sources query to set bp. -Use the count argument with IDLs breakpoint command. -We treat a count of 1 as a temporary breakpoint. -Counts greater than 1 use the IDL AFTER=count keyword to break -only after reaching the statement count times." + ;; Get sources for this routine in the sources list + (idlwave-shell-module-source-query (idlwave-shell-bp-get bp 'module) + (idlwave-shell-bp-get bp 'type)) (let* - ((arg (idlwave-shell-bp-get bp 'count)) - (key (cond - ((not (and arg (numberp arg))) "") - ((= arg 1) - ",/once") - ((> arg 1) - (format ",after=%d" arg)))) + ((count (idlwave-shell-bp-get bp 'count)) + (condition (idlwave-shell-bp-get bp 'condition)) + (disabled (idlwave-shell-bp-get bp 'disabled)) + (key (concat (if (and count (numberp count)) + (cond + ((= count 1) ",/once") + ((> count 1) (format ",after=%d" count)))) + (if condition (concat ",CONDITION=\"" condition "\"")) + ;; IDL can't simultaneously set a condition/count + ;; and disable a breakpoint, but it does keep both + ;; of these when resetting the same BP. We assume + ;; DISABLE and CONDITION/COUNT are not set + ;; together for a newly created breakpoint. + (if (and disabled (not condition) (not count)) + ",/DISABLE"))) (line (idlwave-shell-bp-get bp 'line))) (idlwave-shell-send-command (concat "breakpoint,'" (idlwave-shell-sources-bp bp) "'," (if (integerp line) (setq line (int-to-string line))) key) - ;; Check for failure and look for breakpoint in IDL's list + ;; Check for failure and adjust breakpoint to match IDL's list `(progn - (if (idlwave-shell-set-bp-check (quote ,bp)) - (idlwave-shell-set-bp3 (quote ,bp)))) - ;; do not hide output - nil - 'preempt))) + (if (idlwave-shell-set-bp-check (quote ,bp)) + (idlwave-shell-set-bp-adjust (quote ,bp) (quote ,no-show)))) + ;; hide output? + (idlwave-shell-hide-p 'breakpoint) + 'preempt t))) -(defun idlwave-shell-set-bp3 (bp) +(defun idlwave-shell-set-bp-adjust (bp &optional no-show) "Find the breakpoint in IDL's internal list of breakpoints." - (idlwave-shell-send-command idlwave-shell-bp-query - `(progn - (idlwave-shell-filter-bp) - (idlwave-shell-new-bp (quote ,bp))) - 'hide - 'preempt)) + (idlwave-shell-send-command + idlwave-shell-bp-query + `(progn + (idlwave-shell-filter-bp 'no-show) + (idlwave-shell-new-bp (quote ,bp)) + (unless (quote ,no-show) + (idlwave-shell-update-bp-overlays))) + 'hide + 'preempt)) (defun idlwave-shell-find-bp (frame) "Return breakpoint from `idlwave-shell-bp-alist' for frame. Returns nil if frame not found." (assoc frame idlwave-shell-bp-alist)) +(defun idlwave-shell-find-current-bp () + "Find breakpoint here, or at halt location." + (let ((bp (idlwave-shell-find-bp (idlwave-shell-current-frame)))) + (when (not bp) + ;; Try moving to beginning of halted-at statement + (save-excursion + (idlwave-shell-goto-frame) + (idlwave-beginning-of-statement) + (setq bp (idlwave-shell-find-bp (idlwave-shell-current-frame)))) + (unless bp + (beep) + (message "Cannot identify breakpoint for this line"))) + bp)) + (defun idlwave-shell-new-bp (bp) "Find the new breakpoint in IDL's list and update with DATA. The actual line number for a breakpoint in IDL may be different than @@ -2933,73 +3633,229 @@ considered the new breakpoint if the file name of frame matches." (message "Failed to identify breakpoint in IDL")))) (defvar idlwave-shell-bp-overlays nil - "List of overlays marking breakpoints") + "Alist of overlays marking breakpoints") +(defvar idlwave-shell-bp-glyph) + +(defvar idlwave-shell-debug-line-map (make-sparse-keymap)) +(define-key idlwave-shell-debug-line-map + (if (featurep 'xemacs) [button3] [mouse-3]) + 'idlwave-shell-mouse-active-bp) (defun idlwave-shell-update-bp-overlays () "Update the overlays which mark breakpoints in the source code. Existing overlays are recycled, in order to minimize consumption." (when idlwave-shell-mark-breakpoints - (let ((bp-list idlwave-shell-bp-alist) - (ov-list idlwave-shell-bp-overlays) - ov bp) + (let ((ov-alist (copy-alist idlwave-shell-bp-overlays)) + (bp-list idlwave-shell-bp-alist) + (use-glyph (and (memq idlwave-shell-mark-breakpoints '(t glyph)) + idlwave-shell-bp-glyph)) + ov ov-list bp buf old-buffers win) + ;; Delete the old overlays from their buffers - (while (setq ov (pop ov-list)) - (delete-overlay ov)) - (setq ov-list idlwave-shell-bp-overlays - idlwave-shell-bp-overlays nil) + (if ov-alist + (while (setq ov-list (pop ov-alist)) + (while (setq ov (pop (cdr ov-list))) + (add-to-list 'old-buffers (overlay-buffer ov)) + (delete-overlay ov)))) + + (setq ov-alist idlwave-shell-bp-overlays + idlwave-shell-bp-overlays + (if idlwave-shell-bp-glyph + (mapcar 'list (mapcar 'car idlwave-shell-bp-glyph)) + (list (list 'bp)))) (while (setq bp (pop bp-list)) (save-excursion (idlwave-shell-goto-frame (car bp)) (let* ((end (progn (end-of-line 1) (point))) (beg (progn (beginning-of-line 1) (point))) - (ov (or (pop ov-list) - (idlwave-shell-make-new-bp-overlay)))) + (condition (idlwave-shell-bp-get bp 'condition)) + (count (idlwave-shell-bp-get bp 'count)) + (disabled (idlwave-shell-bp-get bp 'disabled)) + (type (if idlwave-shell-bp-glyph + (cond + (condition 'bp-cond ) + (count + (cond + ((<= count 0) 'bp) + ((<= count 4) + (intern + (concat "bp-" (number-to-string count)))) + (t 'bp-n))) + (t 'bp)) + 'bp)) + (help-list + (delq nil + (list + (if count + (concat "after:" (int-to-string count))) + (if condition + (concat "condition:" condition)) + (if disabled "disabled")))) + (help-text (concat + "BP " + (int-to-string (idlwave-shell-bp-get bp)) + (if help-list + (concat + " - " + (mapconcat 'identity help-list ", "))) + (if (and (not count) (not condition)) + " (use mouse-3 for breakpoint actions)"))) + (full-type (if disabled + (intern (concat (symbol-name type) + "-disabled")) + type)) + (ov-existing (assq full-type ov-alist)) + (ov (or (and (cdr ov-existing) + (pop (cdr ov-existing))) + (idlwave-shell-make-new-bp-overlay type disabled))) + match) + (if idlwave-shell-breakpoint-popup-menu + (overlay-put ov 'help-echo help-text)) (move-overlay ov beg end) - (push ov idlwave-shell-bp-overlays))))))) - -(defvar idlwave-shell-bp-glyph) -(defun idlwave-shell-make-new-bp-overlay () - "Make a new overlay for highlighting breakpoints. -This stuff is stringly dependant upon the version of Emacs." - (let ((ov (make-overlay 1 1))) + (if (setq match (assq full-type idlwave-shell-bp-overlays)) + (push ov (cdr match)) + (nconc idlwave-shell-bp-overlays + (list (list full-type ov))))) + ;; Take care of margins if using a glyph + (when use-glyph + (if old-buffers + (setq old-buffers (delq (current-buffer) old-buffers))) + (if (fboundp 'set-specifier) ;; XEmacs + (set-specifier left-margin-width (cons (current-buffer) 2)) + (if (< left-margin-width 2) + (setq left-margin-width 2))) + (let ((window (get-buffer-window (current-buffer) 0))) + (if window + (set-window-margins + window left-margin-width right-margin-width)))))) + (if use-glyph + (while (setq buf (pop old-buffers)) + (with-current-buffer buf + (if (fboundp 'set-specifier) ;; XEmacs + (set-specifier left-margin-width (cons (current-buffer) 0)) + (setq left-margin-width 0)) + (let ((window (get-buffer-window buf 0))) + (if window + (set-window-margins + window left-margin-width right-margin-width))))))))) + +(defun idlwave-shell-make-new-bp-overlay (&optional type disabled) + "Make a new overlay for highlighting breakpoints. + +This stuff is strongly dependant upon the version of Emacs. If TYPE +is passed, make an overlay of that type ('bp or 'bp-cond, currently +only for glyphs)." + (let ((ov (make-overlay 1 1)) + (use-glyph (and (memq idlwave-shell-mark-breakpoints '(t glyph)) + idlwave-shell-bp-glyph)) + (type (or type 'bp)) + (face (if disabled + idlwave-shell-disabled-breakpoint-face + idlwave-shell-breakpoint-face))) (if (featurep 'xemacs) ;; This is XEmacs (progn + (when idlwave-shell-breakpoint-popup-menu + (set-extent-property ov 'mouse-face 'highlight) + (set-extent-property ov 'keymap idlwave-shell-debug-line-map)) + (cond + ;; tty's cannot display glyphs ((eq (console-type) 'tty) - ;; tty's cannot display glyphs - (set-extent-property ov 'face idlwave-shell-breakpoint-face)) - ((and (memq idlwave-shell-mark-breakpoints '(t glyph)) - idlwave-shell-bp-glyph) - ;; use the glyph - (set-extent-property ov 'begin-glyph idlwave-shell-bp-glyph)) + (set-extent-property ov 'face face)) + + ;; use the glyph + (use-glyph + (let ((glyph (cdr (assq type idlwave-shell-bp-glyph)))) + (if disabled (setq glyph (car glyph)) (setq glyph (nth 1 glyph))) + (set-extent-property ov 'begin-glyph glyph) + (set-extent-property ov 'begin-glyph-layout 'outside-margin))) + + ;; use the face (idlwave-shell-mark-breakpoints - ;; use the face - (set-extent-property ov 'face idlwave-shell-breakpoint-face)) - (t - ;; no marking - nil)) + (set-extent-property ov 'face face)) + + ;; no marking + (t nil)) (set-extent-priority ov -1)) ; make stop line face prevail ;; This is Emacs + (when idlwave-shell-breakpoint-popup-menu + (overlay-put ov 'mouse-face 'highlight) + (overlay-put ov 'keymap idlwave-shell-debug-line-map)) (cond (window-system - (if (and (memq idlwave-shell-mark-breakpoints '(t glyph)) - idlwave-shell-bp-glyph) ; this var knows if glyph's possible - ;; use a glyph - (let ((string "@")) - (put-text-property 0 1 - 'display idlwave-shell-bp-glyph - string) + (if use-glyph + (let ((image-props (cdr (assq type idlwave-shell-bp-glyph))) + string) + + (if disabled (setq image-props + (append image-props + (list :conversion 'disabled)))) + (setq string + (propertize "@" + 'display + (list (list 'margin 'left-margin) + image-props))) (overlay-put ov 'before-string string)) - (overlay-put ov 'face idlwave-shell-breakpoint-face))) + ;; just the face + (overlay-put ov 'face face))) + + ;; use a face (idlwave-shell-mark-breakpoints - ;; use a face - (overlay-put ov 'face idlwave-shell-breakpoint-face)) - (t - ;; No marking - nil))) + (overlay-put ov 'face face)) + + ;; No marking + (t nil))) ov)) +(defun idlwave-shell-mouse-active-bp (ev) + "Does right-click mouse action on breakpoint lines." + (interactive "e") + (if ev (mouse-set-point ev)) + (let ((bp (idlwave-shell-find-bp (idlwave-shell-current-frame))) + index condition count select cmd disabled) + (unless bp + (error "Breakpoint not found")) + (setq index (int-to-string (idlwave-shell-bp-get bp)) + condition (idlwave-shell-bp-get bp 'condition) + cmd (idlwave-shell-bp-get bp 'cmd) + count (idlwave-shell-bp-get bp 'count) + disabled (idlwave-shell-bp-get bp 'disabled)) + (setq select (idlwave-popup-select + ev + (delq nil + (list (if disabled "Enable" "Disable") + "Clear" + "Clear All" + (if condition "Remove Condition" "Add Condition") + (if condition "Change Condition") + (if count "Remove Repeat Count" + "Add Repeat Count") + (if count "Change Repeat Count"))) + (concat "BreakPoint " index))) + (if select + (cond + ((string-equal select "Clear All") + (idlwave-shell-clear-all-bp)) + ((string-equal select "Clear") + (idlwave-shell-clear-current-bp)) + ((string-match "Condition" select) + (idlwave-shell-break-here count cmd + (if (or (not condition) + (string-match "Change" select)) + (read-string "Break Condition: ")) + disabled)) + ((string-match "Count" select) + (idlwave-shell-break-here (if (or (not count) + (string-match "Change" select)) + (string-to-number + (read-string "Break After Count: "))) + cmd condition disabled)) + ((string-match "able$" select) + (idlwave-shell-toggle-enable-current-bp)) + (t + (message "Unimplemented: %s" select)))))) + (defun idlwave-shell-edit-default-command-line (arg) "Edit the current execute command." (interactive "P") @@ -3008,16 +3864,21 @@ This stuff is stringly dependant upon the version of Emacs." (defun idlwave-shell-execute-default-command-line (arg) "Execute a command line. On first use, ask for the command. -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 `idlwave-shell-edit-default-command-line' to edit the line." (interactive "P") - (if (or (not idlwave-shell-command-line-to-execute) - arg) - (setq idlwave-shell-command-line-to-execute - (read-string "IDL> " idlwave-shell-command-line-to-execute))) + (cond + ((equal arg '(16)) + (setq idlwave-shell-command-line-to-execute nil)) + ((equal arg '(4)) + (setq idlwave-shell-command-line-to-execute + (read-string "IDL> " idlwave-shell-command-line-to-execute)))) (idlwave-shell-reset 'hidden) - (idlwave-shell-send-command idlwave-shell-command-line-to-execute - '(idlwave-shell-redisplay 'hide))) + (idlwave-shell-send-command + (or idlwave-shell-command-line-to-execute + (with-current-buffer (idlwave-shell-buffer) + (ring-ref comint-input-ring 0))) + '(idlwave-shell-redisplay 'hide))) (defun idlwave-shell-save-and-run () "Save file and run it in IDL. @@ -3051,6 +3912,8 @@ handled by this command." ;; Remove the stop overlay. (if idlwave-shell-stop-line-overlay (delete-overlay idlwave-shell-stop-line-overlay)) + (if idlwave-shell-is-stopped + (idlwave-shell-electric-debug-all-off)) (setq idlwave-shell-is-stopped nil) (setq overlay-arrow-string nil) (let (buf) @@ -3073,23 +3936,26 @@ handled by this command." ((eq action 'compile) ".compile ") ((eq action 'batch) "@") (t (error "Unknown action %s" action))) - idlwave-shell-last-save-and-action-file) - 'idlwave-shell-maybe-update-routine-info - nil) + "\"" + idlwave-shell-last-save-and-action-file + "\"") + `(idlwave-shell-maybe-update-routine-info nil + ,idlwave-shell-last-save-and-action-file) + (if (idlwave-shell-hide-p 'run) 'mostly) nil t) (idlwave-shell-bp-query)) (let ((msg (format "No such file %s" idlwave-shell-last-save-and-action-file))) (setq idlwave-shell-last-save-and-action-file nil) (error msg)))) -(defun idlwave-shell-maybe-update-routine-info () +(defun idlwave-shell-maybe-update-routine-info (&optional wait file) "Update the routine info if the shell is not stopped at an error." (if (and (not idlwave-shell-is-stopped) (or (eq t idlwave-auto-routine-info-updates) (memq 'compile-buffer idlwave-auto-routine-info-updates)) idlwave-query-shell-for-routine-info idlwave-routines) - (idlwave-shell-update-routine-info t))) + (idlwave-shell-update-routine-info t nil wait file))) (defvar idlwave-shell-sources-query "help,/source,/full" "IDL command to obtain source files for compiled procedures.") @@ -3100,8 +3966,34 @@ Elements of the alist have the form: (module name . (source-file-truename idlwave-internal-filename)).") +(defun idlwave-shell-module-source-query (module &optional type) + "Determine the source file for a given module. +Query as a function if TYPE set to something beside 'pro." + (if module + (idlwave-shell-send-command + (format "print,(routine_info('%s',/SOURCE%s)).PATH" module + (if (eq type 'pro) "" ",/FUNCTIONS")) + `(idlwave-shell-module-source-filter ,module) + 'hide 'wait))) + +(defun idlwave-shell-module-source-filter (module) + "Get module source, and update idlwave-shell-sources-alist." + (let ((old (assoc (upcase module) idlwave-shell-sources-alist)) + filename) + (when (string-match "\.PATH *[\n\r]\\([^%][^\r\n]+\\)[\n\r]" + idlwave-shell-command-output) + (setq filename (substring idlwave-shell-command-output + (match-beginning 1) (match-end 1))) + (if old + (setcdr old (list (idlwave-shell-file-name filename) filename)) + (setq idlwave-shell-sources-alist + (append idlwave-shell-sources-alist + (list (cons (upcase module) + (list (idlwave-shell-file-name filename) + filename))))))))) + (defun idlwave-shell-sources-query () - "Determine source files for IDL compiled procedures. + "Determine source files for all IDL compiled procedures. Queries IDL using the string in `idlwave-shell-sources-query'." (interactive) (idlwave-shell-send-command idlwave-shell-sources-query @@ -3161,7 +4053,6 @@ list elements of the form: )))) (cdr al)))) - (defun idlwave-shell-clear-all-bp () "Remove all breakpoints in IDL." (interactive) @@ -3169,7 +4060,9 @@ list elements of the form: idlwave-shell-bp-query '(progn (idlwave-shell-filter-bp) - (mapcar 'idlwave-shell-clear-bp idlwave-shell-bp-alist)) + (mapcar (lambda (x) (idlwave-shell-clear-bp x 'no-query)) + idlwave-shell-bp-alist) + (idlwave-shell-bp-query)) 'hide)) (defun idlwave-shell-list-all-bp () @@ -3188,15 +4081,17 @@ list elements of the form: (save-excursion (set-buffer idlwave-shell-error-buffer) (goto-char idlwave-shell-error-last) - (if (or (re-search-forward idlwave-shell-syntax-error nil t) - (re-search-forward idlwave-shell-other-error nil t)) + (if (or + (re-search-forward idlwave-shell-syntax-error nil t) + (re-search-forward idlwave-shell-other-error nil t)) (progn (setq frame (list (save-match-data (idlwave-shell-file-name - (buffer-substring (match-beginning 1) (match-end 1)))) - (string-to-int + (buffer-substring (match-beginning 1 ) + (match-end 1)))) + (string-to-number (buffer-substring (match-beginning 2) (match-end 2))))) ;; Try to find the column of the error @@ -3208,7 +4103,7 @@ list elements of the form: (setq idlwave-shell-error-last (point))) (if frame (progn - (idlwave-shell-display-line frame col)) + (idlwave-shell-display-line frame col 'disable)) (beep) (message "No more errors.")))) @@ -3222,20 +4117,33 @@ Otherwise, just expand the file name." (file-truename name def-dir) (expand-file-name name def-dir)))) -;; Keybindings -------------------------------------------------------------- +;; Keybindings ------------------------------------------------------------ (defvar idlwave-shell-mode-map (copy-keymap comint-mode-map) "Keymap for idlwave-mode.") +(defvar idlwave-shell-electric-debug-mode-map (make-sparse-keymap)) (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap)) (fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map) +(defvar idlwave-mode-prefix-map (make-sparse-keymap)) +(fset 'idlwave-mode-prefix-map idlwave-mode-prefix-map) + +(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)) ;(define-key idlwave-shell-mode-map "\M-?" 'comint-dynamic-list-completions) ;(define-key idlwave-shell-mode-map "\t" 'comint-dynamic-complete) + +(define-key idlwave-shell-mode-map "\C-w" 'comint-kill-region) (define-key idlwave-shell-mode-map "\t" 'idlwave-shell-complete) (define-key idlwave-shell-mode-map "\M-\t" 'idlwave-shell-complete) (define-key idlwave-shell-mode-map "\C-c\C-s" 'idlwave-shell) (define-key idlwave-shell-mode-map "\C-c?" 'idlwave-routine-info) +(define-key idlwave-shell-mode-map "\C-g" 'idlwave-keyboard-quit) (define-key idlwave-shell-mode-map "\M-?" 'idlwave-context-help) +(define-key idlwave-shell-mode-map [(control meta ?\?)] + 'idlwave-help-assistant-help-with-topic) (define-key idlwave-shell-mode-map "\C-c\C-i" 'idlwave-update-routine-info) (define-key idlwave-shell-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop) (define-key idlwave-shell-mode-map "\C-c\C-x" 'idlwave-shell-send-char) @@ -3285,41 +4193,49 @@ Otherwise, just expand the file name." ;; The following set of bindings is used to bind the debugging keys. -;; If `idlwave-shell-activate-prefix-keybindings' is non-nil, the first key -;; in the list gets bound the C-c C-d prefix map. -;; If `idlwave-shell-debug-modifiers' is non-nil, the second key -;; in the list gets bound with the specified modifiers in both -;; `idlwave-mode-map' and `idlwave-shell-mode-map'. - -;; Used keys: abcdef hi klmnopqrs u wxyz -;; Unused keys: g j t v +;; If `idlwave-shell-activate-prefix-keybindings' is non-nil, the +;; first key in the list gets bound the C-c C-d prefix map. If +;; `idlwave-shell-debug-modifiers' is non-nil, the second key in the +;; list gets bound with the specified modifiers in both +;; `idlwave-mode-map' and `idlwave-shell-mode-map'. The next list +;; item, if non-nil, means to bind this as a single key in the +;; electric-debug-mode-map. +;; +;; [C-c C-d]-binding debug-modifier-key command bind-electric-debug buf-only +;; Used keys: abcdef hijklmnopqrstuvwxyz +;; Unused keys: g (let* ((specs - '(([(control ?b)] ?b idlwave-shell-break-here) - ([(control ?i)] ?i idlwave-shell-break-in) - ([(control ?d)] ?d idlwave-shell-clear-current-bp) - ([(control ?a)] ?a idlwave-shell-clear-all-bp) - ([(control ?s)] ?s idlwave-shell-step) - ([(control ?n)] ?n idlwave-shell-stepover) - ([(control ?k)] ?k idlwave-shell-skip) - ([(control ?u)] ?u idlwave-shell-up) - ([(control ?o)] ?o idlwave-shell-out) - ([(control ?m)] ?m idlwave-shell-return) - ([(control ?h)] ?h idlwave-shell-to-here) - ([(control ?r)] ?r idlwave-shell-cont) + '(([(control ?b)] ?b idlwave-shell-break-here t t) + ([(control ?i)] ?i idlwave-shell-break-in t t) + ([(control ?j)] ?j idlwave-shell-break-this-module t t) + ([(control ?d)] ?d idlwave-shell-clear-current-bp t) + ([(control ?a)] ?a idlwave-shell-clear-all-bp t) + ([(control ?\\)] ?\\ idlwave-shell-toggle-enable-current-bp t) + ([(control ?s)] ?s idlwave-shell-step t) + ([(control ?n)] ?n idlwave-shell-stepover t) + ([(control ?k)] ?k idlwave-shell-skip t) + ([(control ?u)] ?u idlwave-shell-up t) + ([(control ?o)] ?o idlwave-shell-out t) + ([(control ?m)] ?m idlwave-shell-return t) + ([(control ?h)] ?h idlwave-shell-to-here t t) + ([(control ?r)] ?r idlwave-shell-cont t) ([(control ?y)] ?y idlwave-shell-execute-default-command-line) - ([(control ?z)] ?z idlwave-shell-reset) + ([(control ?z)] ?z idlwave-shell-reset t) ([(control ?q)] ?q idlwave-shell-quit) - ([(control ?p)] ?p idlwave-shell-print) - ([(??)] ?? idlwave-shell-help-expression) - ([(control ?c)] ?c idlwave-shell-save-and-run) - ([( ?@)] ?@ idlwave-shell-save-and-batch) + ([(control ?p)] ?p idlwave-shell-print t) + ([( ??)] ?? idlwave-shell-help-expression t) + ([(control ?v)] ?v idlwave-shell-toggle-electric-debug-mode t t) ([(control ?x)] ?x idlwave-shell-goto-next-error) + ([(control ?c)] ?c idlwave-shell-save-and-run t) + ([( ?@)] ?@ idlwave-shell-save-and-batch) ([(control ?e)] ?e idlwave-shell-run-region) ([(control ?w)] ?w idlwave-shell-resync-dirs) - ([(control ?l)] ?l idlwave-shell-redisplay) + ([(control ?l)] ?l idlwave-shell-redisplay t) ([(control ?t)] ?t idlwave-shell-toggle-toolbar) ([(control up)] up idlwave-shell-stack-up) ([(control down)] down idlwave-shell-stack-down) + ([( ?[)] ?[ idlwave-shell-goto-previous-bp t t) + ([( ?])] ?] idlwave-shell-goto-next-bp t t) ([(control ?f)] ?f idlwave-shell-window))) (mod (cond ((and idlwave-shell-debug-modifiers (listp idlwave-shell-debug-modifiers) @@ -3329,79 +4245,161 @@ Otherwise, just expand the file name." '(alt)))) (shift (memq 'shift mod)) (mod-noshift (delete 'shift (copy-sequence mod))) - s k1 c2 k2 cmd) + s k1 c2 k2 cmd electric only-buffer cannotshift) (while (setq s (pop specs)) (setq k1 (nth 0 s) c2 (nth 1 s) - cmd (nth 2 s)) - (when idlwave-shell-activate-prefix-keybindings - (and k1 (define-key idlwave-shell-mode-prefix-map k1 cmd))) + cmd (nth 2 s) + electric (nth 3 s) + only-buffer (nth 4 s) + cannotshift (and shift (char-valid-p c2) (eq c2 (upcase c2)))) + + ;; The regular prefix keymap. + (when (and idlwave-shell-activate-prefix-keybindings k1) + (unless only-buffer + (define-key idlwave-shell-mode-prefix-map k1 cmd)) + (define-key idlwave-mode-prefix-map k1 cmd)) + ;; The debug modifier map (when (and mod window-system) (if (char-or-string-p c2) (setq k2 (vector (append mod-noshift (list (if shift (upcase c2) c2))))) (setq k2 (vector (append mod (list c2))))) - (define-key idlwave-mode-map k2 cmd) - (define-key idlwave-shell-mode-map k2 cmd)))) - -;; Enter the prefix map at the two places. -(fset 'idlwave-debug-map idlwave-shell-mode-prefix-map) + (unless cannotshift + (define-key idlwave-mode-map k2 cmd) + (unless only-buffer (define-key idlwave-shell-mode-map k2 cmd)))) + ;; The electric debug single-keystroke map + (if (and electric (char-or-string-p c2)) + (define-key idlwave-shell-electric-debug-mode-map (char-to-string c2) + cmd)))) + +;; A few extras in the electric debug map +(define-key idlwave-shell-electric-debug-mode-map " " 'idlwave-shell-step) +(define-key idlwave-shell-electric-debug-mode-map "+" 'idlwave-shell-stack-up) +(define-key idlwave-shell-electric-debug-mode-map "=" 'idlwave-shell-stack-up) +(define-key idlwave-shell-electric-debug-mode-map "-" + 'idlwave-shell-stack-down) +(define-key idlwave-shell-electric-debug-mode-map "_" + 'idlwave-shell-stack-down) +(define-key idlwave-shell-electric-debug-mode-map "e" + '(lambda () (interactive) (idlwave-shell-print '(16)))) +(define-key idlwave-shell-electric-debug-mode-map "q" 'idlwave-shell-retall) +(define-key idlwave-shell-electric-debug-mode-map "t" + '(lambda () (interactive) (idlwave-shell-send-command "help,/TRACE"))) +(define-key idlwave-shell-electric-debug-mode-map [(control ??)] + 'idlwave-shell-electric-debug-help) +(define-key idlwave-shell-electric-debug-mode-map "x" + '(lambda (arg) (interactive "P") + (idlwave-shell-print arg nil nil t))) + + +; Enter the prefix map in two places. +(fset 'idlwave-debug-map idlwave-mode-prefix-map) (fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map) -;; The Menus -------------------------------------------------------------- +;; The Electric Debug Minor Mode -------------------------------------------- +(defun idlwave-shell-toggle-electric-debug-mode () + "Toggle electric-debug-mode, suppressing re-entry into mode if turned off." + (interactive) + ;; If turning it off, make sure it stays off throughout the debug + ;; session until we return or hit $MAIN$. Cancel this suppression + ;; if it's explicitly turned on. + (if idlwave-shell-electric-debug-mode + (progn ;; Turn it off, and make sure it stays off. + (setq idlwave-shell-suppress-electric-debug t) + (idlwave-shell-electric-debug-mode 0)) + (setq idlwave-shell-suppress-electric-debug nil) + (idlwave-shell-electric-debug-mode t))) + +(defvar idlwave-shell-electric-debug-read-only) +(defvar idlwave-shell-electric-debug-buffers nil) + +(define-minor-mode idlwave-shell-electric-debug-mode + "Toggle Electric Debug mode. +With no argument, this command toggles the mode. +Non-null prefix argument turns on the mode. +Null prefix argument turns off the mode. + +When Electric Debug mode is enabled, the many debugging commands are +available as single key sequences." +nil +" *Debugging*" +idlwave-shell-electric-debug-mode-map) + +(add-hook + 'idlwave-shell-electric-debug-mode-on-hook + (lambda () + (set (make-local-variable 'idlwave-shell-electric-debug-read-only) + buffer-read-only) + (setq buffer-read-only t) + (add-to-list 'idlwave-shell-electric-debug-buffers (current-buffer)) + (if idlwave-shell-stop-line-overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + idlwave-shell-electric-stop-line-face)) + (if (facep 'fringe) + (set-face-foreground 'fringe idlwave-shell-electric-stop-color + (selected-frame))))) + +(add-hook + 'idlwave-shell-electric-debug-mode-off-hook + (lambda () + ;; Return to previous read-only state + (setq buffer-read-only (if (boundp 'idlwave-shell-electric-debug-read-only) + idlwave-shell-electric-debug-read-only)) + (setq idlwave-shell-electric-debug-buffers + (delq (current-buffer) idlwave-shell-electric-debug-buffers)) + (if idlwave-shell-stop-line-overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + idlwave-shell-stop-line-face) + (if (facep 'fringe) + (set-face-foreground 'fringe (face-foreground 'default)))))) + +;; easy-mmode defines electric-debug-mode for us, so we need to advise it. +(defadvice idlwave-shell-electric-debug-mode (after print-enter activate) + "Print out an entrance message" + (when idlwave-shell-electric-debug-mode + (message + "Electric Debugging mode entered. Press [C-?] for help, [q] to quit")) + (force-mode-line-update)) + +;; Turn it off in all relevant buffers +(defvar idlwave-shell-electric-debug-buffers nil) +(defun idlwave-shell-electric-debug-all-off () + (setq idlwave-shell-suppress-electric-debug nil) + (let ((buffers idlwave-shell-electric-debug-buffers) + buf) + (save-excursion + (while (setq buf (pop buffers)) + (when (buffer-live-p buf) + (set-buffer buf) + (when (and (eq major-mode 'idlwave-mode) + buffer-file-name + idlwave-shell-electric-debug-mode) + (idlwave-shell-electric-debug-mode 0)))))) + (setq idlwave-shell-electric-debug-buffers nil)) + +;; Show the help text +(defun idlwave-shell-electric-debug-help () + (interactive) + (with-output-to-temp-buffer "*IDLWAVE Electric Debug Help*" + (princ idlwave-shell-electric-debug-help)) + (let* ((current-window (selected-window)) + (window (get-buffer-window "*IDLWAVE Electric Debug Help*")) + (window-lines (window-height window))) + (select-window window) + (enlarge-window (1+ (- (count-lines 1 (point-max)) window-lines))) + (select-window current-window))) + + +;; The Menus -------------------------------------------------------------- (defvar idlwave-shell-menu-def - '("Debug" - ["Save and .RUN" idlwave-shell-save-and-run - (or (eq major-mode 'idlwave-mode) - idlwave-shell-last-save-and-action-file)] - ["Save and .COMPILE" idlwave-shell-save-and-compile - (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)]) - "--" - ["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] + `("Debug" + ["Electric Debug Mode" + idlwave-shell-electric-debug-mode + :style toggle :selected idlwave-shell-electric-debug-mode + :included (eq major-mode 'idlwave-mode) :keys "C-c C-d C-v"] "--" - ["Toggle Toolbar" idlwave-shell-toggle-toolbar t] - ["Exit IDL" idlwave-shell-quit t])) - -(setq idlwave-shell-menu-def - '("Debug" ("Compile & Run" ["Save and .RUN" idlwave-shell-save-and-run (or (eq major-mode 'idlwave-mode) @@ -3412,19 +4410,41 @@ Otherwise, just expand the file name." ["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] "--" - ["Run Region" idlwave-shell-run-region (eq major-mode 'idlwave-mode)] + ["Compile and Run Region" idlwave-shell-run-region + (eq major-mode 'idlwave-mode)] + ["Evaluate Region" idlwave-shell-evaluate-region + (eq major-mode 'idlwave-mode)] "--" ["Execute Default Cmd" idlwave-shell-execute-default-command-line t] ["Edit Default Cmd" idlwave-shell-edit-default-command-line t]) ("Breakpoints" - ["Set Breakpoint" idlwave-shell-break-here - (eq major-mode 'idlwave-mode)] - ["Break in Module" idlwave-shell-break-in t] + ["Set Breakpoint" idlwave-shell-break-here + :keys "C-c C-d C-b" :active (eq major-mode 'idlwave-mode)] + ("Set Special Breakpoint" + ["Set After Count Breakpoint" + (progn + (let ((count (string-to-number (read-string "Break after count: ")))) + (if (integerp count) (idlwave-shell-break-here count)))) + :active (eq major-mode 'idlwave-mode)] + ["Set Condition Breakpoint" + (idlwave-shell-break-here '(4)) + :active (eq major-mode 'idlwave-mode)]) + ["Break in Module" idlwave-shell-break-in + :keys "C-c C-d C-i" :active (eq major-mode 'idlwave-mode)] + ["Break in this Module" idlwave-shell-break-this-module + :keys "C-c C-d C-j" :active (eq major-mode 'idlwave-mode)] ["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]) + ["Disable/Enable Breakpoint" idlwave-shell-toggle-enable-current-bp t] + ["Goto Previous Breakpoint" idlwave-shell-goto-previous-bp + :keys "C-c C-d [" :active (eq major-mode 'idlwave-mode)] + ["Goto Next Breakpoint" idlwave-shell-goto-next-bp + :keys "C-c C-d ]" :active (eq major-mode 'idlwave-mode)] + ["List All Breakpoints" idlwave-shell-list-all-bp t] + ["Resync Breakpoints" idlwave-shell-bp-query t]) ("Continue/Step" ["Step (into)" idlwave-shell-step t] ["Step (over)" idlwave-shell-stepover t] @@ -3434,16 +4454,60 @@ Otherwise, just expand the file name." ["... to End of Subprog" idlwave-shell-return t] ["... to End of Subprog+1" idlwave-shell-out t] ["... to Here (Cursor Line)" idlwave-shell-to-here - (eq major-mode 'idlwave-mode)]) - ("Print Expression" + :keys "C-c C-d C-h" :active (eq major-mode 'idlwave-mode)]) + ("Examine Expressions" ["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)] - "--" - ["Redisplay" idlwave-shell-redisplay t] + ("Examine nearby expression with" + ,@(mapcar (lambda(x) + `[ ,(car x) (idlwave-shell-print nil ',x) t ]) + idlwave-shell-examine-alist)) + ("Examine region with" + ,@(mapcar (lambda(x) + `[ ,(car x) (idlwave-shell-print '(4) ',x) t ]) + idlwave-shell-examine-alist))) + ("Call Stack" ["Stack Up" idlwave-shell-stack-up t] - ["Stack Down" idlwave-shell-stack-down t]) + ["Stack Down" idlwave-shell-stack-down t] + "--" + ["Redisplay and Sync" idlwave-shell-redisplay t]) + ("Show Commands" + ["Everything" (if (eq idlwave-shell-show-commands 'everything) + (progn + (setq idlwave-shell-show-commands + (get 'idlwave-shell-show-commands 'last-val)) + (put 'idlwave-shell-show-commands 'last-val nil)) + (put 'idlwave-shell-show-commands 'last-val + idlwave-shell-show-commands) + (setq idlwave-shell-show-commands 'everything)) + :style toggle :selected (and (not (listp idlwave-shell-show-commands)) + (eq idlwave-shell-show-commands + 'everything))] + "--" + ["Compiling Commands" (idlwave-shell-add-or-remove-show 'run) + :style toggle + :selected (not (idlwave-shell-hide-p + 'run + (get 'idlwave-shell-show-commands 'last-val))) + :active (not (eq idlwave-shell-show-commands 'everything))] + ["Breakpoint Commands" (idlwave-shell-add-or-remove-show 'breakpoint) + :style toggle + :selected (not (idlwave-shell-hide-p + 'breakpoint + (get 'idlwave-shell-show-commands 'last-val))) + :active (not (eq idlwave-shell-show-commands 'everything))] + ["Debug Commands" (idlwave-shell-add-or-remove-show 'debug) + :style toggle + :selected (not (idlwave-shell-hide-p + 'debug + (get 'idlwave-shell-show-commands 'last-val))) + :active (not (eq idlwave-shell-show-commands 'everything))] + ["Miscellaneous Commands" (idlwave-shell-add-or-remove-show 'misc) + :style toggle + :selected (not (idlwave-shell-hide-p + 'misc + (get 'idlwave-shell-show-commands 'last-val))) + :active (not (eq idlwave-shell-show-commands 'everything))]) ("Input Mode" ["Send one char" idlwave-shell-send-char t] ["Temporary Character Mode" idlwave-shell-char-mode-loop t] @@ -3454,6 +4518,11 @@ Otherwise, just expand the file name." :style toggle :selected idlwave-shell-use-input-mode-magic]) "--" ["Update Working Dir" idlwave-shell-resync-dirs t] + ["Save Path Info" + (idlwave-shell-send-command idlwave-shell-path-query + 'idlwave-shell-get-path-info + 'hide) + t] ["Reset IDL" idlwave-shell-reset t] "--" ["Toggle Toolbar" idlwave-shell-toggle-toolbar t] @@ -3461,12 +4530,12 @@ Otherwise, just expand the file name." (if (or (featurep 'easymenu) (load "easymenu" t)) (progn - (easy-menu-define - idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus" - idlwave-shell-menu-def) (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus" idlwave-shell-menu-def) + (easy-menu-define + idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus" + idlwave-shell-menu-def) (save-excursion (mapcar (lambda (buf) (set-buffer buf) @@ -3479,36 +4548,158 @@ Otherwise, just expand the file name." ;; The Breakpoint Glyph ------------------------------------------------------- (defvar idlwave-shell-bp-glyph nil - "The glyph to mark breakpoint lines in the source code.") + "The glyphs to mark breakpoint lines in the source code.") -(let ((image-string "/* XPM */ +(let ((image-alist + '((bp . "/* XPM */ static char * file[] = { \"14 12 3 1\", \" c None s backgroundColor\", \". c #4B4B4B4B4B4B\", \"R c #FFFF00000000\", \" \", +\" .... \", +\" .RRRR. \", +\" .RRRRRR. \", +\" .RRRRRRRR. \", +\" .RRRRRRRR. \", +\" .RRRRRRRR. \", +\" .RRRRRRRR. \", +\" .RRRRRR. \", +\" .RRRR. \", +\" .... \", +\" \"};") + (bp-cond . "/* XPM */ +static char * file[] = { +\"14 12 4 1\", +\" c None s backgroundColor\", +\". c #4B4B4B4B4B4B\", +\"R c #FFFF00000000\", +\"B c #000000000000\", \" \", -\" RRRR \", -\" RRRRRR \", -\" RRRRRRRR \", -\" RRRRRRRR \", -\" RRRRRRRR \", -\" RRRRRRRR \", -\" RRRRRR \", -\" RRRR \", +\" .... \", +\" .RRRR. \", +\" .RRRRRR. \", +\" .RRRRRRRR. \", +\" .RRBBBBRR. \", +\" .RRRRRRRR. \", +\" .RRBBBBRR. \", +\" .RRRRRR. \", +\" .RRRR. \", +\" .... \", +\" \"};") + (bp-1 . "/* XPM */ +static char * file[] = { +\"14 12 4 1\", +\" c None s backgroundColor\", +\". c #4B4B4B4B4B4B\", +\"X c #FFFF00000000\", +\"o c #000000000000\", \" \", -\" \"};")) - - (setq idlwave-shell-bp-glyph - (cond ((and (featurep 'xemacs) - (featurep 'xpm)) - (make-glyph image-string)) - ((and (not (featurep 'xemacs)) - (fboundp 'image-type-available-p) - (image-type-available-p 'xpm)) - (list 'image :type 'xpm :data image-string :ascent 'center)) - (t nil)))) +\" .... \", +\" .XXXX. \", +\" .XXooXX. \", +\" .XXoooXXX. \", +\" .XXXooXXX. \", +\" .XXXooXXX. \", +\" .XXooooXX. \", +\" .XooooX. \", +\" .XXXX. \", +\" .... \", +\" \"};") + (bp-2 . "/* XPM */ +static char * file[] = { +\"14 12 4 1\", +\" c None s backgroundColor\", +\". c #4B4B4B4B4B4B\", +\"X c #FFFF00000000\", +\"o c #000000000000\", +\" \", +\" .... \", +\" .XXXX. \", +\" .XoooXX. \", +\" .XXoXooXX. \", +\" .XXXXooXX. \", +\" .XXXooXXX. \", +\" .XXooXXXX. \", +\" .XooooX. \", +\" .XXXX. \", +\" .... \", +\" \"};") + (bp-3 . "/* XPM */ +static char * file[] = { +\"14 12 4 1\", +\" c None s backgroundColor\", +\". c #4B4B4B4B4B4B\", +\"X c #FFFF00000000\", +\"o c #000000000000\", +\" \", +\" .... \", +\" .XXXX. \", +\" .XoooXX. \", +\" .XXXXooXX. \", +\" .XXXooXXX. \", +\" .XXXXooXX. \", +\" .XXoXooXX. \", +\" .XoooXX. \", +\" .XXXX. \", +\" .... \", +\" \"};") + (bp-4 . "/* XPM */ +static char * file[] = { +\"14 12 4 1\", +\" c None s backgroundColor\", +\". c #4B4B4B4B4B4B\", +\"X c #FFFF00000000\", +\"o c #000000000000\", +\" \", +\" .... \", +\" .XXXX. \", +\" .XoXXoX. \", +\" .XXoXXoXX. \", +\" .XXooooXX. \", +\" .XXXXooXX. \", +\" .XXXXooXX. \", +\" .XXXooX. \", +\" .XXXX. \", +\" .... \", +\" \"};") + (bp-n . "/* XPM */ +static char * file[] = { +\"14 12 4 1\", +\" c None s backgroundColor\", +\". c #4B4B4B4B4B4B\", +\"X c #FFFF00000000\", +\"o c #000000000000\", +\" \", +\" .... \", +\" .XXXX. \", +\" .XXXXXX. \", +\" .XXoXoXXX. \", +\" .XXooXoXX. \", +\" .XXoXXoXX. \", +\" .XXoXXoXX. \", +\" .XoXXoX. \", +\" .XXXX. \", +\" .... \", +\" \"};"))) im-cons im) + + (while (setq im-cons (pop image-alist)) + (setq im (cond ((and (featurep 'xemacs) + (featurep 'xpm)) + (list + (let ((data (cdr im-cons))) + (string-match "#FFFF00000000" data) + (setq data (replace-match "#8F8F8F8F8F8F" t t data)) + (make-glyph data)) + (make-glyph (cdr im-cons)))) + ((and (not (featurep 'xemacs)) + (fboundp 'image-type-available-p) + (image-type-available-p 'xpm)) + (list 'image :type 'xpm :data (cdr im-cons) + :ascent 'center)) + (t nil))) + (if im (push (cons (car im-cons) im) idlwave-shell-bp-glyph)))) (provide 'idlw-shell) (provide 'idlwave-shell) @@ -3527,4 +4718,5 @@ static char * file[] = { (if idlwave-shell-use-toolbar (add-hook 'idlwave-shell-mode-hook 'idlwave-toolbar-add-everywhere)) +;; arch-tag: 20c2e8ce-0709-41d8-a5b6-bb039148440a ;;; idlw-shell.el ends here