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