;; idlw-shell.el --- run IDL as an inferior process of Emacs.
-;; Copyright (c) 1999,2000,2001,2002,2003,2004 Free Software Foundation
+;; Copyright (c) 1999, 2000, 2001, 2002, 2003, 2004, 2005
+;; Free Software Foundation
;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
;; Carsten Dominik <dominik@astro.uva.nl>
;; Chris Chase <chase@att.com>
;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>
-;; Version: 5.5
+;; Version: 5.7_22
;; Keywords: processes
;; This file is part of GNU Emacs.
;; 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:
;;
: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, and is required.
+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.
(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-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.
(regexp :tag "Char-mode regexp")
(regexp :tag "Line-mode regexp")))
+(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
(defgroup idlwave-shell-highlighting-and-faces nil
(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
(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
(defvar idlwave-shell-use-breakpoint-glyph t
"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-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 idlwave-shell-have-new-custom
- ;; We have the new customize - use it to define a customizable face
- (defface idlwave-shell-disabled-bp-face
- '((((class color)) (:foreground "Black" :background "gray"))
- (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-disabled-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-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'.
(defvar idlwave-shell-ready nil
"If non-nil can send next command to IDL process.")
-(defvar idlwave-shell-wait-for-output nil
- "Whether to wait for output to accumulate.")
-
;;; The following are the types of messages we attempt to catch to
;;; resync our idea of where IDL execution currently is.
;;;
(set-marker comint-last-input-end (point))
(setq idlwave-idlwave_routine_info-compiled nil)
(setq idlwave-shell-ready nil)
- (setq idlwave-shell-wait-for-output 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-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)
(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)
(set (make-local-variable 'comment-start) ";")
(setq abbrev-mode t)
- ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
- ;;(make-local-hook 'post-command-hook)
(add-hook 'post-command-hook 'idlwave-command-hook nil t)
;; Read the command history?
(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)
;; 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)
+ (format "defsysv,'!idlwave_version','%s',1" idlwave-mode-version)
nil 'hide)
;; Get the paths if they weren't read in from file
(if (and (not idlwave-path-alist)
; (progn
; (message "SENDING Pending commands: %s"
; (prin1-to-string idlwave-shell-pending-commands)))
-; (message "SENDING %s|||%s" cmd pcmd))
+; (message "SENDING %s|||%s" cmd pcmd))
(if (and (symbolp idlwave-shell-show-commands)
(eq idlwave-shell-show-commands 'everything))
(setq hide nil))
(set-marker comint-last-input-end (point))
(comint-simple-send proc cmd)
(setq idlwave-shell-ready nil)
- (when (equal preempt 'wait) ; Get all the output at once
- (setq idlwave-shell-wait-for-output t)
- (accept-process-output proc))))
+ (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))))
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.
- (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)))
+ (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
; (goto-char (point-max))
; (insert "\nSTRING===>\n" string "\n<====\n"))
- ;; Check for prompt in current accumulating output
- (if (setq idlwave-shell-ready
- (string-match idlwave-shell-prompt-pattern
- idlwave-shell-accumulation))
- (progn
- ;; Gather the command output
+ ;; 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 (point-min) (point)))
+ (delete-region (point-min) (point)))
+ (setq idlwave-shell-command-output
+ (with-current-buffer (process-buffer proc)
+ (buffer-substring
+ (save-excursion
+ (goto-char (process-mark proc))
+ (forward-line 0)
+ (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
- (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 (point-min) (point)))
- (delete-region (point-min) (point)))
- (setq idlwave-shell-command-output
- (with-current-buffer (process-buffer proc)
- (buffer-substring
- (save-excursion
- (goto-char (process-mark proc))
- (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))))))
+ (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
- idlwave-shell-wait-for-output nil))
- ;; Done with post command. Do pending command if
- ;; any.
- (idlwave-shell-send-command))
- ;; We didn't get the prompt yet... maybe accept more output
- (when idlwave-shell-wait-for-output
-;;; Test/Debug code
-; (save-excursion (set-buffer
-; (get-buffer-create "*idlwave-shell-output*"))
-; (goto-char (point-max))
-; (insert "\n<=== WAITING ON OUTPUT ==>\n"))
- (accept-process-output proc 1))))
- (store-match-data data)))))
+ ;; 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."
;; 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
;; 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))))
(when (not (string= expression ""))
(setq idlwave-shell-get-object-class nil)
(idlwave-shell-send-command
- (concat "print,obj_class(" expression ")")
+ (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
(defun idlwave-shell-parse-object-class ()
"Parse the output of the obj_class command."
- (let ((match "print,obj_class([^\n\r]+[\n\r ]"))
- (if (and
- (not (string-match (concat match match "\\s-*^[\n\r]+"
- "% Syntax error")
- idlwave-shell-command-output))
- (string-match (concat match "\\([A-Za-z_0-9]+\\)")
- idlwave-shell-command-output))
+ (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)))))
(looking-at "\\$")))
;; Debugging Commands ------------------------------------------------------
+(defvar idlwave-shell-electric-debug-mode) ; defined by easy-mmode
(defun idlwave-shell-redisplay (&optional hide)
"Tries to resync the display with where execution has stopped.
(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 condition no-show)
+(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
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")
(when (listp count)
(if (equal (car count) 4)
(idlwave-shell-set-bp
;; Create breakpoint
(idlwave-shell-bp (idlwave-shell-current-frame)
- (list count cmd condition nil)
+ (list count cmd condition disabled)
(idlwave-shell-current-module))
no-show))
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
(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.
"Set a breakpoint with count 1 then continue."
(interactive)
(let ((disabled (idlwave-shell-enable-all-bp 'disable 'no-update)))
- (idlwave-shell-break-here 1 nil nil 'no-show)
+ (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
for the first line of the corresponding module. If MODULE is `t', set
in the current routine."
(interactive)
- (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)))
+ (let ((module (idlwave-fix-module-if-obj_new (idlwave-what-module))))
+ (if module
+ (progn
+ (setq module (idlwave-make-full-name (nth 2 module) (car module)))
+ (idlwave-shell-module-source-query module)
+ (idlwave-shell-set-bp-in-module module))
+ (error "No identifier at point"))))
+
(defun idlwave-shell-set-bp-in-module (module)
"Set breakpoint in module. Assumes that `idlwave-shell-sources-alist'
(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."))
+ (unless bp-line (error "No further breakpoints"))
(goto-line bp-line)))
;; Examine Commands ------------------------------------------------------
t)
(defun idlwave-xemacs-hack-mouse-track (event)
- (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))))
+ (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)
(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)
versions of IDL."
(let ((fetch (- 0 level))
(start 0)
- var rnvar pre post)
+ var fetch-start fetch-end pre post)
;; 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
(while (string-match
"\\(\\`\\|[^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)
- 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
+ (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)))
- (t ;; seems to be a variable - replace its name in the
- ;; expression with the fetch.
- (setq rnvar (format "(routine_names('%s',fetch=%d))" var fetch)
- expr (concat pre rnvar post)
- start (+ start (length rnvar))))))
+ (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))
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 (string-to-int (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-int (match-string 8))))
+ (string-to-number (match-string 8))))
condition (match-string 13)
disabled (not (null (match-string 15)))))
((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))))
+ (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)
(idlwave-shell-filter-bp (quote ,no-show))
(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) (quote ,no-show)))
- 'hide))
-(defun idlwave-shell-set-bp2 (bp &optional no-show)
- "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))
(let*
((arg (idlwave-shell-bp-get bp 'count))
(key (cond
((> arg 1)
(format ",after=%d" arg))))
(condition (idlwave-shell-bp-get bp 'condition))
+ (disabled (idlwave-shell-bp-get bp 'disabled))
(key (concat key
(if condition (concat ",CONDITION=\"" condition "\""))))
+ (key (concat key (if disabled ",/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) (quote ,no-show))))
+ (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 &optional no-show)
+(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 (quote ,no-show))
- (idlwave-shell-new-bp (quote ,bp))
- (unless (quote ,no-show)
- (idlwave-shell-update-bp-overlays)))
- '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.
"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."
- ;(message "Updating Overlays")
(when idlwave-shell-mark-breakpoints
(let ((ov-alist (copy-alist idlwave-shell-bp-overlays))
(bp-list idlwave-shell-bp-alist)
(delq nil
(list
(if count
- (concat "n=" (int-to-string count)))
+ (concat "after:" (int-to-string count)))
(if condition
- (concat "condition: " condition))
+ (concat "condition:" condition))
(if disabled "disabled"))))
- (help-text (if help-list
- (mapconcat 'identity help-list ",")))
+ (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"))
(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 help-text)))
+ (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)
(if (setq match (assq full-type idlwave-shell-bp-overlays))
(push ov (cdr match))
(if (setq win (get-buffer-window buf t))
(set-window-buffer win buf))))))))
-
-(defun idlwave-shell-make-new-bp-overlay (&optional type disabled help)
+(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). If HELP is set, use it to make a tooltip with that
-text popup."
+only for glyphs)."
(let ((ov (make-overlay 1 1))
(use-glyph (and (memq idlwave-shell-mark-breakpoints '(t glyph))
idlwave-shell-bp-glyph))
(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)
(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 use-glyph
(propertize "@"
'display
(list (list 'margin 'left-margin)
- image-props)
- 'mouse-face 'highlight
- 'help-echo help))
+ image-props)))
(overlay-put ov 'before-string string))
;; just the face
(overlay-put ov 'face face)))
(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")
(module name . (source-file-truename idlwave-internal-filename)).")
+(defun idlwave-shell-module-source-query (module)
+ "Determine the source file for a given module."
+ (if module
+ (idlwave-shell-send-command
+ (format "print,(routine_info('%s',/SOURCE)).PATH" module)
+ `(idlwave-shell-module-source-filter ,module)
+ 'hide)))
+
+(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)
+ (if (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)))
+ (error "No file matching module found."))
+ (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)
+ (interactive)
(idlwave-shell-send-command idlwave-shell-sources-query
'idlwave-shell-sources-filter
'hide))
(idlwave-shell-file-name
(buffer-substring (match-beginning 1 )
(match-end 1))))
- (string-to-int
+ (string-to-number
(buffer-substring (match-beginning 2)
(match-end 2)))))
;; Try to find the column of the error
(setq idlwave-shell-suppress-electric-debug nil))
(idlwave-shell-electric-debug-mode))
-(defvar idlwave-shell-electric-debug-mode) ; defined by easy-mmode
(defvar idlwave-shell-electric-debug-read-only)
(defvar idlwave-shell-electric-debug-buffers nil)
(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)
("Set Special Breakpoint"
["Set After Count Breakpoint"
(progn
- (let ((count (string-to-int (read-string "Break after count: "))))
+ (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"