]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/idlw-shell.el
(ada-prj-display-page): Use `mapc' rather than `mapcar'.
[gnu-emacs] / lisp / progmodes / idlw-shell.el
index 64f359aa1e72a08bfa9edcd992be59bcbf7d0d3f..f903d490565df844d681aba55ce4232b84a6b349 100644 (file)
@@ -14,7 +14,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -1026,7 +1026,8 @@ IDL has currently stepped.")
   (setq idlwave-shell-ready nil)
   (setq idlwave-shell-bp-alist nil)
   (idlwave-shell-update-bp-overlays) ; Throw away old overlays
-  (setq idlwave-shell-sources-alist nil)
+  (setq idlwave-shell-post-command-hook nil ;clean up any old stuff
+       idlwave-shell-sources-alist nil)
   (setq idlwave-shell-default-directory default-directory)
   (setq idlwave-shell-hide-output nil)
 
@@ -1303,7 +1304,7 @@ output to complete and the next prompt to arrive before returning
 \(useful if you need an answer now\). IDL is considered ready if the
 prompt is present and if `idlwave-shell-ready' is non-nil.  
 
-If SHOW-IF-ERROR is non-nil, show the output it it contains an error
+If SHOW-IF-ERROR is non-nil, show the output if it contains an error
 message, independent of what HIDE is set to."
 
 ;  (setq hide nil)  ;  FIXME: turn this on for debugging only
@@ -2585,7 +2586,7 @@ breakpoint can not be set."
                              (if (idlwave-shell-hide-p 'debug) 'mostly)
                              nil t))
 
-(defun idlwave-shell-clear-bp (bp)
+(defun idlwave-shell-clear-bp (bp &optional no-query)
   "Clear breakpoint BP.
 Clears in IDL and in `idlwave-shell-bp-alist'."
   (let ((index (idlwave-shell-bp-get bp)))
@@ -2594,7 +2595,7 @@ Clears in IDL and in `idlwave-shell-bp-alist'."
           (idlwave-shell-send-command
            (concat "breakpoint,/clear," (int-to-string index))
           nil (idlwave-shell-hide-p 'breakpoint) nil t)
-         (idlwave-shell-bp-query)))))
+         (unless no-query (idlwave-shell-bp-query))))))
 
 (defun idlwave-shell-current-frame ()
   "Return a list containing the current file name and line point is in.
@@ -2621,7 +2622,10 @@ Returns nil if unable to obtain a module name."
       (widen)
       (save-excursion
         (if (idlwave-prev-index-position)
-            (upcase (idlwave-unit-name)))))))
+           (let* ((module (idlwave-what-module))
+                  (name (idlwave-make-full-name (nth 2 module) (car module)))
+                  (type (nth 1 module)))
+             (list (upcase name) type)))))))
 
 (defun idlwave-shell-clear-current-bp ()
   "Remove breakpoint at current line.
@@ -2634,7 +2638,10 @@ at a breakpoint."
 
 (defun idlwave-shell-toggle-enable-current-bp (&optional bp force
                                                         no-update)
-  "Disable or enable current bp."
+  "Disable or enable current breakpoint or a breakpoint passed in BP.
+If FORCE is 'disable or 'enable, for that condition instead of
+toggling.  If NO-UPDATE is non-nil, don't update the breakpoint
+list after toggling."
   (interactive)
   (let* ((bp (or bp (idlwave-shell-find-current-bp)))
         (disabled (idlwave-shell-bp-get bp 'disabled)))
@@ -2685,23 +2692,30 @@ The command looks for an identifier near point and sets a breakpoint
 for the first line of the corresponding module.  If MODULE is `t', set
 in the current routine."
   (interactive)
-  (let ((module (idlwave-fix-module-if-obj_new (idlwave-what-module))))
+  (let* ((module (idlwave-fix-module-if-obj_new (idlwave-what-module)))
+        (type (nth 1 module))
+        (name (car module))
+        (class (nth 2 module)))
     (if module
        (progn 
-         (setq module (idlwave-make-full-name (nth 2 module) (car module)))
-         (idlwave-shell-module-source-query module)
-         (idlwave-shell-set-bp-in-module module))
+         (setq module (idlwave-make-full-name class name))
+         (idlwave-shell-module-source-query module type)
+         (idlwave-shell-set-bp-in-module name type class))
       (error "No identifier at point"))))
 
 
