+ (let* ((process (get-buffer-process (current-buffer)))
+ (process-mark (if process (process-mark process)))
+ (stack-label
+ (if (and (integerp idlwave-shell-calling-stack-index)
+ (> idlwave-shell-calling-stack-index 0))
+ (format " [-%d:%s]"
+ idlwave-shell-calling-stack-index
+ idlwave-shell-calling-stack-routine)))
+ expr beg end cmd examine-hook)
+ (cond
+ ((and (equal arg '(16))
+ (< (- (region-end) (region-beginning)) 2000))
+ (setq beg (region-beginning)
+ end (region-end)))
+ (arg
+ (setq expr (read-string "Expression: ")))
+ (t
+ (idlwave-with-special-syntax
+ ;; Move to beginning of current or previous expression
+ (if (looking-at "\\<\\|(")
+ ;; At beginning of expression, don't move backwards unless
+ ;; this is at the end of an indentifier.
+ (if (looking-at "\\>")
+ (backward-sexp))
+ (backward-sexp))
+ (if (looking-at "\\>")
+ ;; Move to beginning of identifier - must be an array or
+ ;; function expression.
+ (backward-sexp))
+ ;; Move to end of expression
+ (setq beg (point))
+ (forward-sexp)
+ (while (looking-at "\\>[[(]\\|\\.")
+ ;; an array
+ (forward-sexp))
+ (setq end (point)))))
+
+ ;; Get expression, but first move the begin mark if a
+ ;; process-mark is inside the region, to keep the overlay from
+ ;; wandering in the Shell.
+ (when (and beg end)
+ (if (and process-mark (> process-mark beg) (< process-mark end))
+ (setq beg (marker-position process-mark)))
+ (setq expr (buffer-substring beg end)))
+
+ ;; Show the overlay(s) and attach any necessary hooks and filters
+ (when (and beg end idlwave-shell-expression-overlay)
+ (move-overlay idlwave-shell-expression-overlay beg end
+ (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)
+
+ ;; Remove empty or comment-only lines
+ (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)
+ (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)))))
+
+(defvar idlwave-shell-examine-window-alist nil
+ "Variable to hold the win/height pairs for all *Examine* windows.")
+
+(defun idlwave-shell-examine-display ()
+ "View the examine command output in a separate buffer."
+ (let (win cur-beg cur-end)
+ (save-excursion
+ (set-buffer (get-buffer-create "*Examine*"))
+ (use-local-map idlwave-shell-examine-map)
+ (setq buffer-read-only nil)
+ (goto-char (point-max))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (if (string-match "^% Syntax error." idlwave-shell-command-output)
+ (insert "% Syntax error.\n")
+ (insert idlwave-shell-command-output)
+ ;; Just take the last bit between the prompts (if more than one).
+ (let* ((end (or
+ (re-search-backward idlwave-shell-prompt-pattern nil t)
+ (point-max)))
+ (beg (progn
+ (goto-char
+ (or (progn (if (re-search-backward
+ idlwave-shell-prompt-pattern nil t)
+ (match-end 0)))
+ (point-min)))
+ (re-search-forward "\n")))
+ (str (buffer-substring beg end)))
+ (delete-region (point-min) (point-max))
+ (insert str)
+ (if idlwave-shell-examine-label
+ (progn (goto-char (point-min))
+ (insert idlwave-shell-examine-label)
+ (setq idlwave-shell-examine-label nil)))))
+ (setq cur-beg (point-min)
+ cur-end (point-max))
+ (setq buffer-read-only t)
+ (move-overlay idlwave-shell-output-overlay cur-beg cur-end
+ (current-buffer))
+
+ ;; Look for the examine buffer in all windows. If one is
+ ;; found in a frame all by itself, use that, otherwise, switch
+ ;; to or create an examine window in this frame, and resize if
+ ;; it's a newly created window
+ (let* ((winlist (get-buffer-window-list "*Examine*" nil 'visible)))
+ (setq win (idlwave-display-buffer
+ "*Examine*"
+ nil
+ (let ((list winlist) thiswin)
+ (catch 'exit
+ (save-selected-window
+ (while (setq thiswin (pop list))
+ (select-window thiswin)
+ (if (one-window-p)
+ (throw 'exit (window-frame thiswin)))))))))
+ (set-window-start win (point-min)) ; Ensure the point is visible.
+ (save-selected-window
+ (select-window win)
+ (let ((elt (assoc win idlwave-shell-examine-window-alist)))
+ (when (and (not (one-window-p))
+ (or (not (memq win winlist)) ;a newly created window
+ (eq (window-height) (cdr elt))))
+ ;; Autosize it.
+ (enlarge-window (- (/ (frame-height) 2)
+ (window-height)))
+ (shrink-window-if-larger-than-buffer)
+ ;; Clean the window list of dead windows
+ (setq idlwave-shell-examine-window-alist
+ (delq nil
+ (mapcar (lambda (x) (if (window-live-p (car x)) x))
+ idlwave-shell-examine-window-alist)))
+ ;; And add the new value.
+ (if (setq elt (assoc win idlwave-shell-examine-window-alist))
+ (setcdr elt (window-height))
+ (add-to-list 'idlwave-shell-examine-window-alist
+ (cons win (window-height)))))))))
+ ;; Recenter for maximum output, after widened
+ (save-selected-window
+ (select-window win)
+ (goto-char (point-max))
+ (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)))
+ (if (one-window-p)
+ (delete-frame (window-frame win))
+ (delete-window win))))
+
+(defun idlwave-shell-examine-display-clear ()
+ (interactive)
+ (save-excursion
+ (let ((buf (get-buffer "*Examine*")))
+ (when (bufferp buf)
+ (set-buffer buf)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (setq buffer-read-only t)))))
+
+(defun idlwave-retrieve-expression-from-level (expr level routine help)
+ "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))
+ (start 0)
+ var tvar fetch-vars 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
+ ;; 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)
+ (setq var (match-string 2 expr)
+ tvar (concat prefix var)
+ start (match-beginning 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))))
+
+(defun idlwave-shell-help-statement (help expr)
+ "Construct a help statement for printing expression EXPR.
+
+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))
+ ((stringp help)
+ (if (string-match "\\(^\\|[^_]\\)\\(___\\)\\([^_]\\|$\\)" help)
+ (concat (substring help 0 (match-beginning 2))
+ expr
+ (substring help (match-end 2)))))
+ (t (concat "help, " expr))))
+
+
+(defun idlwave-shell-examine-highlight ()
+ "Highlight the most recent IDL output."
+ (let* ((buffer (get-buffer (idlwave-shell-buffer)))
+ (process (get-buffer-process buffer))
+ (process-mark (if process (process-mark process)))
+ output-begin output-end)
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char process-mark)
+ (beginning-of-line)
+ (setq output-end (point))
+ (re-search-backward idlwave-shell-prompt-pattern nil t)
+ (beginning-of-line 2)
+ (setq output-begin (point)))
+
+ ;; First make sure the shell window is visible
+ (idlwave-display-buffer (idlwave-shell-buffer)
+ nil (idlwave-shell-shell-frame))
+ (if (and idlwave-shell-output-overlay process-mark)
+ (move-overlay idlwave-shell-output-overlay
+ output-begin output-end buffer))))
+
+(defun idlwave-shell-delete-output-overlay ()
+ (if (eq this-command 'idlwave-shell-mouse-nop)
+ nil
+ (condition-case nil
+ (if idlwave-shell-output-overlay
+ (delete-overlay idlwave-shell-output-overlay))
+ (error nil))
+ (remove-hook 'pre-command-hook 'idlwave-shell-delete-output-overlay)))