-(defun idlwave-shell-set-bp-in-module (module)
+(defun idlwave-shell-set-bp-in-module (name type class)
   "Set breakpoint in module.  Assumes that `idlwave-shell-sources-alist'
 contains an entry for that module."
-  (let ((source-file (car-safe 
-                     (cdr-safe
-                      (assoc (upcase module)
-                             idlwave-shell-sources-alist))))
-       buf)
+  (let* ((module (idlwave-make-full-name class name))
+        (source-file 
+         (car-safe (cdr-safe
+                    (or
+                     (assoc (upcase module)
+                            idlwave-shell-sources-alist)
+                     (nth 3 (idlwave-best-rinfo-assoc name type class 
+                                                      (idlwave-routines)))))))
+        buf)
     (if (or (not source-file)
            (not (file-regular-p source-file))
            (not (setq buf
@@ -3376,12 +3390,12 @@ Queries IDL using the string in `idlwave-shell-bp-query'."
                              'hide))
 
 (defun idlwave-shell-bp-get (bp &optional item)
-  "Get a value for a breakpoint.  
-BP has the form of elements in idlwave-shell-bp-alist.  Optional
-second arg ITEM is the particular value to retrieve.  ITEM can be
-'file, 'line, 'index, 'module, 'count, 'cmd, 'condition, 'disabled or
-'data.  'data returns a list of 'count, 'cmd and 'condition.  Defaults
-to 'index."
+  "Get a value for a breakpoint.  BP has the form of elements in
+idlwave-shell-bp-alist.  Optional second arg ITEM is the
+particular value to retrieve.  ITEM can be 'file, 'line, 'index,
+'module, 'count, 'cmd, 'condition, 'disabled, 'type, or
+'data.  'data returns a list of 'count, 'cmd and 'condition.
+Defaults to 'index."
   (cond
    ;; Frame
    ((eq item 'line) (nth 1 (car bp)))
@@ -3393,7 +3407,12 @@ to 'index."
    ((eq item 'condition) (nth 2 (cdr (cdr bp))))
    ((eq item 'disabled) (nth 3 (cdr (cdr bp))))
    ;; IDL breakpoint info
-   ((eq item 'module) (nth 1 (car (cdr bp))))
+   ((eq item 'module) 
+    (let ((module (nth 1 (car (cdr bp)))))
+      (if (listp module) (car module) module)))
+   ((eq item 'type)
+    (let ((module (nth 1 (car (cdr bp)))))
+      (if (listp module) (nth 1 module))))
    ;;    index - default
    (t (nth 0 (car (cdr bp))))))
 
@@ -3486,7 +3505,9 @@ If BP frame is in `idlwave-shell-bp-alist' updates the breakpoint data."
 and third args, DATA and MODULE, are optional.  Returns a breakpoint
 of the format used in `idlwave-shell-bp-alist'.  Can be used in commands
 attempting match a breakpoint in `idlwave-shell-bp-alist'."
-  (cons frame (cons (list nil module) data)))
+  (cons frame ;; (file line)
+       (cons (list nil module) ;; (index_id (module type) | module)
+             data)))           ;; (count command condition disabled)
 
 (defvar idlwave-shell-old-bp nil
   "List of breakpoints previous to setting a new breakpoint.")
@@ -3522,20 +3543,24 @@ specified.  If NO-SHOW is non-nil, don't do any updating."
    'hide)
 
   ;; Get sources for this routine in the sources list
-  (idlwave-shell-module-source-query (idlwave-shell-bp-get bp 'module))
+  (idlwave-shell-module-source-query (idlwave-shell-bp-get bp 'module)
+                                    (idlwave-shell-bp-get bp 'type))
   (let*
-      ((arg (idlwave-shell-bp-get bp 'count))
-       (key (cond
-              ((not (and arg (numberp arg))) "")
-              ((= arg 1)
-               ",/once")
-              ((> arg 1)
-               (format ",after=%d" arg))))
+      ((count (idlwave-shell-bp-get bp 'count))
        (condition (idlwave-shell-bp-get bp 'condition))
        (disabled (idlwave-shell-bp-get bp 'disabled))
-       (key (concat key 
-                   (if condition (concat ",CONDITION=\"" condition "\""))))
-       (key (concat key (if disabled ",/DISABLE")))
+       (key (concat (if (and count (numberp count))
+                       (cond
+                        ((= count 1) ",/once")
+                        ((> count 1) (format ",after=%d" count))))
+                   (if condition (concat ",CONDITION=\"" condition "\""))
+                   ;; IDL can't simultaneously set a condition/count
+                   ;; and disable a breakpoint, but it does keep both
+                   ;; of these when resetting the same BP.  We assume
+                   ;; DISABLE and CONDITION/COUNT are not set
+                   ;; together for a newly created breakpoint.
+                   (if (and disabled (not condition) (not count))
+                           ",/DISABLE")))
        (line (idlwave-shell-bp-get bp 'line)))
     (idlwave-shell-send-command
      (concat "breakpoint,'" 
@@ -3697,17 +3722,22 @@ Existing overlays are recycled, in order to minimize consumption."
                (setq old-buffers (delq (current-buffer) old-buffers)))
            (if (fboundp 'set-specifier) ;; XEmacs
                (set-specifier left-margin-width (cons (current-buffer) 2))
-             (setq left-margin-width 2))
-           (if (setq win (get-buffer-window (current-buffer) t))
-               (set-window-buffer win (current-buffer))))))
+             (if (< left-margin-width 2)
+                 (setq left-margin-width 2)))
+           (let ((window (get-buffer-window (current-buffer) 0)))
+             (if window
+                 (set-window-margins 
+                  window left-margin-width right-margin-width))))))
       (if use-glyph
          (while (setq buf (pop old-buffers))
            (with-current-buffer buf
              (if (fboundp 'set-specifier) ;; XEmacs
                  (set-specifier left-margin-width (cons (current-buffer) 0))
                (setq left-margin-width 0))
-             (if (setq win (get-buffer-window buf t))
-                 (set-window-buffer win buf))))))))
+             (let ((window (get-buffer-window buf 0)))
+               (if window
+                   (set-window-margins 
+                    window left-margin-width right-margin-width)))))))))
 
 (defun idlwave-shell-make-new-bp-overlay (&optional type disabled)
   "Make a new overlay for highlighting breakpoints.  
@@ -3936,30 +3966,31 @@ Elements of the alist have the form:
 
   (module name . (source-file-truename idlwave-internal-filename)).")
 
-(defun idlwave-shell-module-source-query (module)
-  "Determine the source file for a given module."
+(defun idlwave-shell-module-source-query (module &optional type)
+  "Determine the source file for a given module.
+Query as a function if TYPE set to something beside 'pro."
   (if module
       (idlwave-shell-send-command 
-       (format "print,(routine_info('%s',/SOURCE)).PATH" module)
+       (format "print,(routine_info('%s',/SOURCE%s)).PATH" module
+              (if (eq type 'pro) "" ",/FUNCTIONS"))
        `(idlwave-shell-module-source-filter ,module)
-       'hide)))
+       'hide 'wait)))
 
 (defun idlwave-shell-module-source-filter (module)
   "Get module source, and update idlwave-shell-sources-alist."
   (let ((old (assoc (upcase module) idlwave-shell-sources-alist))
        filename)
-    (if (string-match "\.PATH *[\n\r]\\([^\r\n]+\\)[\n\r]"
-                     idlwave-shell-command-output)
-       (setq filename (substring idlwave-shell-command-output 
-                                 (match-beginning 1) (match-end 1)))
-      (error "No file matching module found."))
-    (if old
-       (setcdr old (list (idlwave-shell-file-name filename) filename))
-      (setq idlwave-shell-sources-alist
-           (append idlwave-shell-sources-alist 
-                   (list (cons (upcase module)
-                               (list (idlwave-shell-file-name filename) 
-                                     filename))))))))
+    (when (string-match "\.PATH *[\n\r]\\([^%][^\r\n]+\\)[\n\r]"
+                       idlwave-shell-command-output)
+      (setq filename (substring idlwave-shell-command-output 
+                               (match-beginning 1) (match-end 1)))
+      (if old
+         (setcdr old (list (idlwave-shell-file-name filename) filename))
+       (setq idlwave-shell-sources-alist
+             (append idlwave-shell-sources-alist 
+                     (list (cons (upcase module)
+                                 (list (idlwave-shell-file-name filename) 
+                                       filename)))))))))
   
 (defun idlwave-shell-sources-query ()
   "Determine source files for all IDL compiled procedures.
@@ -4029,7 +4060,9 @@ list elements of the form:
    idlwave-shell-bp-query
    '(progn
       (idlwave-shell-filter-bp)
-      (mapcar 'idlwave-shell-clear-bp idlwave-shell-bp-alist))
+      (mapcar (lambda (x) (idlwave-shell-clear-bp x 'no-query))
+             idlwave-shell-bp-alist)
+      (idlwave-shell-bp-query))
    'hide))
 
 (defun idlwave-shell-list-all-bp ()
@@ -4101,6 +4134,7 @@ Otherwise, just expand the file name."
 
 ;(define-key idlwave-shell-mode-map "\M-?" 'comint-dynamic-list-completions)
 ;(define-key idlwave-shell-mode-map "\t" 'comint-dynamic-complete)
+
 (define-key idlwave-shell-mode-map "\C-w"     'comint-kill-region)
 (define-key idlwave-shell-mode-map "\t"       'idlwave-shell-complete)
 (define-key idlwave-shell-mode-map "\M-\t"    'idlwave-shell-complete)