Mercurial > emacs
changeset 69822:84de63539ab8
Update to IDLWAVE version 6.0; see idlwave.org. Includes code to
obsolete idlw-rinfo.el.
| author | J.D. Smith <jdsmith@as.arizona.edu> |
|---|---|
| date | Thu, 06 Apr 2006 18:47:37 +0000 |
| parents | 5baeec79c0cd |
| children | 68a0990dcb35 |
| files | lisp/progmodes/idlw-shell.el lisp/progmodes/idlwave.el |
| diffstat | 2 files changed, 1318 insertions(+), 730 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/progmodes/idlw-shell.el Thu Apr 06 18:46:56 2006 +0000 +++ b/lisp/progmodes/idlw-shell.el Thu Apr 06 18:47:37 2006 +0000 @@ -1,12 +1,12 @@ ;; idlw-shell.el --- run IDL as an inferior process of Emacs. ;; Copyright (c) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 -;; Free Software Foundation, Inc. +;; Free Software Foundation ;; Authors: J.D. Smith <jdsmith@as.arizona.edu> ;; Carsten Dominik <dominik@astro.uva.nl> ;; Chris Chase <chase@att.com> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> -;; Version: 5.7_22 +;; Version: 6.0_em22 ;; Keywords: processes ;; This file is part of GNU Emacs. @@ -138,6 +138,11 @@ ;; (defcustom idlwave-shell-automatic-start...) See idlwave.el +(defcustom idlwave-shell-use-dedicated-window nil + "*Non-nil means, never replace the shell frame with another buffer." + :group 'idlwave-shell-general-setup + :type 'boolean) + (defcustom idlwave-shell-use-dedicated-frame nil "*Non-nil means, IDLWAVE should use a special frame to display shell buffer." :group 'idlwave-shell-general-setup @@ -313,8 +318,15 @@ (const :tag "All debug and stepping commands" debug) (const :tag "Close, window, retall, etc. commands" misc)))) +(defcustom idlwave-shell-max-print-length 200 + "Maximum number of array elements to print when examining." + :group 'idlwave-shell-command-setup + :type 'integer) + (defcustom idlwave-shell-examine-alist - '(("Print" . "print,___") + `(("Print" . ,(concat "idlwave_print_safe,___," + (number-to-string + idlwave-shell-max-print-length))) ("Help" . "help,___") ("Structure Help" . "help,___,/STRUCTURE") ("Dimensions" . "print,size(___,/DIMENSIONS)") @@ -322,6 +334,7 @@ ("N_Elements" . "print,n_elements(___)") ("All Size Info" . "help,(__IWsz__=size(___,/STRUCTURE)),/STRUCTURE & print,__IWsz__.DIMENSIONS") ("Ptr Valid" . "print,ptr_valid(___)") + ("Arg Present" . "print,arg_present(___)") ("Widget Valid" . "print,widget_info(___,/VALID)") ("Widget Geometry" . "help,widget_info(___,/GEOMETRY)")) "Alist of special examine commands for popup selection. @@ -437,6 +450,11 @@ :group 'idlwave-shell-command-setup :type 'boolean) +(defcustom idlwave-shell-reset-no-prompt nil + "If non-nil, skip the yes/no prompt when resetting the IDL session." + :group 'idlwave-shell-command-setup + :type 'boolean) + ;; Breakpoint Overlays etc (defgroup idlwave-shell-highlighting-and-faces nil "Highlighting and Faces used by the IDLWAVE Shell mode." @@ -488,11 +506,11 @@ (defcustom idlwave-shell-electric-stop-line-face (prog1 - (copy-face 'modeline 'idlwave-shell-electric-stop-line-face) - (set-face-background 'idlwave-shell-electric-stop-line-face + (copy-face 'modeline 'idlwave-shell-electric-stop-line) + (set-face-background 'idlwave-shell-electric-stop-line idlwave-shell-electric-stop-color) (condition-case nil - (set-face-foreground 'idlwave-shell-electric-stop-line-face nil) + (set-face-foreground 'idlwave-shell-electric-stop-line nil) (error nil))) "*The face for `idlwave-shell-stop-line-overlay' when in electric debug mode. Allows you to choose the font, color and other properties for the line @@ -553,6 +571,7 @@ "Face for highlighting lines with breakpoints." :group 'idlwave-shell-highlighting-and-faces)) + (defcustom idlwave-shell-expression-face 'secondary-selection "*The face for `idlwave-shell-expression-overlay'. Allows you to choose the font, color and other properties for @@ -652,7 +671,7 @@ "The overlay for where IDL is currently stopped.") (defvar idlwave-shell-is-stopped nil) (defvar idlwave-shell-expression-overlay nil - "The overlay for where IDL is currently stopped.") + "The overlay for the examined expression.") (defvar idlwave-shell-output-overlay nil "The overlay for the last IDL output.") @@ -700,10 +719,21 @@ (setq idlwave-shell-expression-overlay (make-overlay 1 1)) (overlay-put idlwave-shell-expression-overlay 'face idlwave-shell-expression-face) +(overlay-put idlwave-shell-expression-overlay + 'priority 1) (setq idlwave-shell-output-overlay (make-overlay 1 1)) (overlay-put idlwave-shell-output-overlay 'face idlwave-shell-output-face) +(copy-face idlwave-shell-stop-line-face + 'idlwave-shell-pending-stop) +(copy-face idlwave-shell-electric-stop-line-face + 'idlwave-shell-pending-electric-stop) +(set-face-background 'idlwave-shell-pending-stop "gray70") +(set-face-background 'idlwave-shell-pending-electric-stop "gray70") + + + (defvar idlwave-shell-bp-query "help,/breakpoints" "Command to obtain list of breakpoints") @@ -823,6 +853,7 @@ ? Help on expression near point or in region ([C-u ?]). x Examine expression near point or in region ([C-u x]) with letter completion of the examine type. + e Prompt for an expression to print. Miscellaneous: q Quit - end debugging session and return to the Shell's main level. @@ -998,6 +1029,8 @@ (setq idlwave-shell-default-directory default-directory) (setq idlwave-shell-hide-output nil) + ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility + ;; (make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm nil 'local) (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local) @@ -1040,6 +1073,8 @@ (set (make-local-variable 'comment-start) ";") (setq abbrev-mode t) + ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility + ;; make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'idlwave-command-hook nil t) ;; Read the command history? @@ -1061,23 +1096,25 @@ (idlwave-shell-send-command (format "defsysv,'!idlwave_version','%s',1" idlwave-mode-version) nil 'hide) - ;; Get the paths if they weren't read in from file - (if (and (not idlwave-path-alist) - (or (not (stringp idlwave-system-directory)) - (eq (length idlwave-system-directory) 0))) - (idlwave-shell-send-command idlwave-shell-path-query - 'idlwave-shell-get-path-info - 'hide))) - + ;; Read the paths, and save if they changed + (idlwave-shell-send-command idlwave-shell-path-query + 'idlwave-shell-get-path-info + 'hide)) + +(defvar idlwave-system-directory) (defun idlwave-shell-get-path-info (&optional no-write) "Get the path lists, writing to file unless NO-WRITE is set." (let* ((rpl (idlwave-shell-path-filter)) (sysdir (car rpl)) (dirs (cdr rpl)) - (old-path-alist idlwave-path-alist)) + (old-path-alist idlwave-path-alist) + (old-sys-dir idlwave-system-directory) + path-changed sysdir-changed) (when sysdir (setq idlwave-system-directory sysdir) - (put 'idlwave-system-directory 'from-shell t)) + (if (setq sysdir-changed + (not (string= idlwave-system-directory old-sys-dir))) + (put 'idlwave-system-directory 'from-shell t))) ;; Preserve any existing flags (setq idlwave-path-alist (mapcar (lambda (x) @@ -1086,11 +1123,13 @@ (cons x (cdr old-entry)) (list x)))) dirs)) - (put 'idlwave-path-alist 'from-shell t) + (if (setq path-changed (not (equal idlwave-path-alist old-path-alist))) + (put 'idlwave-path-alist 'from-shell t)) (if idlwave-path-alist - (if (and idlwave-auto-write-paths - (not idlwave-library-path) - (not no-write) ) + (if (and (not no-write) + idlwave-auto-write-paths + (or sysdir-changed path-changed) + (not idlwave-library-path)) (idlwave-write-paths)) ;; Fall back (setq idlwave-path-alist old-path-alist)))) @@ -1199,12 +1238,14 @@ (current-window (selected-window))) (select-window window) (goto-char (point-max)) + (if idlwave-shell-use-dedicated-window + (set-window-dedicated-p window t)) (select-window current-window) (if idlwave-shell-ready (raise-frame (window-frame window))) (if (eq (selected-frame) (window-frame window)) (select-window window)))) - ;; Save the paths at the end + ;; Save the paths at the end, if they are from the Shell and new. (add-hook 'idlwave-shell-sentinel-hook (lambda () (if (and @@ -1518,10 +1559,10 @@ ;;; Test/Debug code -; (save-excursion (set-buffer -; (get-buffer-create "*idlwave-shell-output*")) -; (goto-char (point-max)) -; (insert "\nSTRING===>\n" string "\n<====\n")) + ;(with-current-buffer + ; (get-buffer-create "*idlwave-shell-output*") + ; (goto-char (point-max)) + ; (insert "\nReceived STRING\n===>\n" string "\n<====\n")) ;; Check for prompt in current accumulating output (when (setq idlwave-shell-ready @@ -1536,14 +1577,14 @@ (re-search-backward idlwave-shell-prompt-pattern nil t) (goto-char (match-end 0)) (setq idlwave-shell-command-output - (buffer-substring (point-min) (point))) + (buffer-substring-no-properties (point-min) (point))) (delete-region (point-min) (point))) (setq idlwave-shell-command-output (with-current-buffer (process-buffer proc) - (buffer-substring + (buffer-substring-no-properties (save-excursion (goto-char (process-mark proc)) - (forward-line 0) + (forward-line 0) ; Emacs 21 (beginning-of-line nil) (point)) comint-last-input-end)))) @@ -1570,10 +1611,10 @@ ;; Call the post-command hook (if (listp idlwave-shell-post-command-hook) (progn - ;(message "Calling list") - ;(prin1 idlwave-shell-post-command-hook) + ;;(message "Calling list") + ;;(prin1 idlwave-shell-post-command-hook) (eval idlwave-shell-post-command-hook)) - ;(message "Calling command function") + ;;(message "Calling command function") (funcall idlwave-shell-post-command-hook)) ;; Reset to default state for next command. @@ -1668,6 +1709,8 @@ All parts may contain linebreaks surrounded by spaces. This is important in IDL5 which inserts random linebreaks in long module and file names.") +(defvar idlwave-shell-electric-debug-mode) ; defined by easy-mmode + (defun idlwave-shell-scan-for-state () "Scan for state info. Looks for messages in output from last IDL command indicating where IDL has stopped. The types of messages we are @@ -1688,9 +1731,8 @@ idlwave-shell-command-output) (string-match idlwave-shell-other-error idlwave-shell-command-output)) - (save-excursion - (set-buffer - (get-buffer-create idlwave-shell-error-buffer)) + (with-current-buffer + (get-buffer-create idlwave-shell-error-buffer) (erase-buffer) (insert idlwave-shell-command-output) (goto-char (point-min)) @@ -1723,8 +1765,10 @@ (substring idlwave-shell-command-output (match-end 0)))) (setq idlwave-shell-current-state 'halt) ;; Don't debug trace messages - (idlwave-shell-display-line (idlwave-shell-pc-frame) nil - (if trace 'no-debug))) + (idlwave-shell-display-line + (idlwave-shell-pc-frame) nil + (if trace 'disable + (if idlwave-shell-electric-debug-mode 'force)))) ;; Fourth Priority: Breakpoints ((string-match idlwave-shell-break-message @@ -1763,29 +1807,29 @@ (defun idlwave-shell-parse-line (string &optional skip-main) - "Parse IDL message for the subroutine, file name and line number. -We need to work hard here to remove the stupid line breaks inserted by -IDL5. These line breaks can be right in the middle of procedure -or file names. -It is very difficult to come up with a robust solution. This one seems -to be pretty good though. - -Here is in what ways it improves over the previous solution: - -1. The procedure name can be split and will be restored. -2. The number can be split. I have never seen this, but who knows. -3. We do not require the `.pro' extension for files. - -This function can still break when the file name ends on a end line -and the message line contains an additional line with garbage. Then -the first part of that garbage will be added to the file name. -However, the function checks the existence of the files with and -without this last part - thus the function only breaks if file name -plus garbage match an existing regular file. This is hopefully very -unlikely. - -If optional arg SKIP-MAIN is non-nil, don't parse $MAIN$ routine stop -statements." + "Parse IDL message for the subroutine, file name and line number." +;We need to work hard here to remove the stupid line breaks inserted by +;IDL5. These line breaks can be right in the middle of procedure +;or file names. +;It is very difficult to come up with a robust solution. This one seems +;to be pretty good though. +; +;Here is in what ways it improves over the previous solution: +; +;1. The procedure name can be split and will be restored. +;2. The number can be split. I have never seen this, but who knows. +;3. We do not require the `.pro' extension for files. +; +;This function can still break when the file name ends on an end line +;and the message line contains an additional line with garbage. Then +;the first part of that garbage will be added to the file name. +;However, the function checks the existence of the files with and +;without this last part - thus the function only breaks if file name +;plus garbage match an existing regular file. This is hopefully very +;unlikely. +; +;If optional arg SKIP-MAIN is non-nil, don't parse $MAIN$ routine stop +;statements. (let (number procedure file) (when (and (not (if skip-main (string-match ":\\s-*\\$MAIN" string))) @@ -1926,14 +1970,17 @@ HEAP_GC, /VERBOSE" ;; OBJ_DESTROY, OBJ_VALID() FIXME: should this be added? (interactive "P") - (message "Resetting IDL") - (setq idlwave-shell-calling-stack-index 0) - (idlwave-shell-send-command "retall" nil hidden) - (idlwave-shell-send-command "widget_control,/reset" nil hidden) - (idlwave-shell-send-command "close,/all" nil hidden) - ;; (idlwave-shell-send-command "obj_destroy, obj_valid()" nil hidden) - (idlwave-shell-send-command "heap_gc,/verbose" nil hidden) - (idlwave-shell-display-line nil)) + (when (or idlwave-shell-reset-no-prompt + (yes-or-no-p "Really Reset IDL and discard current session? ")) + (message "Resetting IDL") + (setq idlwave-shell-calling-stack-index 0) + ;; Give widget exit handlers a chance + (idlwave-shell-send-command "retall" nil hidden) + (idlwave-shell-send-command "widget_control,/reset" nil hidden) + (idlwave-shell-send-command "close,/all" nil hidden) + ;; (idlwave-shell-send-command "obj_destroy, obj_valid()" nil hidden) + (idlwave-shell-send-command "heap_gc,/verbose" nil hidden) + (idlwave-shell-display-line nil))) (defun idlwave-shell-path-filter () ;; Convert the output of the path query into a list of directories @@ -1978,9 +2025,6 @@ (message "Routine Info warning: No match for END line in \n>>>\n%s\n<<<\n" idlwave-shell-command-output))) - (if (string-match "\\S-" text) - ;; Obviously, the pro worked. Make a note that we have it now. - (setq idlwave-idlwave_routine_info-compiled t)) ;; Match the output lines (while (string-match "^IDLWAVE-\\(PRO\\|FUN\\): \\(.*\\)" text start) (setq start (match-end 0)) @@ -2208,7 +2252,6 @@ (looking-at "\\$"))) ;; Debugging Commands ------------------------------------------------------ -(defvar idlwave-shell-electric-debug-mode) ; defined by easy-mmode (defun idlwave-shell-redisplay (&optional hide) "Tries to resync the display with where execution has stopped. @@ -2259,14 +2302,14 @@ (setq idlwave-shell-calling-stack-routine (nth 2 (nth idlwave-shell-calling-stack-index stack))) - ;; only edebug if in that mode already + ;; force edebug for this frame if we're in that mode already (idlwave-shell-display-line (nth idlwave-shell-calling-stack-index stack) nil - (unless idlwave-shell-electric-debug-mode 'no-debug)) + (if idlwave-shell-electric-debug-mode 'force)) (message "%s" (or message - (format "In routine %s (stack level %d)" - idlwave-shell-calling-stack-routine - (- idlwave-shell-calling-stack-index)))))) + (format "In routine %s (stack level %d)" + idlwave-shell-calling-stack-routine + (- idlwave-shell-calling-stack-index)))))) (defun idlwave-shell-stack-up () "Display the source code one step up the calling stack." @@ -2302,30 +2345,38 @@ "Check that frame is for an existing file." (file-readable-p (car frame))) +(defun idlwave-shell-stop-line-pending () + ;; Temporarily change the color of the stop line overlay + (if idlwave-shell-stop-line-overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + (if idlwave-shell-electric-debug-mode + 'idlwave-shell-pending-electric-stop + 'idlwave-shell-pending-stop)))) + (defvar idlwave-shell-suppress-electric-debug nil) -(defun idlwave-shell-display-line (frame &optional col no-debug) - "Display FRAME file in other window with overlay arrow. - -FRAME is a list of file name, line number, and subroutine name. If -FRAME is nil then remove overlay. If COL is set, move point to that -column in the line. If NO-DEBUG is non-nil, do *not* toggle the electric -debug mode." +(defun idlwave-shell-display-line (frame &optional col debug) + "display frame file in other window with overlay arrow. + +frame is a list of file name, line number, and subroutine name. if +frame is nil then remove overlay. if col is set, move point to that +column in the line. if debug is non-nil, enable the electric debug +mode. if it is 'disable, do not enable no matter what the setting of +'idlwave-shell-automatic-electric-debug'. if it is 'force, enable no +matter what the settings of that variable." (if (not frame) - ;; Remove stop-line overlay from old position + ;; remove stop-line overlay from old position (progn (setq overlay-arrow-string nil) (setq idlwave-shell-mode-line-info nil) (setq idlwave-shell-is-stopped nil) (if idlwave-shell-stop-line-overlay (delete-overlay idlwave-shell-stop-line-overlay)) - ;; Turn off electric debug everywhere, if it's on - (if (and (not no-debug) - idlwave-shell-automatic-electric-debug) - (idlwave-shell-electric-debug-all-off))) + ;; turn off electric debug everywhere, if it's on + (idlwave-shell-electric-debug-all-off)) (if (not (idlwave-shell-valid-frame frame)) - ;; FIXME: errors are dangerous in shell filters. But I think I + ;; fixme: errors are dangerous in shell filters. but i think i ;; have never encountered this one. - (error (concat "Invalid frame - unable to access file: " (car frame))) + (error (concat "invalid frame - unable to access file: " (car frame))) ;;; ;;; buffer : the buffer to display a line in. ;;; select-shell: current buffer is the shell. @@ -2339,15 +2390,15 @@ (select-shell (equal (buffer-name) (idlwave-shell-buffer))) window pos electric) - ;; First make sure the shell window is visible + ;; first make sure the shell window is visible (idlwave-display-buffer (idlwave-shell-buffer) nil (idlwave-shell-shell-frame)) - ;; Now display the buffer and remember which window it is. + ;; now display the buffer and remember which window it is. (setq window (idlwave-display-buffer buffer nil (idlwave-shell-source-frame))) - ;; Enter the buffer and mark the line + ;; enter the buffer and mark the line (save-excursion (set-buffer buffer) (save-restriction @@ -2358,45 +2409,53 @@ (setq idlwave-shell-is-stopped t) (if idlwave-shell-stop-line-overlay - ;; Move overlay - (move-overlay idlwave-shell-stop-line-overlay - (point) (save-excursion (end-of-line) (point)) - (current-buffer)) - ;; Use the arrow instead, but only if marking is wanted. + (progn + ;; restore face and move overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + (if idlwave-shell-electric-debug-mode + idlwave-shell-electric-stop-line-face + idlwave-shell-stop-line-face)) + (move-overlay idlwave-shell-stop-line-overlay + (point) (save-excursion (end-of-line) (point)) + (current-buffer))) + ;; use the arrow instead, but only if marking is wanted. (if idlwave-shell-mark-stop-line (setq overlay-arrow-string idlwave-shell-overlay-arrow)) (or overlay-arrow-position ; create the marker if necessary (setq overlay-arrow-position (make-marker))) (set-marker overlay-arrow-position (point) buffer))) - ;; If the point is outside the restriction, widen the buffer. + ;; if the point is outside the restriction, widen the buffer. (if (or (< pos (point-min)) (> pos (point-max))) (progn (widen) (goto-char pos))) - ;; If we have the column of the error, move the cursor there. + ;; if we have the column of the error, move the cursor there. (if col (move-to-column col)) (setq pos (point)) - ;; Enter electric debug mode, if not prohibited and not in + ;; enter electric debug mode, if not prohibited and not in ;; it already - (when (and (or - (eq idlwave-shell-automatic-electric-debug t) - (and - (eq idlwave-shell-automatic-electric-debug 'breakpoint) - (not (eq idlwave-shell-current-state 'error)))) - (not no-debug) - (not idlwave-shell-suppress-electric-debug) - (not idlwave-shell-electric-debug-mode)) - (idlwave-shell-electric-debug-mode) - (setq electric t))) + (when (and (not idlwave-shell-electric-debug-mode) + (or (eq debug 'force) + (and + (not (eq debug 'disable)) ;; explicitly disabled + (or + (eq idlwave-shell-automatic-electric-debug t) + (and + (eq idlwave-shell-automatic-electric-debug + 'breakpoint) + (not (eq idlwave-shell-current-state 'error)))) + (not idlwave-shell-suppress-electric-debug)))) + (idlwave-shell-electric-debug-mode t)) + (setq electric idlwave-shell-electric-debug-mode)) ;; Make sure pos is really displayed in the window. (set-window-point window pos) ;; If we came from the shell, go back there. Otherwise select - ;; the window where the error is displayed. + ;; the window where the error/halt is displayed. (if (or (and idlwave-shell-electric-zap-to-file electric) (and (equal (buffer-name) (idlwave-shell-buffer)) (not select-shell))) @@ -2408,6 +2467,7 @@ (interactive "p") (or (not arg) (< arg 1) (setq arg 1)) + (idlwave-shell-stop-line-pending) (idlwave-shell-send-command (concat ".s " (if (integerp arg) (int-to-string arg) arg)) nil (if (idlwave-shell-hide-p 'debug) 'mostly) nil t)) @@ -2419,6 +2479,7 @@ (interactive "p") (or (not arg) (< arg 1) (setq arg 1)) + (idlwave-shell-stop-line-pending) (idlwave-shell-send-command (concat ".so " (if (integerp arg) (int-to-string arg) arg)) nil (if (idlwave-shell-hide-p 'debug) 'mostly) nil t)) @@ -2462,13 +2523,13 @@ (beep) (y-or-n-p (concat "Okay to recompile file " - (idlwave-shell-bp-get bp 'file) "? "))) + (idlwave-shell-bp-get bp 'file) "?"))) ;; Recompile (progn ;; Clean up before retrying (idlwave-shell-command-failure) (idlwave-shell-send-command - (concat ".run " (idlwave-shell-bp-get bp 'file)) nil + (concat ".run \"" (idlwave-shell-bp-get bp 'file) "\"") nil (if (idlwave-shell-hide-p 'run) 'mostly) nil t) ;; Try setting breakpoint again (idlwave-shell-set-bp bp)) @@ -2496,6 +2557,7 @@ (defun idlwave-shell-cont (&optional no-show) "Continue executing." (interactive) + (idlwave-shell-stop-line-pending) (idlwave-shell-send-command ".c" (unless no-show '(idlwave-shell-redisplay 'hide)) (if (idlwave-shell-hide-p 'debug) 'mostly) @@ -2504,6 +2566,7 @@ (defun idlwave-shell-go () "Run .GO. This starts the main program of the last compiled file." (interactive) + (idlwave-shell-stop-line-pending) (idlwave-shell-send-command ".go" '(idlwave-shell-redisplay 'hide) (if (idlwave-shell-hide-p 'debug) 'mostly) nil t)) @@ -2511,6 +2574,7 @@ (defun idlwave-shell-return () "Run .RETURN (continue to next return, but stay in subprogram)." (interactive) + (idlwave-shell-stop-line-pending) (idlwave-shell-send-command ".return" '(idlwave-shell-redisplay 'hide) (if (idlwave-shell-hide-p 'debug) 'mostly) nil t)) @@ -2518,6 +2582,7 @@ (defun idlwave-shell-skip () "Run .SKIP (skip one line, then step)." (interactive) + (idlwave-shell-stop-line-pending) (idlwave-shell-send-command ".skip" '(idlwave-shell-redisplay 'hide) (if (idlwave-shell-hide-p 'debug) 'mostly) nil t)) @@ -2603,6 +2668,7 @@ (defun idlwave-shell-to-here () "Set a breakpoint with count 1 then continue." (interactive) + ;; temporarily disable all other breakpoints (let ((disabled (idlwave-shell-enable-all-bp 'disable 'no-update))) (idlwave-shell-break-here 1 nil nil nil 'no-show) (idlwave-shell-cont 'no-show) @@ -2739,13 +2805,18 @@ `(lambda (event) "Expansion function for expression examination." (interactive "e") - (let ((transient-mark-mode t) - (zmacs-regions t) - (tracker (if (featurep 'xemacs) - (if (fboundp 'default-mouse-track-event-is-with-button) - 'idlwave-xemacs-hack-mouse-track - 'mouse-track) - 'mouse-drag-region))) + (let* ((drag-track (fboundp 'mouse-drag-track)) + (transient-mark-mode t) + (zmacs-regions t) + (tracker (if (featurep 'xemacs) + (if (fboundp + 'default-mouse-track-event-is-with-button) + 'idlwave-xemacs-hack-mouse-track + 'mouse-track) + ;; Emacs 22 no longer completes the drag with + ;; mouse-drag-region, without an additional + ;; event. mouse-drag-track does so. + (if drag-track 'mouse-drag-track 'mouse-drag-region)))) (funcall tracker event) (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil) ,help ,ev)))) @@ -2756,8 +2827,9 @@ t) (defun idlwave-xemacs-hack-mouse-track (event) - (if (featurep 'xemacs) - (let ((oldfunc (symbol-function 'default-mouse-track-event-is-with-button))) + (if (featurep 'xemacs) + (let ((oldfunc (symbol-function + 'default-mouse-track-event-is-with-button))) (unwind-protect (progn (fset 'default-mouse-track-event-is-with-button @@ -2822,6 +2894,11 @@ If instead COMPLETE-HELP-TYPE is non-nil, choose from idlw-shell-examine-alist via mini-buffer shortcut key." (interactive "P") + + ;; For speed: assume the helper routine hasn't been lost, e.g. with + ;; .FULL_RESET_SESSION. We'll recover if necessary + (unless idlwave-idlwave_routine_info-compiled + (idlwave-shell-compile-helper-routines)) (save-excursion (let* ((process (get-buffer-process (current-buffer))) (process-mark (if process (process-mark process))) @@ -2831,7 +2908,7 @@ (format " [-%d:%s]" idlwave-shell-calling-stack-index idlwave-shell-calling-stack-routine))) - expr beg end cmd examine-hook) + expr beg end cmd) (cond ((equal arg '(16)) (setq expr (read-string "Expression: "))) @@ -2874,10 +2951,6 @@ (current-buffer)) (add-hook 'pre-command-hook 'idlwave-shell-delete-expression-overlay)) - (setq examine-hook - (if idlwave-shell-separate-examine-output - 'idlwave-shell-examine-display - 'idlwave-shell-examine-highlight)) (add-hook 'pre-command-hook 'idlwave-shell-delete-output-overlay) @@ -2939,7 +3012,7 @@ ;;(idlwave-shell-recenter-shell-window) (idlwave-shell-send-command cmd - examine-hook + 'idlwave-shell-check-compiled-and-display (if idlwave-shell-separate-examine-output 'hide)))))) (defvar idlwave-shell-examine-window-alist nil @@ -2949,6 +3022,15 @@ (define-key idlwave-shell-examine-map "q" 'idlwave-shell-examine-display-quit) (define-key idlwave-shell-examine-map "c" 'idlwave-shell-examine-display-clear) + +(defun idlwave-shell-check-compiled-and-display () + "Check examine output for warning about undefined procedure/function." + (if (string-match "% Attempt to call undefined" idlwave-shell-command-output) + (idlwave-shell-compile-helper-routines)) + (if idlwave-shell-separate-examine-output + (idlwave-shell-examine-display) + (idlwave-shell-examine-highlight))) + (defun idlwave-shell-examine-display () "View the examine command output in a separate buffer." (let (win cur-beg cur-end) @@ -3121,13 +3203,16 @@ to insert expression in place of the marker ___, e.g.: print, size(___,/DIMENSIONS)" (cond - ((null help) (concat "print, " expr)) + ((null help) + (concat "idlwave_print_safe, " expr "," + (number-to-string idlwave-shell-max-print-length))) ((stringp help) (if (string-match "\\(^\\|[^_]\\)\\(___\\)\\([^_]\\|$\\)" help) (concat (substring help 0 (match-beginning 2)) expr (substring help (match-end 2))))) - (t (concat "help, " expr)))) + (t + (concat "help, " expr)))) (defun idlwave-shell-examine-highlight () @@ -3221,7 +3306,8 @@ (idlwave-look-at "\\<end\\>"))) (insert "\nend\n")) (save-buffer 0))) - (idlwave-shell-send-command (concat ".run " idlwave-shell-temp-pro-file) + (idlwave-shell-send-command (concat ".run \"" + idlwave-shell-temp-pro-file "\"") nil (if (idlwave-shell-hide-p 'run) 'mostly) nil t) @@ -3822,8 +3908,11 @@ ((eq action 'compile) ".compile ") ((eq action 'batch) "@") (t (error "Unknown action %s" action))) - idlwave-shell-last-save-and-action-file) - 'idlwave-shell-maybe-update-routine-info + "\"" + idlwave-shell-last-save-and-action-file + "\"") + `(idlwave-shell-maybe-update-routine-info nil + ,idlwave-shell-last-save-and-action-file) (if (idlwave-shell-hide-p 'run) 'mostly) nil t) (idlwave-shell-bp-query)) (let ((msg (format "No such file %s" @@ -3831,14 +3920,14 @@ (setq idlwave-shell-last-save-and-action-file nil) (error msg)))) -(defun idlwave-shell-maybe-update-routine-info (&optional wait) +(defun idlwave-shell-maybe-update-routine-info (&optional wait file) "Update the routine info if the shell is not stopped at an error." (if (and (not idlwave-shell-is-stopped) (or (eq t idlwave-auto-routine-info-updates) (memq 'compile-buffer idlwave-auto-routine-info-updates)) idlwave-query-shell-for-routine-info idlwave-routines) - (idlwave-shell-update-routine-info t nil wait))) + (idlwave-shell-update-routine-info t nil wait file))) (defvar idlwave-shell-sources-query "help,/source,/full" "IDL command to obtain source files for compiled procedures.") @@ -3983,7 +4072,7 @@ (setq idlwave-shell-error-last (point))) (if frame (progn - (idlwave-shell-display-line frame col 'no-debug)) + (idlwave-shell-display-line frame col 'disable)) (beep) (message "No more errors.")))) @@ -4158,6 +4247,8 @@ 'idlwave-shell-stack-down) (define-key idlwave-shell-electric-debug-mode-map "_" 'idlwave-shell-stack-down) +(define-key idlwave-shell-electric-debug-mode-map "e" + '(lambda () (interactive) (idlwave-shell-print '(16)))) (define-key idlwave-shell-electric-debug-mode-map "q" 'idlwave-shell-retall) (define-key idlwave-shell-electric-debug-mode-map "t" '(lambda () (interactive) (idlwave-shell-send-command "help,/TRACE"))) @@ -4181,9 +4272,11 @@ ;; session until we return or hit $MAIN$. Cancel this suppression ;; if it's explicitly turned on. (if idlwave-shell-electric-debug-mode - (setq idlwave-shell-suppress-electric-debug t) - (setq idlwave-shell-suppress-electric-debug nil)) - (idlwave-shell-electric-debug-mode)) + (progn ;; Turn it off, and make sure it stays off. + (setq idlwave-shell-suppress-electric-debug t) + (idlwave-shell-electric-debug-mode 0)) + (setq idlwave-shell-suppress-electric-debug nil) + (idlwave-shell-electric-debug-mode t))) (defvar idlwave-shell-electric-debug-read-only) (defvar idlwave-shell-electric-debug-buffers nil) @@ -4196,9 +4289,9 @@ When Electric Debug mode is enabled, the many debugging commands are available as single key sequences." - nil - " *Debugging*" - idlwave-shell-electric-debug-mode-map) +nil +" *Debugging*" +idlwave-shell-electric-debug-mode-map) (add-hook 'idlwave-shell-electric-debug-mode-on-hook @@ -4249,7 +4342,7 @@ (when (and (eq major-mode 'idlwave-mode) buffer-file-name idlwave-shell-electric-debug-mode) - (idlwave-shell-electric-debug-mode)))))) + (idlwave-shell-electric-debug-mode 0)))))) (setq idlwave-shell-electric-debug-buffers nil)) ;; Show the help text
--- a/lisp/progmodes/idlwave.el Thu Apr 06 18:46:56 2006 +0000 +++ b/lisp/progmodes/idlwave.el Thu Apr 06 18:47:37 2006 +0000 @@ -1,12 +1,12 @@ ;; idlwave.el --- IDL editing mode for GNU Emacs ;; Copyright (c) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 -;; Free Software Foundation, Inc. +;; Free Software Foundation ;; Authors: J.D. Smith <jdsmith@as.arizona.edu> ;; Carsten Dominik <dominik@science.uva.nl> ;; Chris Chase <chase@att.com> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> -;; Version: 5.7_22 +;; Version: 6.0_em22 ;; Keywords: languages ;; This file is part of GNU Emacs. @@ -28,7 +28,10 @@ ;;; Commentary: -;; IDLWAVE enables feature-rich development and interaction with IDL. +;; IDLWAVE enables feature-rich development and interaction with IDL, +;; the Interactive Data Language. It provides a compelling, +;; full-featured alternative to the IDLDE development environment +;; bundled with IDL. ;; In the remotely distant past, based on pascal.el, though bears ;; little resemblance to it now. @@ -72,7 +75,7 @@ ;; of the documentation is available from the maintainers webpage (see ;; SOURCE). ;; -;; +;; ;; ACKNOWLEDGMENTS ;; =============== ;; @@ -122,7 +125,7 @@ ;; up inserting the character that expanded the abbrev after moving ;; point backward, e.g., "\cl" expanded with a space becomes ;; "LONG( )" with point before the close paren. This is solved by -;; using a temporary function in `post-command-hook' - not pretty, +;; using a temporary function in `post-command-hook' - not pretty, ;; but it works. ;; ;; Tabs and spaces are treated equally as whitespace when filling a @@ -160,6 +163,8 @@ (defalias 'line-end-position 'point-at-eol)) (unless (fboundp 'char-valid-p) (defalias 'char-valid-p 'characterp)) +(unless (fboundp 'match-string-no-properties) + (defalias 'match-string-no-properties 'match-string)) (if (not (fboundp 'cancel-timer)) (condition-case nil @@ -173,13 +178,13 @@ nil ;; We've got what we needed ;; We have the old or no custom-library, hack around it! (defmacro defgroup (&rest args) nil) - (defmacro defcustom (var value doc &rest args) + (defmacro defcustom (var value doc &rest args) `(defvar ,var ,value ,doc)))) (defgroup idlwave nil "Major mode for editing IDL .pro files." :tag "IDLWAVE" - :link '(url-link :tag "Home Page" + :link '(url-link :tag "Home Page" "http://idlwave.org") :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" "idlw-shell.el") @@ -195,34 +200,34 @@ "Indentation and formatting options for IDLWAVE mode." :group 'idlwave) -(defcustom idlwave-main-block-indent 0 +(defcustom idlwave-main-block-indent 2 "*Extra indentation for the main block of code. That is the block between the FUNCTION/PRO statement and the END statement for that program unit." :group 'idlwave-code-formatting :type 'integer) -(defcustom idlwave-block-indent 4 +(defcustom idlwave-block-indent 3 "*Extra indentation applied to block lines. If you change this, you probably also want to change `idlwave-end-offset'." :group 'idlwave-code-formatting :type 'integer) -(defcustom idlwave-end-offset -4 +(defcustom idlwave-end-offset -3 "*Extra indentation applied to block END lines. A value equal to negative `idlwave-block-indent' will make END lines line up with the block BEGIN lines." :group 'idlwave-code-formatting :type 'integer) -(defcustom idlwave-continuation-indent 2 +(defcustom idlwave-continuation-indent 3 "*Extra indentation applied to continuation lines. This extra offset applies to the first of a set of continuation lines. The following lines receive the same indentation as the first." :group 'idlwave-code-formatting :type 'integer) -(defcustom idlwave-max-extra-continuation-indent 20 +(defcustom idlwave-max-extra-continuation-indent 40 "*Maximum additional indentation for special continuation indent. Several special indentations are tried to help line up continuation lines in routine calls or definitions, other statements with @@ -293,8 +298,8 @@ (defcustom idlwave-auto-fill-split-string t "*If non-nil then auto fill will split strings with the IDL `+' operator. -When the line end falls within a string, string concatenation with the -'+' operator will be used to distribute a long string over lines. +When the line end falls within a string, string concatenation with the +'+' operator will be used to distribute a long string over lines. If nil and a string is split then a terminal beep and warning are issued. This variable is ignored when `idlwave-fill-comment-line-only' is @@ -354,17 +359,20 @@ :type 'boolean) (defcustom idlwave-init-rinfo-when-idle-after 10 - "*Seconds of idle time before routine info is automatically initialized. -Initializing the routine info can take long, in particular if a large -library catalog is involved. When Emacs is idle for more than the number -of seconds specified by this variable, it starts the initialization. -The process is split into five steps, in order to keep possible work -interruption as short as possible. If one of the steps finishes, and no -user input has arrived in the mean time, initialization proceeds immediately -to the next step. -A good value for this variable is about 1/3 of the time initialization -take in you setup. So if you have a fast machine and no problems with a slow network connection, don't hesitate to set this to 2 seconds. -A Value of 0 means, don't initialize automatically." + "*Seconds of idle time before routine info is automatically +initialized. Initializing the routine info can take a long time, in +particular if a large number of library catalogs are involved. When +Emacs is idle for more than the number of seconds specified by this +variable, it starts the initialization. The process is split into +five steps, in order to keep work interruption as short as possible. +If one of the steps finishes, and no user input has arrived in the +mean time, initialization proceeds immediately to the next step. A +good value for this variable is about 1/3 of the time initialization +take in your setup. So if you have a fast machine and no problems +with a slow network connection, don't hesitate to set this to 2 +seconds. A Value of 0 means, don't initialize automatically, but +instead wait until routine information is needed, and initialize +then." :group 'idlwave-routine-info :type 'number) @@ -410,7 +418,7 @@ (const :tag "When saving a buffer" save-buffer) (const :tag "After a buffer was killed" kill-buffer) (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) - + (defcustom idlwave-rinfo-max-source-lines 5 "*Maximum number of source files displayed in the Routine Info window. When an integer, it is the maximum number of source files displayed. @@ -419,16 +427,17 @@ :type 'integer) (defcustom idlwave-library-path nil - "Library path for Windows and MacOS. Not needed under Unix. When -selecting the directories to scan for IDL user catalog routine info, -IDLWAVE can, under UNIX, query the shell for the exact search path -\(the value of !PATH). However, under Windows and MacOS (pre-OSX), -the IDLWAVE shell does not work. In this case, this variable can be -set to specify the paths where IDLWAVE can find PRO files. The shell -will only be asked for a list of paths when this variable is nil. The -value is a list of directories. A directory preceeded by a `+' will -be searched recursively. If you set this variable on a UNIX system, -the shell will not be queried. See also `idlwave-system-directory'." + "Library path for Windows and MacOS (OS9). Not needed under Unix. +When selecting the directories to scan for IDL user catalog routine +info, IDLWAVE can, under UNIX, query the shell for the exact search +path \(the value of !PATH). However, under Windows and MacOS +(pre-OSX), the IDLWAVE shell does not work. In this case, this +variable can be set to specify the paths where IDLWAVE can find PRO +files. The shell will only be asked for a list of paths when this +variable is nil. The value is a list of directories. A directory +preceeded by a `+' will be searched recursively. If you set this +variable on a UNIX system, the shell will not be queried. See also +`idlwave-system-directory'." :group 'idlwave-routine-info :type '(repeat (directory))) @@ -443,13 +452,15 @@ :group 'idlwave-routine-info :type 'directory) -(defcustom idlwave-config-directory +;; Configuration files +(defcustom idlwave-config-directory (convert-standard-filename "~/.idlwave") "*Directory for configuration files and user-library catalog." :group 'idlwave-routine-info :type 'file) (defvar idlwave-user-catalog-file "idlusercat.el") +(defvar idlwave-xml-system-rinfo-converted-file "idl_xml_rinfo.el") (defvar idlwave-path-file "idlpath.el") (defvar idlwave-libinfo-file nil @@ -458,7 +469,7 @@ (defcustom idlwave-special-lib-alist nil "Alist of regular expressions matching special library directories. When listing routine source locations, IDLWAVE gives a short hint where -the file defining the routine is located. By default it lists `SystemLib' +the file defining the routine is located. By default it lists `SystemLib' for routines in the system library `!DIR/lib' and `Library' for anything else. This variable can define additional types. The car of each entry is a regular expression matching the file name (they normally will match @@ -469,7 +480,7 @@ (cons regexp string))) (defcustom idlwave-auto-write-paths t - "Write out path (!PATH) and system directory (!DIR) info automatically. + "Write out path (!PATH) and system directory (!DIR) info automatically. Path info is needed to locate library catalog files. If non-nil, whenever the path-list changes as a result of shell-query, etc., it is written to file. Otherwise, the menu option \"Write Paths\" can be @@ -500,7 +511,7 @@ This variable determines the case (UPPER/lower/Capitalized...) of words inserted into the buffer by completion. The preferred case can be specified separately for routine names, keywords, classes and -methods. +methods. This alist should therefore have entries for `routine' (normal functions and procedures, i.e. non-methods), `keyword', `class', and `method'. Plausible values are @@ -587,7 +598,7 @@ for which to assume this can be set here." :group 'idlwave-routine-info :type '(repeat (regexp :tag "Match method:"))) - + (defcustom idlwave-completion-show-classes 1 "*Number of classes to show when completing object methods and keywords. @@ -652,7 +663,7 @@ specify if the class should be found during method and keyword completion, respectively. -The alist may have additional entries specifying exceptions from the +The alist may have additional entries specifying exceptions from the keyword completion rule for specific methods, like INIT or GETPROPERTY. In order to turn on class specification for the INIT method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." @@ -668,7 +679,7 @@ (cons (string :tag "MODULE" :value "") (boolean :tag "Determine class for this method"))))) -(defcustom idlwave-store-inquired-class nil +(defcustom idlwave-store-inquired-class t "*Non-nil means, store class of a method call as text property on `->'. IDLWAVE sometimes has to ask the user for the class associated with a particular object method call. This happens during the commands @@ -676,7 +687,7 @@ value of the variable `idlwave-query-class'. When you specify a class, this information can be stored as a text -property on the `->' arrow in the source code, so that during the same +property on the `->' arrow in the source code, so that during the same editing session, IDLWAVE will not have to ask again. When this variable is non-nil, IDLWAVE will store and reuse the class information. The class stored can be checked and removed with `\\[idlwave-routine-info]' @@ -950,7 +961,7 @@ For example you might set PATHNAME to the path for the lib_template.pro file included in the IDL distribution.") -(defcustom idlwave-header-to-beginning-of-file nil +(defcustom idlwave-header-to-beginning-of-file t "*Non-nil means, the documentation header will always be at start of file. When nil, the header is positioned between the PRO/FUNCTION line of the current routine and the code, allowing several routine headers in @@ -987,10 +998,6 @@ "Path locations of external commands used by IDLWAVE." :group 'idlwave) -;; WARNING: The following variable has recently been moved from -;; idlw-shell.el to this file. I hope this does not break -;; anything. - (defcustom idlwave-shell-explicit-file-name "idl" "*If non-nil, this is the command to run IDL. Should be an absolute file path or path relative to the current environment @@ -1015,7 +1022,8 @@ :group 'idlwave-external-programs) (defcustom idlwave-help-application "idlhelp" - "*The external application providing reference help for programming." + "*The external application providing reference help for programming. +Obsolete, if the IDL Assistant is being used for help." :group 'idlwave-external-programs :type 'string) @@ -1057,7 +1065,7 @@ :group 'idlwave-misc :type 'boolean) -(defcustom idlwave-default-font-lock-items +(defcustom idlwave-default-font-lock-items '(pros-and-functions batch-files idlwave-idl-keywords label goto common-blocks class-arrows) "Items which should be fontified on the default fontification level 2. @@ -1119,25 +1127,25 @@ ;;; and Carsten Dominik... ;; The following are the reserved words in IDL. Maybe we should -;; highlight some more stuff as well? +;; highlight some more stuff as well? ;; Procedure declarations. Fontify keyword plus procedure name. (defvar idlwave-idl-keywords - ;; To update this regexp, update the list of keywords and + ;; To update this regexp, update the list of keywords and ;; evaluate the form. - ;; (insert + ;; (insert ;; (prin1-to-string - ;; (concat + ;; (concat ;; "\\<\\(" - ;; (regexp-opt + ;; (regexp-opt ;; '("||" "&&" "and" "or" "xor" "not" - ;; "eq" "ge" "gt" "le" "lt" "ne" + ;; "eq" "ge" "gt" "le" "lt" "ne" ;; "for" "do" "endfor" - ;; "if" "then" "endif" "else" "endelse" + ;; "if" "then" "endif" "else" "endelse" ;; "case" "of" "endcase" ;; "switch" "break" "continue" "endswitch" ;; "begin" "end" ;; "repeat" "until" "endrep" - ;; "while" "endwhile" + ;; "while" "endwhile" ;; "goto" "return" ;; "inherits" "mod" ;; "compile_opt" "forward_function" @@ -1158,9 +1166,9 @@ '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" (1 font-lock-keyword-face) ; "common" (2 font-lock-reference-face nil t) ; block name - (font-lock-match-c++-style-declaration-item-and-skip-to-next + ("[ \t]*\\(\\sw+\\)[ ,]*" ;; Start with point after block name and comma - (goto-char (match-end 0)) ; needed for XEmacs, could be nil + (goto-char (match-end 0)) ; needed for XEmacs, could be nil nil (1 font-lock-variable-name-face) ; variable names ))) @@ -1215,7 +1223,7 @@ ;; All operators (not used because too noisy) (all-operators '("[-*^#+<>/]" (0 font-lock-keyword-face))) - + ;; Arrows with text property `idlwave-class' (class-arrows '(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) @@ -1252,14 +1260,14 @@ (defvar idlwave-font-lock-defaults '((idlwave-font-lock-keywords - idlwave-font-lock-keywords-1 + idlwave-font-lock-keywords-1 idlwave-font-lock-keywords-2 idlwave-font-lock-keywords-3) - nil t - ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) + nil t + ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) beginning-of-line)) -(put 'idlwave-mode 'font-lock-defaults +(put 'idlwave-mode 'font-lock-defaults idlwave-font-lock-defaults) ; XEmacs (defconst idlwave-comment-line-start-skip "^[ \t]*;" @@ -1267,7 +1275,7 @@ That is the _beginning_ of a line containing a comment delimiter `;' preceded only by whitespace.") -(defconst idlwave-begin-block-reg +(defconst idlwave-begin-block-reg "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" "Regular expression to find the beginning of a block. The case does not matter. The search skips matches in comments.") @@ -1344,17 +1352,17 @@ '(goto . ("goto\\>" nil)) '(case . ("case\\>" nil)) '(switch . ("switch\\>" nil)) - (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" + (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" "\\(" idlwave-method-call "\\s *\\)?" idlwave-identifier "\\s *(") nil)) - (cons 'call (list (concat + (cons 'call (list (concat "\\(" idlwave-method-call "\\s *\\)?" - idlwave-identifier + idlwave-identifier "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil)) - (cons 'assign (list (concat + (cons 'assign (list (concat "\\(" idlwave-variable "\\) *=") nil))) - + "Associated list of statement matching regular expressions. Each regular expression matches the start of an IDL statement. The first element of each association is a symbol giving the statement @@ -1377,7 +1385,7 @@ ;; Note that this is documented in the v18 manuals as being a string ;; of length one rather than a single character. ;; The code in this file accepts either format for compatibility. -(defvar idlwave-comment-indent-char ?\ +(defvar idlwave-comment-indent-char ?\ "Character to be inserted for IDL comment indentation. Normally a space.") @@ -1385,7 +1393,7 @@ "Character which is inserted as a last character on previous line by \\[idlwave-split-line] to begin a continuation line. Normally $.") -(defconst idlwave-mode-version "5.7_22") +(defconst idlwave-mode-version "6.0_em22") (defmacro idlwave-keyword-abbrev (&rest args) "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." @@ -1536,7 +1544,7 @@ (define-key idlwave-mode-map "\C-c\C-n" 'idlwave-next-statement) ;; (define-key idlwave-mode-map "\r" 'idlwave-newline) ;; (define-key idlwave-mode-map "\t" 'idlwave-indent-line) -(define-key idlwave-mode-map [(shift tab)] 'idlwave-indent-statement) +(define-key idlwave-mode-map [(shift iso-lefttab)] 'idlwave-indent-statement) (define-key idlwave-mode-map "\C-c\C-a" 'idlwave-auto-fill-mode) (define-key idlwave-mode-map "\M-q" 'idlwave-fill-paragraph) (define-key idlwave-mode-map "\M-s" 'idlwave-edit-in-idlde) @@ -1549,15 +1557,15 @@ (not (equal idlwave-shell-debug-modifiers '()))) ;; Bind the debug commands also with the special modifiers. (let ((shift (memq 'shift idlwave-shell-debug-modifiers)) - (mods-noshift (delq 'shift + (mods-noshift (delq 'shift (copy-sequence idlwave-shell-debug-modifiers)))) - (define-key idlwave-mode-map + (define-key idlwave-mode-map (vector (append mods-noshift (list (if shift ?C ?c)))) 'idlwave-shell-save-and-run) - (define-key idlwave-mode-map + (define-key idlwave-mode-map (vector (append mods-noshift (list (if shift ?B ?b)))) 'idlwave-shell-break-here) - (define-key idlwave-mode-map + (define-key idlwave-mode-map (vector (append mods-noshift (list (if shift ?E ?e)))) 'idlwave-shell-run-region))) (define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) @@ -1594,25 +1602,28 @@ (define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete) (define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info) (define-key idlwave-mode-map "\C-c=" 'idlwave-resolve) -(define-key idlwave-mode-map +(define-key idlwave-mode-map (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) 'idlwave-mouse-context-help) ;; Set action and key bindings. ;; See description of the function `idlwave-action-and-binding'. ;; Automatically add spaces for the following characters -;(idlwave-action-and-binding "&" '(idlwave-surround -1 -1 '(?&) 1 -; (lambda (char) 0))) -(idlwave-action-and-binding "<" '(idlwave-surround -1 -1)) -;; Binding works for both > and ->, by changing the length of the token. -(idlwave-action-and-binding ">" '(idlwave-surround -1 -1 '(?-) 1 - 'idlwave-gtr-pad-hook)) -(idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t) -(idlwave-action-and-binding "," '(idlwave-surround 0 -1)) - -;; Automatically add spaces to equal sign if not keyword + +;; Actions for & are complicated by && +(idlwave-action-and-binding "&" 'idlwave-custom-ampersand-surround) + +;; Automatically add spaces to equal sign if not keyword. This needs +;; to go ahead of > and <, so >= and <= will be treated correctly (idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1)) +;; Actions for > and < are complicated by >=, <=, and ->... +(idlwave-action-and-binding "<" '(idlwave-custom-ltgtr-surround nil)) +(idlwave-action-and-binding ">" '(idlwave-custom-ltgtr-surround 'gtr)) + +(idlwave-action-and-binding "," '(idlwave-surround 0 -1 1)) + + ;;; ;;; Abbrev Section ;;; @@ -1639,7 +1650,7 @@ (error (apply 'define-abbrev args))))) (condition-case nil - (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) + (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) "w" idlwave-mode-syntax-table) (error nil)) @@ -1763,12 +1774,12 @@ (defvar imenu-extract-index-name-function) (defvar imenu-prev-index-position-function) ;; defined later - so just make the compiler hush -(defvar idlwave-mode-menu) +(defvar idlwave-mode-menu) (defvar idlwave-mode-debug-menu) ;;;###autoload (defun idlwave-mode () - "Major mode for editing IDL source files (version 5.7_22). + "Major mode for editing IDL source files (version 6.0_em22). The main features of this mode are @@ -1817,11 +1828,10 @@ 3. Online IDL Help --------------- + \\[idlwave-context-help] displays the IDL documentation relevant - for the system variable, keyword, or routine at point. A single - key stroke gets you directly to the right place in the docs. The - HTML help files package must be installed for this to work -- check - the IDLWAVE webpage for the correct package for your version. See + for the system variable, keyword, or routines at point. A single + key stroke gets you directly to the right place in the docs. See the manual to configure where and how the HTML help is displayed. 4. Completion @@ -1848,7 +1858,7 @@ \\i IF statement template \\elif IF-ELSE statement template \\b BEGIN - + For a full list, use \\[idlwave-list-abbrevs]. Some templates also have direct keybindings - see the list of keybindings below. @@ -1890,26 +1900,26 @@ (interactive) (kill-all-local-variables) - + (if idlwave-startup-message (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) (setq idlwave-startup-message nil) - + (setq local-abbrev-table idlwave-mode-abbrev-table) (set-syntax-table idlwave-mode-syntax-table) - + (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) - + (make-local-variable idlwave-comment-indent-function) (set idlwave-comment-indent-function 'idlwave-comment-hook) - + (set (make-local-variable 'comment-start-skip) ";+[ \t]*") (set (make-local-variable 'comment-start) ";") - (set (make-local-variable 'require-final-newline) mode-require-final-newline) + (set (make-local-variable 'require-final-newline) t) (set (make-local-variable 'abbrev-all-caps) t) (set (make-local-variable 'indent-tabs-mode) nil) (set (make-local-variable 'completion-ignore-case) t) - + (use-local-map idlwave-mode-map) (when (featurep 'easymenu) @@ -1919,11 +1929,11 @@ (setq mode-name "IDLWAVE") (setq major-mode 'idlwave-mode) (setq abbrev-mode t) - + (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) (setq comment-end "") (set (make-local-variable 'comment-multi-line) nil) - (set (make-local-variable 'paragraph-separate) + (set (make-local-variable 'paragraph-separate) "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$") (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") (set (make-local-variable 'paragraph-ignore-fill-prefix) nil) @@ -1932,7 +1942,7 @@ ;; Set tag table list to use IDLTAGS as file name. (if (boundp 'tag-table-alist) (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) - + ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow ;; Following line is for Emacs - XEmacs uses the corresponding property ;; on the `idlwave-mode' symbol. @@ -1947,11 +1957,16 @@ 'idlwave-prev-index-position) ;; Make a local post-command-hook and add our hook to it + ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility + ;; (make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'idlwave-command-hook nil 'local) ;; Make local hooks for buffer updates + ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility + ;; (make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local) - (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) + ;; (make-local-hook 'after-save-hook) + ;; (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) ;; Setup directories and file, if necessary @@ -1960,6 +1975,9 @@ ;; Update the routine info with info about current buffer? (idlwave-new-buffer-update) + ;; Check help location + (idlwave-help-check-locations) + ;; Run the mode hook (run-mode-hooks 'idlwave-mode-hook)) @@ -1968,18 +1986,23 @@ (unless idlwave-setup-done (if (not (file-directory-p idlwave-config-directory)) (make-directory idlwave-config-directory)) - (setq idlwave-user-catalog-file (expand-file-name - idlwave-user-catalog-file - idlwave-config-directory) - idlwave-path-file (expand-file-name - idlwave-path-file - idlwave-config-directory)) + (setq + idlwave-user-catalog-file (expand-file-name + idlwave-user-catalog-file + idlwave-config-directory) + idlwave-xml-system-rinfo-converted-file + (expand-file-name + idlwave-xml-system-rinfo-converted-file + idlwave-config-directory) + idlwave-path-file (expand-file-name + idlwave-path-file + idlwave-config-directory)) (idlwave-read-paths) ; we may need these early (setq idlwave-setup-done t))) ;; ;; Code Formatting ---------------------------------------------------- -;; +;; (defun idlwave-push-mark (&rest rest) "Push mark for compatibility with Emacs 18/19." @@ -2128,7 +2151,7 @@ (if (> end-pos eol-pos) (setq end-pos pos)) (goto-char end-pos) - (setq end (buffer-substring + (setq end (buffer-substring (progn (skip-chars-backward "a-zA-Z") (point)) @@ -2150,7 +2173,7 @@ (sit-for 1)) (t (beep) - (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" + (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" end1 end) (sit-for 1)))))))) ;;(delete-char 1)) @@ -2162,8 +2185,8 @@ ((looking-at "pro\\|case\\|switch\\|function\\>") (assoc (downcase (match-string 0)) idlwave-block-matches)) ((looking-at "begin\\>") - (let ((limit (save-excursion - (idlwave-beginning-of-statement) + (let ((limit (save-excursion + (idlwave-beginning-of-statement) (point)))) (cond ((re-search-backward ":[ \t]*\\=" limit t) @@ -2180,7 +2203,6 @@ (defun idlwave-close-block () "Terminate the current block with the correct END statement." (interactive) - ;; Start new line if we are not in a new line (unless (save-excursion (skip-chars-backward " \t") @@ -2191,12 +2213,27 @@ (insert "end") (idlwave-show-begin))) -(defun idlwave-gtr-pad-hook (char) - "Let the > symbol expand around -> if present. The new token length -is returned." - 2) - -(defun idlwave-surround (&optional before after escape-chars length ec-hook) +(defun idlwave-custom-ampersand-surround (&optional is-action) + "Surround &, leaving room for && (which surrround as well)." + (let* ((prev-char (char-after (- (point) 2))) + (next-char (char-after (point))) + (amp-left (eq prev-char ?&)) + (amp-right (eq next-char ?&)) + (len (if amp-left 2 1))) + (unless amp-right ;no need to do it twice, amp-left will catch it. + (idlwave-surround -1 (if (or is-action amp-left) -1) len)))) + +(defun idlwave-custom-ltgtr-surround (gtr &optional is-action) + "Surround > and < by blanks, leaving room for >= and <=, and considering ->." + (let* ((prev-char (char-after (- (point) 2))) + (next-char (char-after (point))) + (method-invoke (and gtr (eq prev-char ?-))) + (len (if method-invoke 2 1))) + (unless (eq next-char ?=) + ;; Key binding: pad only on left, to save for possible >=/<= + (idlwave-surround -1 (if (or is-action method-invoke) -1) len)))) + +(defun idlwave-surround (&optional before after length is-action) "Surround the LENGTH characters before point with blanks. LENGTH defaults to 1. Optional arguments BEFORE and AFTER affect the behavior before and @@ -2209,42 +2246,28 @@ The function does nothing if any of the following conditions is true: - `idlwave-surround-by-blank' is nil -- the character before point is inside a string or comment -- the char preceeding the string to be surrounded is a member of ESCAPE-CHARS. - This hack is used to avoid padding of `>' when it is part of - the '->' operator. In this case, ESCAPE-CHARS would be '(?-). - -If a function is passed in EC-HOOK, and an ESCAPE-CHARS match occurs, -the named function will be called with a single argument of the -preceeding character. Then idlwave-surround will run as usual if -EC-HOOK returns non-nil, and a new length will be taken from the -return value." +- the character before point is inside a string or comment" (when (and idlwave-surround-by-blank (not (idlwave-quoted))) - (let* ((length (or length 1)) ; establish a default for LENGTH - (prev-char (char-after (- (point) (1+ length))))) - (when (or (not (memq prev-char escape-chars)) - (and (fboundp ec-hook) - (setq length - (save-excursion (funcall ec-hook prev-char))))) - (backward-char length) - (save-restriction - (let ((here (point))) - (skip-chars-backward " \t") - (if (bolp) - ;; avoid clobbering indent - (progn - (move-to-column (idlwave-calculate-indent)) - (if (<= (point) here) - (narrow-to-region (point) here)) - (goto-char here))) - (idlwave-make-space before)) - (skip-chars-forward " \t")) - (forward-char length) - (idlwave-make-space after) - ;; Check to see if the line should auto wrap - (if (and (equal (char-after (1- (point))) ?\ ) - (> (current-column) fill-column)) - (funcall auto-fill-function)))))) + (let ((length (or length 1))) ; establish a default for LENGTH + (backward-char length) + (save-restriction + (let ((here (point))) + (skip-chars-backward " \t") + (if (bolp) + ;; avoid clobbering indent + (progn + (move-to-column (idlwave-calculate-indent)) + (if (<= (point) here) + (narrow-to-region (point) here)) + (goto-char here))) + (idlwave-make-space before)) + (skip-chars-forward " \t")) + (forward-char length) + (idlwave-make-space after) + ;; Check to see if the line should auto wrap + (if (and (equal (char-after (1- (point))) ?\ ) + (> (current-column) fill-column)) + (funcall auto-fill-function))))) (defun idlwave-make-space (n) "Make space at point. @@ -2446,7 +2469,7 @@ (let ((eos (save-excursion (idlwave-block-jump-out -1 'nomark) (point)))) - (if (setq status (idlwave-find-key + (if (setq status (idlwave-find-key idlwave-end-block-reg -1 'nomark eos)) (idlwave-beginning-of-statement) (message "No nested block before beginning of containing block."))) @@ -2454,7 +2477,7 @@ (let ((eos (save-excursion (idlwave-block-jump-out 1 'nomark) (point)))) - (if (setq status (idlwave-find-key + (if (setq status (idlwave-find-key idlwave-begin-block-reg 1 'nomark eos)) (idlwave-end-of-statement) (message "No nested block before end of containing block.")))) @@ -2468,7 +2491,7 @@ (here (point))) (goto-char (point-max)) (if (re-search-backward idlwave-doclib-start nil t) - (progn + (progn (setq beg (progn (beginning-of-line) (point))) (if (re-search-forward idlwave-doclib-end nil t) (progn @@ -2502,7 +2525,7 @@ ((eq major-mode 'idlwave-shell-mode) (if (re-search-backward idlwave-shell-prompt-pattern nil t) (goto-char (match-end 0)))) - (t + (t (if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) (idlwave-previous-statement) (beginning-of-line))))) @@ -2579,7 +2602,7 @@ (let ((save-point (point))) (when (re-search-forward ".*&" lim t) (goto-char (match-end 0)) - (if (idlwave-quoted) + (if (idlwave-quoted) (goto-char save-point) (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point)))) (point))) @@ -2596,7 +2619,7 @@ ;; - not in parenthesis (like a[0:3]) ;; - not followed by another ":" in explicit class, ala a->b::c ;; As many in this mode, this function is heuristic and not an exact - ;; parser. + ;; parser. (let* ((start (point)) (eos (save-excursion (idlwave-end-of-statement) (point))) (end (idlwave-find-key ":" 1 'nomark eos))) @@ -2665,7 +2688,7 @@ (if st (append st (match-end 0)))))) -(defun idlwave-expand-equal (&optional before after) +(defun idlwave-expand-equal (&optional before after is-action) "Pad '=' with spaces. Two cases: Assignment statement, and keyword assignment. Which case is determined using `idlwave-start-of-substatement' and `idlwave-statement-type'. The @@ -2673,7 +2696,7 @@ `idlwave-pad-keyword' is t then keyword assignment is treated just like assignment statements. When nil, spaces are removed for keyword assignment. Any other value keeps the current space around the `='. -Limits in for loops are treated as keyword assignment. +Limits in for loops are treated as keyword assignment. Starting with IDL 6.0, a number of op= assignments are available. Since ambiguities of the form: @@ -2686,29 +2709,31 @@ \(not just for padding, but for proper parsing by IDL too!). Other operators, such as ##=, ^=, etc., will be pre-padded. +IS-ACTION is ignored. + See `idlwave-surround'." (if idlwave-surround-by-blank - (let + (let ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=") - (an-ops + (an-ops "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=") (len 1)) - - (save-excursion + + (save-excursion (let ((case-fold-search t)) (backward-char) - (if (or + (if (or (re-search-backward non-an-ops nil t) ;; Why doesn't ##? work for both? - (re-search-backward "\\(#\\)\\=" nil t)) + (re-search-backward "\\(#\\)\\=" nil t)) (setq len (1+ (length (match-string 1)))) (when (re-search-backward an-ops nil t) ;(setq begin nil) ; won't modify begin (setq len (1+ (length (match-string 1)))))))) - - (if (eq t idlwave-pad-keyword) + + (if (eq t idlwave-pad-keyword) ;; Everything gets padded equally - (idlwave-surround before after nil len) + (idlwave-surround before after len) ;; Treating keywords/for variables specially... (let ((st (save-excursion ; To catch "for" variables (idlwave-start-of-substatement t) @@ -2717,22 +2742,22 @@ (skip-chars-backward "= \t") (nth 2 (idlwave-where))))) (cond ((or (memq what '(function-keyword procedure-keyword)) - (memq (caar st) '(for pdef))) - (cond + (memq (caar st) '(for pdef))) + (cond ((null idlwave-pad-keyword) (idlwave-surround 0 0) ) ; remove space (t))) ; leave any spaces alone - (t (idlwave-surround before after nil len)))))))) - + (t (idlwave-surround before after len)))))))) + (defun idlwave-indent-and-action (&optional arg) "Call `idlwave-indent-line' and do expand actions. With prefix ARG non-nil, indent the entire sub-statement." (interactive "p") (save-excursion - (if (and idlwave-expand-generic-end - (re-search-backward "\\<\\(end\\)\\s-*\\=" + (if (and idlwave-expand-generic-end + (re-search-backward "\\<\\(end\\)\\s-*\\=" (max 0 (- (point) 10)) t) (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)")) (progn (goto-char (match-end 1)) @@ -2742,7 +2767,7 @@ (when (and (not arg) current-prefix-arg) (setq arg current-prefix-arg) (setq current-prefix-arg nil)) - (if arg + (if arg (idlwave-indent-statement) (idlwave-indent-line t))) @@ -2804,18 +2829,20 @@ (set-marker mloc nil))) (defun idlwave-do-action (action) - "Perform an action repeatedly on a line. -ACTION is a list (REG . FUNC). REG is a regular expression. FUNC is -either a function name to be called with `funcall' or a list to be -evaluated with `eval'. The action performed by FUNC should leave point -after the match for REG - otherwise an infinite loop may be entered." + "Perform an action repeatedly on a line. ACTION is a list (REG +. FUNC). REG is a regular expression. FUNC is either a function name +to be called with `funcall' or a list to be evaluated with `eval'. +The action performed by FUNC should leave point after the match for +REG - otherwise an infinite loop may be entered. FUNC is always +passed a final argument of 'is-action, so it can discriminate between +being run as an action, or a key binding" (let ((action-key (car action)) (action-routine (cdr action))) (beginning-of-line) (while (idlwave-look-at action-key) (if (listp action-routine) - (eval action-routine) - (funcall action-routine))))) + (eval (append action-routine '('is-action))) + (funcall action-routine 'is-action))))) (defun idlwave-indent-to (col &optional min) "Indent from point with spaces until column COL. @@ -2875,7 +2902,7 @@ (save-excursion (cond ;; Beginning of file - ((prog1 + ((prog1 (idlwave-previous-statement) (setq beg-prev-pos (point))) 0) @@ -2885,7 +2912,7 @@ idlwave-main-block-indent)) ;; Begin block ((idlwave-look-at idlwave-begin-block-reg t) - (+ (idlwave-min-current-statement-indent) + (+ (idlwave-min-current-statement-indent) idlwave-block-indent)) ;; End Block ((idlwave-look-at idlwave-end-block-reg t) @@ -2896,7 +2923,7 @@ (idlwave-min-current-statement-indent))) ;; idlwave-end-offset ;; idlwave-block-indent)) - + ;; Default to current indent ((idlwave-current-statement-indent)))))) ;; adjust the indentation based on the current statement @@ -2912,7 +2939,7 @@ (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) "Calculate the continuation indent inside a paren group. -Returns a cons-cell with (open . indent), where open is the +Returns a cons-cell with (open . indent), where open is the location of the open paren" (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) ;; Found an innermost open paren. @@ -2953,24 +2980,24 @@ (end-reg (progn (beginning-of-line) (point))) (beg-last-statement (save-excursion (idlwave-previous-statement) (point))) - (beg-reg (progn (idlwave-start-of-substatement 'pre) + (beg-reg (progn (idlwave-start-of-substatement 'pre) (if (eq (line-beginning-position) end-reg) (goto-char beg-last-statement) (point)))) (basic-indent (+ (idlwave-min-current-statement-indent end-reg) idlwave-continuation-indent)) fancy-nonparen-indent fancy-paren-indent) - (cond + (cond ;; Align then with its matching if, etc. ((let ((matchers '(("\\<if\\>" . "[ \t]*then") ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else") ("\\<\\(for\\|while\\)\\>" . "[ \t]*do") - ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . + ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . "[ \t]*until") ("\\<case\\>" . "[ \t]*of"))) match cont-re) (goto-char end-reg) - (and + (and (setq cont-re (catch 'exit (while (setq match (car matchers)) @@ -2979,7 +3006,7 @@ (setq matchers (cdr matchers))))) (idlwave-find-key cont-re -1 'nomark beg-last-statement))) (if (looking-at "end") ;; that one's special - (- (idlwave-current-indent) + (- (idlwave-current-indent) (+ idlwave-block-indent idlwave-end-offset)) (idlwave-current-indent))) @@ -3005,7 +3032,7 @@ (let* ((end-reg end-reg) (close-exp (progn (goto-char end-reg) - (skip-chars-forward " \t") + (skip-chars-forward " \t") (looking-at "\\s)"))) indent-cons) (catch 'loop @@ -3039,12 +3066,12 @@ (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) nil (current-column))) - + ;; Continued assignment (with =): ((catch 'assign ; (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*") (goto-char (match-end 0)) - (if (null (idlwave-what-function beg-reg)) + (if (null (idlwave-what-function beg-reg)) (throw 'assign t)))) (unless (or (idlwave-in-quote) @@ -3106,7 +3133,7 @@ (let* ((here (point)) (case-fold-search t) (limit (if (>= dir 0) (point-max) (point-min))) - (block-limit (if (>= dir 0) + (block-limit (if (>= dir 0) idlwave-begin-block-reg idlwave-end-block-reg)) found @@ -3117,7 +3144,7 @@ (idlwave-find-key idlwave-begin-unit-reg dir t limit) (end-of-line) - (idlwave-find-key + (idlwave-find-key idlwave-end-unit-reg dir t limit))) limit))) (if (>= dir 0) (end-of-line)) ;Make sure we are in current block @@ -3142,7 +3169,7 @@ (or (null end-reg) (< (point) end-reg))) (unless comm-or-empty (setq min (min min (idlwave-current-indent))))) (if (or comm-or-empty (and end-reg (>= (point) end-reg))) - min + min (min min (idlwave-current-indent)))))) (defun idlwave-current-statement-indent (&optional last-line) @@ -3168,10 +3195,10 @@ Blank or comment-only lines following regular continuation lines (with `$') count as continuations too." (save-excursion - (or + (or (idlwave-look-at "\\<\\$") (catch 'loop - (while (and (looking-at "^[ \t]*\\(;.*\\)?$") + (while (and (looking-at "^[ \t]*\\(;.*\\)?$") (eq (forward-line -1) 0)) (if (idlwave-look-at "\\<\\$") (throw 'loop t))))))) @@ -3269,7 +3296,7 @@ (beginning-of-line) (point)) (point)))) "[^;]")) - + ;; Mark the beginning and end of the paragraph (goto-char bcl) (while (and (looking-at fill-prefix-reg) @@ -3333,7 +3360,7 @@ (insert (make-string diff ?\ )))) (forward-line -1)) ) - + ;; No hang. Instead find minimum indentation of paragraph ;; after first line. ;; For the following while statement, since START is at the @@ -3365,7 +3392,7 @@ t) (current-column)) indent)) - + ;; try to keep point at its original place (goto-char here) @@ -3414,7 +3441,7 @@ (current-column))))) (defun idlwave-auto-fill () - "Called to break lines in auto fill mode. + "Called to break lines in auto fill mode. Only fills non-comment lines if `idlwave-fill-comment-line-only' is non-nil. Places a continuation character at the end of the line if not in a comment. Splits strings with IDL concatenation operator `+' @@ -3565,7 +3592,7 @@ (insert (current-time-string)) (insert ", " (user-full-name)) (if (boundp 'user-mail-address) - (insert " <" user-mail-address ">") + (insert " <" user-mail-address ">") (insert " <" (user-login-name) "@" (system-name) ">")) ;; Remove extra spaces from line (idlwave-fill-paragraph) @@ -3591,7 +3618,7 @@ (setq end (match-end 0))) (progn (goto-char beg) - (if (re-search-forward + (if (re-search-forward (concat idlwave-doc-modifications-keyword ":") end t) (end-of-line) @@ -3689,7 +3716,7 @@ (not (idlwave-in-quote)) (save-excursion (forward-char) - (re-search-backward (concat "\\(" idlwave-idl-keywords + (re-search-backward (concat "\\(" idlwave-idl-keywords "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t))))) @@ -3735,7 +3762,7 @@ (indent-region beg end nil)) (if (stringp prompt) (message prompt))))) - + (defun idlwave-rw-case (string) "Make STRING have the case required by `idlwave-reserved-word-upcase'." (if idlwave-reserved-word-upcase @@ -3753,7 +3780,7 @@ (defun idlwave-case () "Build skeleton IDL case statement." (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "case") (idlwave-rw-case " of\n\nendcase") "Selector expression")) @@ -3761,7 +3788,7 @@ (defun idlwave-switch () "Build skeleton IDL switch statement." (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "switch") (idlwave-rw-case " of\n\nendswitch") "Selector expression")) @@ -3769,7 +3796,7 @@ (defun idlwave-for () "Build skeleton for loop statment." (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "for") (idlwave-rw-case " do begin\n\nendfor") "Loop expression")) @@ -3784,14 +3811,14 @@ (defun idlwave-procedure () (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "pro") (idlwave-rw-case "\n\nreturn\nend") "Procedure name")) (defun idlwave-function () (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "function") (idlwave-rw-case "\n\nreturn\nend") "Function name")) @@ -3805,7 +3832,7 @@ (defun idlwave-while () (interactive) - (idlwave-template + (idlwave-template (idlwave-rw-case "while") (idlwave-rw-case " do begin\n\nendwhile") "Entry condition")) @@ -3884,8 +3911,8 @@ (defun idlwave-count-outlawed-buffers (tag) "How many outlawed buffers have tag TAG?" (length (delq nil - (mapcar - (lambda (x) (eq (cdr x) tag)) + (mapcar + (lambda (x) (eq (cdr x) tag)) idlwave-outlawed-buffers)))) (defun idlwave-do-kill-autoloaded-buffers (&rest reasons) @@ -3899,9 +3926,9 @@ (memq (cdr entry) reasons)) (kill-buffer (car entry)) (incf cnt) - (setq idlwave-outlawed-buffers + (setq idlwave-outlawed-buffers (delq entry idlwave-outlawed-buffers))) - (setq idlwave-outlawed-buffers + (setq idlwave-outlawed-buffers (delq entry idlwave-outlawed-buffers)))) (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) @@ -3913,7 +3940,7 @@ (entry (assq buf idlwave-outlawed-buffers))) ;; Revoke license (if entry - (setq idlwave-outlawed-buffers + (setq idlwave-outlawed-buffers (delq entry idlwave-outlawed-buffers))) ;; Remove this function from the hook. (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) @@ -3932,7 +3959,7 @@ (defun idlwave-expand-lib-file-name (file) ;; Find FILE on the scanned lib path and return a buffer visiting it ;; This is for, e.g., finding source with no user catalog - (cond + (cond ((null file) nil) ((file-name-absolute-p file) file) (t (idlwave-locate-lib-file file)))) @@ -3947,7 +3974,7 @@ (interactive) (let (directory directories cmd append status numdirs dir getsubdirs buffer save_buffer files numfiles item errbuf) - + ;; ;; Read list of directories (setq directory (read-string "Tag Directories: " ".")) @@ -3999,7 +4026,7 @@ (message "%s" (concat "Tagging " item "...")) (setq errbuf (get-buffer-create "*idltags-error*")) (setq status (+ status - (if (eq 0 (call-process + (if (eq 0 (call-process "sh" nil errbuf nil "-c" (concat cmd append item))) 0 @@ -4013,13 +4040,13 @@ (setq numfiles (1+ numfiles)) (setq item (nth numfiles files)) ))) - + (setq numdirs (1+ numdirs)) (setq dir (nth numdirs directories))) (progn (setq numdirs (1+ numdirs)) (setq dir (nth numdirs directories))))) - + (setq errbuf (get-buffer-create "*idltags-error*")) (if (= status 0) (kill-buffer errbuf)) @@ -4095,7 +4122,7 @@ ;; Make sure the hash functions are accessible. (if (or (not (fboundp 'gethash)) (not (fboundp 'puthash))) - (progn + (progn (require 'cl) (or (fboundp 'puthash) (defalias 'puthash 'cl-puthash)))) @@ -4109,22 +4136,22 @@ for var = (car entry) do (if (not (consp (symbol-value var))) (set var (list nil)))) + ;; Reset the system & library hash (when (or (eq what t) (eq what 'syslib) (null (cdr idlwave-sint-routines))) - ;; Reset the system & library hash (loop for entry in entries for var = (car entry) for size = (nth 1 entry) - do (setcdr (symbol-value var) + do (setcdr (symbol-value var) (make-hash-table ':size size ':test 'equal))) (setq idlwave-sint-dirs nil idlwave-sint-libnames nil)) + ;; Reset the buffer & shell hash (when (or (eq what t) (eq what 'bufsh) (null (car idlwave-sint-routines))) - ;; Reset the buffer & shell hash (loop for entry in entries for var = (car entry) for size = (nth 1 entry) - do (setcar (symbol-value var) + do (setcar (symbol-value var) (make-hash-table ':size size ':test 'equal)))))) (defun idlwave-sintern-routine-or-method (name &optional class set) @@ -4211,11 +4238,11 @@ (setq class (idlwave-sintern-class class set)) (setq name (idlwave-sintern-method name set))) (setq name (idlwave-sintern-routine name set))) - + ;; The source (let ((source-type (car source)) (source-file (nth 1 source)) - (source-dir (if default-dir + (source-dir (if default-dir (file-name-as-directory default-dir) (nth 2 source))) (source-lib (nth 3 source))) @@ -4224,7 +4251,7 @@ (if (stringp source-lib) (setq source-lib (idlwave-sintern-libname source-lib set))) (setq source (list source-type source-file source-dir source-lib))) - + ;; The keywords (setq kwds (mapcar (lambda (x) (idlwave-sintern-keyword-list x set)) @@ -4364,10 +4391,10 @@ "-l" (expand-file-name "~/.emacs") "-l" "idlwave" "-f" "idlwave-rescan-catalog-directories")) - (process (apply 'start-process "idlcat" + (process (apply 'start-process "idlcat" nil emacs args))) (setq idlwave-catalog-process process) - (set-process-sentinel + (set-process-sentinel process (lambda (pro why) (when (string-match "finished" why) @@ -4384,7 +4411,8 @@ ;; ("ROUTINE" type class ;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | ;; (buffer pro_file dir) | (compiled pro_file dir) -;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...))) +;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) +;; ("HELPFILE2" (("KWD2" . link) ...)) ...) ;; ;; DIR will be supplied dynamically while loading library catalogs, ;; and is sinterned to save space, as is LIBNAME. PRO_FILE can be a @@ -4442,7 +4470,7 @@ ;; The override-idle means, even if the idle timer has done some ;; preparing work, load and renormalize everything anyway. (override-idle (or arg idlwave-buffer-case-takes-precedence))) - + (setq idlwave-buffer-routines nil idlwave-compiled-routines nil idlwave-unresolved-routines nil) @@ -4453,14 +4481,14 @@ (idlwave-reset-sintern (cond (load t) ((null idlwave-system-routines) t) (t 'bufsh)))) - + (if idlwave-buffer-case-takes-precedence ;; We can safely scan the buffer stuff first (progn (idlwave-update-buffer-routine-info) - (and load (idlwave-load-system-rinfo override-idle))) + (and load (idlwave-load-all-rinfo override-idle))) ;; We first do the system info, and then the buffers - (and load (idlwave-load-system-rinfo override-idle)) + (and load (idlwave-load-all-rinfo override-idle)) (idlwave-update-buffer-routine-info)) ;; Let's see if there is a shell @@ -4468,9 +4496,9 @@ (idlwave-shell-is-running))) (ask-shell (and shell-is-running idlwave-query-shell-for-routine-info))) - + ;; Load the library catalogs again, first re-scanning the path - (when arg + (when arg (if shell-is-running (idlwave-shell-send-command idlwave-shell-path-query '(progn @@ -4490,7 +4518,7 @@ ;; Therefore, we do a concatenation now, even though ;; the shell might do it again. (idlwave-concatenate-rinfo-lists nil 'run-hooks)) - + (when ask-shell ;; Ask the shell about the routines it knows of. (message "Querying the shell") @@ -4521,16 +4549,433 @@ (defvar idlwave-library-routines nil "Obsolete variable.") +;;------ XML Help routine info system +(defun idlwave-load-system-routine-info () + ;; Load the system routine info from the cached routine info file, + ;; which, if necessary, will be re-created from the XML file on + ;; disk. As a last fallback, load the (likely outdated) idlw-rinfo + ;; file distributed with older IDLWAVE versions (<6.0) + (unless (and (load idlwave-xml-system-rinfo-converted-file + 'noerror 'nomessage) + (idlwave-xml-system-routine-info-up-to-date)) + ;; See if we can create it from XML source + (condition-case nil + (idlwave-convert-xml-system-routine-info) + (error + (unless (load idlwave-xml-system-rinfo-converted-file + 'noerror 'nomessage) + (if idlwave-system-routines + (message + "Failed to load converted routine info, using old conversion.") + (message + "Failed to convert XML routine info, falling back on idlw-rinfo.") + (if (not (load "idlw-rinfo" 'noerror 'nomessage)) + (message + "Could not locate any system routine information.")))))))) + +(defun idlwave-xml-system-routine-info-up-to-date() + (let* ((dir (file-name-as-directory + (expand-file-name "help/online_help" (idlwave-sys-dir)))) + (catalog-file (expand-file-name "idl_catalog.xml" dir))) + (file-newer-than-file-p ;converted file is newer than catalog + idlwave-xml-system-rinfo-converted-file + catalog-file))) + +(defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo +(defvar idlwave-system-variables-alist nil + "Alist of system variables and the associated structure tags. +Gets set in cached XML rinfo, or `idlw-rinfo.el'.") +(defvar idlwave-executive-commands-alist nil + "Alist of system variables and their help files.") +(defvar idlwave-help-special-topic-words nil) + + +(defun idlwave-shorten-syntax (syntax name &optional class) + ;; From a list of syntax statments, shorten with %s and group with "or" + (let ((case-fold-search t)) + (mapconcat + (lambda (x) + (while (string-match name x) + (setq x (replace-match "%s" t t x))) + (if class + (while (string-match class x) + (setq x (replace-match "%s" t t x)))) + x) + (nreverse syntax) + " or "))) + +(defun idlwave-xml-create-class-method-lists (xml-entry) + ;; Create a class list entry from the xml parsed list., returning a + ;; cons of form (class-entry method-entries). + (let* ((nameblock (nth 1 xml-entry)) + (class (cdr (assq 'name nameblock))) + (link (cdr (assq 'link nameblock))) + (params (cddr xml-entry)) + (case-fold-search t) + class-entry + method methods-entry extra-kwds + props get-props set-props init-props inherits + pelem ptype) + (while params + (setq pelem (car params)) + (when (listp pelem) + (setq ptype (car pelem) + props (car (cdr pelem))) + (cond + ((eq ptype 'SUPERCLASS) + (push (cdr (assq 'name props)) inherits)) + + ((eq ptype 'PROPERTY) + (let ((pname (cdr (assq 'name props))) + (plink (cdr (assq 'link props))) + (get (string= (cdr (assq 'get props)) "Yes")) + (set (string= (cdr (assq 'set props)) "Yes")) + (init (string= (cdr (assq 'init props)) "Yes"))) + (if get (push (list pname plink) get-props)) + (if set (push (list pname plink) set-props)) + (if init (push (list pname plink) init-props)))) + + ((eq ptype 'METHOD) + (setq method (cdr (assq 'name props))) + (setq extra-kwds ;;Assume all property keywords are gathered already + (cond + ((string-match (concat class "::Init") method) + (put 'init-props 'matched t) + init-props) + ((string-match (concat class "::GetProperty") method) + (put 'get-props 'matched t) + get-props) + ((string-match (concat class "::SetProperty") method) + (put 'set-props 'matched t) + set-props) + (t nil))) + (setq methods-entry + (nconc (idlwave-xml-create-rinfo-list pelem class extra-kwds) + methods-entry))) + (t))) + (setq params (cdr params))) + ;(unless (get 'init-props 'matched) + ; (message "Failed to match Init in class %s" class)) + ;(unless (get 'get-props 'matched) + ; (message "Failed to match GetProperty in class %s" class)) + ;(unless (get 'set-props 'matched) + ; (message "Failed to match SetProperty in class %s" class)) + (setq class-entry + (if inherits + (list class (append '(inherits) inherits) (list 'link link)) + (list class (list 'link link)))) + (cons class-entry methods-entry))) + +(defun idlwave-xml-create-rinfo-list (xml-entry &optional class extra-kws) + ;; Create correctly structured list elements from ROUTINE or METHOD + ;; XML list structures. Return a list of list elements, with more + ;; than one sub-list possible if a routine can serve as both + ;; procedure and function (e.g. call_method). + (let* ((nameblock (nth 1 xml-entry)) + (name (cdr (assq 'name nameblock))) + (link (cdr (assq 'link nameblock))) + (params (cddr xml-entry)) + (syntax-vec (make-vector 3 nil)) ; procedure, function, exec command + (case-fold-search t) + syntax kwd klink pref-list kwds pelem ptype entry props result type) + (if class ;; strip out class name from class method name string + (if (string-match (concat class "::") name) + (setq name (substring name (match-end 0))))) + (while params + (setq pelem (car params)) + (when (listp pelem) + (setq ptype (car pelem) + props (car (cdr pelem))) + (cond + ((eq ptype 'SYNTAX) + (setq syntax (cdr (assq 'name props))) + (if (string-match "->" syntax) + (setq syntax (replace-match "->" t nil syntax))) + (setq type (cdr (assq 'type props))) + (push syntax + (aref syntax-vec (cond + ((string-match "^pro" type) 0) + ((string-match "^fun" type) 1) + ((string-match "^exec" type) 2))))) + ((eq ptype 'KEYWORD) + (setq kwd (cdr (assq 'name props)) + klink (cdr (assq 'link props))) + (if (string-match "^\\[XY\\(Z?\\)\\]" kwd) + (progn + (setq pref-list + (if (match-string 1 kwd) '("X" "Y" "Z") '("X" "Y")) + kwd (substring kwd (match-end 0))) + (loop for x in pref-list do + (push (list (concat x kwd) klink) kwds))) + (push (list kwd klink) kwds))) + + (t))); Do nothing for the others + (setq params (cdr params))) + + ;; Debug +; (if (and (null (aref syntax-vec 0)) +; (null (aref syntax-vec 1)) +; (null (aref syntax-vec 2))) +; (with-current-buffer (get-buffer-create "IDL_XML_catalog_complaints") +; (if class +; (insert (format "Missing SYNTAX entry for %s::%s\n" class name)) +; (insert (message "Missing SYNTAX entry for %s\n" name))))) + + ;; Executive commands are treated specially + (if (aref syntax-vec 2) + (cons (substring name 1) link) + (if extra-kws (setq kwds (nconc kwds extra-kws))) + (setq kwds (idlwave-rinfo-group-keywords kwds link)) + (loop for idx from 0 to 1 do + (if (aref syntax-vec idx) + (push (append (list name (if (eq idx 0) 'pro 'fun) + class '(system) + (idlwave-shorten-syntax + (aref syntax-vec idx) name class)) + kwds) result))) + result))) + + +(defun idlwave-rinfo-group-keywords (kwds master-link) + ;; Group keywords by link file, as a list with elements + ;; (linkfile ( ("KWD1" . link1) ("KWD2" . link2)) + (let (kwd link anchor linkfiles block master-elt) + (while kwds + (setq kwd (car kwds) + link (idlwave-split-link-target (nth 1 kwd)) + anchor (cdr link) + link (car link) + kwd (car kwd)) + (if (setq block (assoc link linkfiles)) + (push (cons kwd anchor) (cdr block)) + (push (list link (cons kwd anchor)) linkfiles)) + (setq kwds (cdr kwds))) + ;; Ensure the master link is there + (if (setq master-elt (assoc master-link linkfiles)) + (if (eq (car linkfiles) master-elt) + linkfiles + (cons master-elt (delq master-elt linkfiles))) + (push (list master-link) linkfiles)))) + +(defun idlwave-convert-xml-clean-statement-aliases (aliases) + ;; Clean up the syntax of routines which are actually aliases by + ;; removing the "OR" from the statements + (let (syntax entry) + (loop for x in aliases do + (setq entry (assoc x idlwave-system-routines)) + (when entry + (while (string-match " +or +" (setq syntax (nth 4 entry))) + (setf (nth 4 entry) (replace-match ", " t t syntax))))))) + +(defun idlwave-convert-xml-clean-routine-aliases (aliases) + ;; Duplicate and trim original routine aliases from rinfo list + ;; This if for, e.g. OPENR/OPENW/OPENU + (let (alias remove-list new parts all-parts) + (loop for x in aliases do + (when (setq parts (split-string (cdr x) "/")) + (setq new (assoc (cdr x) all-parts)) + (unless new + (setq new (cons (cdr x) parts)) + (push new all-parts)) + (setcdr new (delete (car x) (cdr new))))) + + ;; Add any missing aliases (separate by slashes) + (loop for x in all-parts do + (if (cdr x) + (push (cons (nth 1 x) (car x)) aliases))) + + (loop for x in aliases do + (when (setq alias (assoc (cdr x) idlwave-system-routines)) + (unless (memq alias remove-list) (push alias remove-list)) + (setq alias (copy-sequence alias)) + (setcar alias (car x)) + (push alias idlwave-system-routines))) + (loop for x in remove-list do + (delq x idlwave-system-routines)))) + +(defun idlwave-convert-xml-clean-sysvar-aliases (aliases) + ;; Duplicate and trim original routine aliases from rinfo list + ;; This if for, e.g. !X, !Y, !Z. + (let (alias remove-list new parts all-parts) + (loop for x in aliases do + (when (setq alias (assoc (cdr x) idlwave-system-variables-alist)) + (unless (memq alias remove-list) (push alias remove-list)) + (setq alias (copy-sequence alias)) + (setcar alias (car x)) + (push alias idlwave-system-variables-alist))) + (loop for x in remove-list do + (delq x idlwave-system-variables-alist)))) + + +(defun idlwave-xml-create-sysvar-alist (xml-entry) + ;; Create a sysvar list entry from the xml parsed list. + (let* ((nameblock (nth 1 xml-entry)) + (sysvar (substring (cdr (assq 'name nameblock)) 1)) + (link (cdr (assq 'link nameblock))) + (params (cddr xml-entry)) + (case-fold-search t) + pelem ptype props fields tags) + (while params + (setq pelem (car params)) + (when (listp pelem) + (setq ptype (car pelem) + props (car (cdr pelem))) + (cond + ((eq ptype 'FIELD) + (push (cons (cdr (assq 'name props)) + (cdr + (idlwave-split-link-target (cdr (assq 'link props))))) + tags)))) + (setq params (cdr params))) + (delq nil + (list sysvar (if tags (cons 'tags tags)) (list 'link link))))) + + +(defvar idlwave-xml-routine-info-file nil) + +(defun idlwave-save-routine-info () + (if idlwave-xml-routine-info-file + (with-temp-file idlwave-xml-system-rinfo-converted-file + (insert + (concat ";; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +;; IDLWAVE Routine Information File (IDLWAVE version " idlwave-mode-version ") +;; Automatically generated from source file: +;; " idlwave-xml-routine-info-file " +;; on " (current-time-string) " +;; Do not edit.")) + (insert (format "\n(setq idlwave-xml-routine-info-file \n \"%s\")" + idlwave-xml-routine-info-file)) + (insert "\n(setq idlwave-system-routines\n '") + (prin1 idlwave-system-routines (current-buffer)) + (insert ")") + (insert "\n(setq idlwave-system-variables-alist\n '") + (prin1 idlwave-system-variables-alist (current-buffer)) + (insert ")") + (insert "\n(setq idlwave-system-class-info\n '") + (prin1 idlwave-system-class-info (current-buffer)) + (insert ")") + (insert "\n(setq idlwave-executive-commands-alist\n '") + (prin1 idlwave-executive-commands-alist (current-buffer)) + (insert ")") + (insert "\n(setq idlwave-help-special-topic-words\n '") + (prin1 idlwave-help-special-topic-words (current-buffer)) + (insert ")")))) + +(defun idlwave-convert-xml-system-routine-info () + "Convert XML supplied IDL routine info into internal form. +Cache to disk for quick recovery." + (interactive) + (let* ((dir (file-name-as-directory + (expand-file-name "help/online_help" (idlwave-sys-dir)))) + (catalog-file (expand-file-name "idl_catalog.xml" dir)) + (elem-cnt 0) + props rinfo msg-cnt elem type nelem class-result alias + routines routine-aliases statement-aliases sysvar-aliases + buf version-string) + (if (not (file-exists-p catalog-file)) + (error "No such XML routine info file: %s" catalog-file) + (if (not (file-readable-p catalog-file)) + (error "Cannot read XML routine info file: %s" catalog-file))) + (require 'xml) + (message "Reading XML routine info...") + (unwind-protect + (progn + ;; avoid warnings about read-only files + (setq buf (find-file-noselect catalog-file 'nowarn)) + (setq rinfo (xml-parse-file catalog-file))) + (if (bufferp buf) (kill-buffer buf))) + (message "Reading XML routine info...done") + (setq rinfo (assq 'CATALOG rinfo)) + (unless rinfo (error "Failed to parse XML routine info")) + ;;(setq rinfo (car rinfo)) ; Skip the catalog stuff. + + (setq version-string (cdr (assq 'version (nth 1 rinfo))) + rinfo (cddr rinfo)) + + (setq nelem (length rinfo) + msg-cnt (/ nelem 20)) + + (setq idlwave-xml-routine-info-file nil) + (message "Converting XML routine info...") + (setq idlwave-system-routines nil + idlwave-system-variables-alist nil + idlwave-system-class-info nil + idlwave-executive-commands-alist nil + idlwave-help-special-topic-words nil) + + (while rinfo + (setq elem (car rinfo) + rinfo (cdr rinfo)) + (incf elem-cnt) + (when (listp elem) + (setq type (car elem) + props (car (cdr elem))) + (if (= (mod elem-cnt msg-cnt) 0) + (message "Converting XML routine info...%2d%%" + (/ (* elem-cnt 100) nelem))) + (cond + ((eq type 'ROUTINE) + (if (setq alias (assq 'alias_to props)) + (push (cons (cdr (assq 'name props)) (cdr alias)) + routine-aliases) + (setq routines (idlwave-xml-create-rinfo-list elem)) + (if (listp (cdr routines)) + (setq idlwave-system-routines + (nconc idlwave-system-routines routines)) + ;; a cons cell is an executive commands + (push routines idlwave-executive-commands-alist)))) + + ((eq type 'CLASS) + (setq class-result (idlwave-xml-create-class-method-lists elem)) + (push (car class-result) idlwave-system-class-info) + (setq idlwave-system-routines + (nconc idlwave-system-routines (cdr class-result)))) + + ((eq type 'STATEMENT) + (push (cons (cdr (assq 'name props)) + (cdr (assq 'link props))) + idlwave-help-special-topic-words) + ;; Save the links to those which are statement aliases (not routines) + (if (setq alias (assq 'alias_to props)) + (unless (member (cdr alias) statement-aliases) + (push (cdr alias) statement-aliases)))) + + ((eq type 'SYSVAR) + (if (setq alias (cdr (assq 'alias_to props))) + (push (cons (substring (cdr (assq 'name props)) 1) + (substring alias 1)) + sysvar-aliases) + (push (idlwave-xml-create-sysvar-alist elem) + idlwave-system-variables-alist))) + (t)))) + (idlwave-convert-xml-clean-routine-aliases routine-aliases) + (idlwave-convert-xml-clean-statement-aliases statement-aliases) + (idlwave-convert-xml-clean-sysvar-aliases sysvar-aliases) + + (setq idlwave-xml-routine-info-file catalog-file) + (idlwave-save-routine-info) + (message "Converting XML routine info...done"))) + + +;; ("ROUTINE" type class +;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") | +;; (buffer pro_file dir) | (compiled pro_file dir) +;; "calling_string" ("HELPFILE" (("KWD1" . link1) ...)) +;; ("HELPFILE2" (("KWD2" . link) ...)) ...) + + (defun idlwave-load-rinfo-next-step () (let ((inhibit-quit t) (arr idlwave-load-rinfo-steps-done)) - (when (catch 'exit + (if (catch 'exit (when (not (aref arr 0)) - (message "Loading idlw-rinfo.el in idle time...") - (load "idlw-rinfo" 'noerror 'nomessage) - (message "Loading idlw-rinfo.el in idle time...done") + (message "Loading system routine info in idle time...") + (idlwave-load-system-routine-info) + ;;(load "idlw-rinfo" 'noerror 'nomessage) + (message "Loading system routine info in idle time...done") (aset arr 0 t) (throw 'exit t)) + (when (not (aref arr 1)) (message "Normalizing idlwave-system-routines in idle time...") (idlwave-reset-sintern t) @@ -4540,6 +4985,7 @@ (message "Normalizing idlwave-system-routines in idle time...done") (aset arr 1 t) (throw 'exit t)) + (when (not (aref arr 2)) (when (and (stringp idlwave-user-catalog-file) (file-regular-p idlwave-user-catalog-file)) @@ -4554,23 +5000,25 @@ (progn (setq idlwave-library-routines nil) (ding) - (message "Outdated user catalog: %s... recreate" + (message "Outdated user catalog: %s... recreate" idlwave-user-catalog-file)) - (message "Loading user catalog in idle time...done")) - (aset arr 2 t) - (throw 'exit t))) + (message "Loading user catalog in idle time...done"))) + (aset arr 2 t) + (throw 'exit t)) + (when (not (aref arr 3)) (when idlwave-user-catalog-routines (message "Normalizing user catalog routines in idle time...") - (setq idlwave-user-catalog-routines + (setq idlwave-user-catalog-routines (idlwave-sintern-rinfo-list idlwave-user-catalog-routines 'sys)) - (message + (message "Normalizing user catalog routines in idle time...done")) (aset arr 3 t) (throw 'exit t)) + (when (not (aref arr 4)) - (idlwave-scan-library-catalogs + (idlwave-scan-library-catalogs "Loading and normalizing library catalogs in idle time...") (aset arr 4 t) (throw 'exit t)) @@ -4578,6 +5026,7 @@ (message "Finishing initialization in idle time...") (idlwave-routines) (message "Finishing initialization in idle time...done") + (aset arr 5 t) (throw 'exit nil))) ;; restart the timer (if (sit-for 1) @@ -4587,34 +5036,46 @@ idlwave-init-rinfo-when-idle-after nil 'idlwave-load-rinfo-next-step)))))) -(defun idlwave-load-system-rinfo (&optional force) - ;; Load and case-treat the system and catalog files. +(defun idlwave-load-all-rinfo (&optional force) + ;; Load and case-treat the system, user catalog, and library routine + ;; info files. + + ;; System (when (or force (not (aref idlwave-load-rinfo-steps-done 0))) - (load "idlw-rinfo" 'noerror 'nomessage)) + ;;(load "idlw-rinfo" 'noerror 'nomessage)) + (idlwave-load-system-routine-info)) (when (or force (not (aref idlwave-load-rinfo-steps-done 1))) (message "Normalizing idlwave-system-routines...") (setq idlwave-system-routines (idlwave-sintern-rinfo-list idlwave-system-routines 'sys)) (message "Normalizing idlwave-system-routines...done")) - (setq idlwave-routines (copy-sequence idlwave-system-routines)) - (setq idlwave-last-system-routine-info-cons-cell - (nthcdr (1- (length idlwave-routines)) idlwave-routines)) + (when idlwave-system-routines + (setq idlwave-routines (copy-sequence idlwave-system-routines)) + (setq idlwave-last-system-routine-info-cons-cell + (nthcdr (1- (length idlwave-routines)) idlwave-routines))) + + ;; User catalog (when (and (stringp idlwave-user-catalog-file) (file-regular-p idlwave-user-catalog-file)) (condition-case nil (when (or force (not (aref idlwave-load-rinfo-steps-done 2))) (load-file idlwave-user-catalog-file)) (error nil)) - (when (boundp 'idlwave-library-routines) + (when (and + (boundp 'idlwave-library-routines) + idlwave-library-routines) (setq idlwave-library-routines nil) - (error "Outdated user catalog: %s... recreate" idlwave-user-catalog-file)) + (error "Outdated user catalog: %s... recreate" + idlwave-user-catalog-file)) (setq idlwave-true-path-alist nil) (when (or force (not (aref idlwave-load-rinfo-steps-done 3))) (message "Normalizing user catalog routines...") - (setq idlwave-user-catalog-routines - (idlwave-sintern-rinfo-list + (setq idlwave-user-catalog-routines + (idlwave-sintern-rinfo-list idlwave-user-catalog-routines 'sys)) (message "Normalizing user catalog routines...done"))) + + ;; Library catalog (when (or force (not (aref idlwave-load-rinfo-steps-done 4))) (idlwave-scan-library-catalogs "Loading and normalizing library catalogs...")) @@ -4623,11 +5084,11 @@ (defun idlwave-update-buffer-routine-info () (let (res) - (cond + (cond ((eq idlwave-scan-all-buffers-for-routine-info t) ;; Scan all buffers, current buffer last (message "Scanning all buffers...") - (setq res (idlwave-get-routine-info-from-buffers + (setq res (idlwave-get-routine-info-from-buffers (reverse (buffer-list))))) ((null idlwave-scan-all-buffers-for-routine-info) ;; Don't scan any buffers @@ -4640,12 +5101,12 @@ (setq res (idlwave-get-routine-info-from-buffers (list (current-buffer)))))))) ;; Put the result into the correct variable - (setq idlwave-buffer-routines + (setq idlwave-buffer-routines (idlwave-sintern-rinfo-list res 'set)))) (defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook) "Put the different sources for routine information together." - ;; The sequence here is important because earlier definitions shadow + ;; The sequence here is important because earlier definitions shadow ;; later ones. We assume that if things in the buffers are newer ;; then in the shell of the system, they are meant to be different. (setcdr idlwave-last-system-routine-info-cons-cell @@ -4657,7 +5118,7 @@ ;; Give a message with information about the number of routines we have. (unless quiet - (message + (message "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)" (length idlwave-buffer-routines) (length idlwave-compiled-routines) @@ -4675,7 +5136,7 @@ (when (and (setq class (nth 2 x)) (not (assq class idlwave-class-alist))) (push (list class) idlwave-class-alist))) - idlwave-class-alist))) + idlwave-class-alist))) ;; Three functions for the hooks (defun idlwave-save-buffer-update () @@ -4708,7 +5169,7 @@ (defun idlwave-replace-buffer-routine-info (file new) "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." - (let ((list idlwave-buffer-routines) + (let ((list idlwave-buffer-routines) found) (while list ;; The following test uses eq to make sure it works correctly @@ -4719,7 +5180,7 @@ (setcar list nil) (setq found t)) (if found - ;; End of that section reached. Jump. + ;; End of that section reached. Jump. (setq list nil))) (setq list (cdr list))) (setq idlwave-buffer-routines @@ -4751,11 +5212,11 @@ (save-restriction (widen) (goto-char (point-min)) - (while (re-search-forward + (while (re-search-forward "^[ \t]*\\(pro\\|function\\)[ \t]" nil t) (setq string (buffer-substring-no-properties (match-beginning 0) - (progn + (progn (idlwave-end-of-statement) (point)))) (setq entry (idlwave-parse-definition string)) @@ -4793,7 +5254,7 @@ (push (match-string 1 string) args))) ;; Normalize and sort. (setq args (nreverse args)) - (setq keywords (sort keywords (lambda (a b) + (setq keywords (sort keywords (lambda (a b) (string< (downcase a) (downcase b))))) ;; Make and return the entry ;; We don't know which argument are optional, so this information @@ -4803,7 +5264,7 @@ class (cond ((not (boundp 'idlwave-scanning-lib)) (list 'buffer (buffer-file-name))) -; ((string= (downcase +; ((string= (downcase ; (file-name-sans-extension ; (file-name-nondirectory (buffer-file-name)))) ; (downcase name)) @@ -4811,7 +5272,7 @@ ; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) (t (list 'user (file-name-nondirectory (buffer-file-name)) idlwave-scanning-lib-dir "UserLib"))) - (concat + (concat (if (string= type "function") "Result = " "") (if class "Obj ->[%s::]" "") "%s" @@ -4837,7 +5298,6 @@ (t "@@@@@@@@"))) - (defun idlwave-create-user-catalog-file (&optional arg) "Scan all files on selected dirs of IDL search path for routine information. @@ -4858,10 +5318,10 @@ (> (length idlwave-user-catalog-file) 0) (file-accessible-directory-p (file-name-directory idlwave-user-catalog-file)) - (not (string= "" (file-name-nondirectory + (not (string= "" (file-name-nondirectory idlwave-user-catalog-file)))) (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory")) - + (cond ;; Rescan the known directories ((and arg idlwave-path-alist @@ -4871,13 +5331,13 @@ ;; Expand the directories from library-path and run the widget (idlwave-library-path (idlwave-display-user-catalog-widget - (if idlwave-true-path-alist + (if idlwave-true-path-alist ;; Propagate any flags on the existing path-alist (mapcar (lambda (x) (let ((path-entry (assoc (file-truename x) idlwave-true-path-alist))) (if path-entry - (cons x (cdr path-entry)) + (cons x (cdr path-entry)) (list x)))) (idlwave-expand-path idlwave-library-path)) (mapcar 'list (idlwave-expand-path idlwave-library-path))))) @@ -4902,7 +5362,7 @@ (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load) (idlwave-display-user-catalog-widget idlwave-path-alist))) -(defconst idlwave-user-catalog-widget-help-string +(defconst idlwave-user-catalog-widget-help-string "This is the front-end to the creation of the IDLWAVE user catalog. Please select the directories on IDL's search path from which you would like to extract routine information, to be stored in the file: @@ -4937,7 +5397,7 @@ (make-local-variable 'idlwave-widget) (widget-insert (format idlwave-user-catalog-widget-help-string idlwave-user-catalog-file)) - + (widget-create 'push-button :notify 'idlwave-widget-scan-user-lib-files "Scan & Save") @@ -4947,7 +5407,7 @@ "Delete File") (widget-insert " ") (widget-create 'push-button - :notify + :notify '(lambda (&rest ignore) (let ((path-list (widget-get idlwave-widget :path-dirs))) (mapcar (lambda (x) @@ -4958,7 +5418,7 @@ "Select All Non-Lib") (widget-insert " ") (widget-create 'push-button - :notify + :notify '(lambda (&rest ignore) (let ((path-list (widget-get idlwave-widget :path-dirs))) (mapcar (lambda (x) @@ -4974,18 +5434,18 @@ (widget-insert "\n\n") (widget-insert "Select Directories: \n") - + (setq idlwave-widget (apply 'widget-create 'checklist - :value (delq nil (mapcar (lambda (x) - (if (memq 'user (cdr x)) + :value (delq nil (mapcar (lambda (x) + (if (memq 'user (cdr x)) (car x))) dirs-list)) :greedy t :tag "List of directories" - (mapcar (lambda (x) - (list 'item + (mapcar (lambda (x) + (list 'item (if (memq 'lib (cdr x)) (concat "[LIB] " (car x) ) (car x)))) dirs-list))) @@ -4995,7 +5455,7 @@ (widget-setup) (goto-char (point-min)) (delete-other-windows)) - + (defun idlwave-delete-user-catalog-file (&rest ignore) (if (yes-or-no-p (format "Delete file %s " idlwave-user-catalog-file)) @@ -5011,7 +5471,7 @@ (this-path-alist path-alist) dir-entry) (while (setq dir-entry (pop this-path-alist)) - (if (member + (if (member (if (memq 'lib (cdr dir-entry)) (concat "[LIB] " (car dir-entry)) (car dir-entry)) @@ -5108,7 +5568,7 @@ ;; Define the variable which knows the value of "!DIR" (insert (format "\n(setq idlwave-system-directory \"%s\")\n" idlwave-system-directory)) - + ;; Define the variable which contains a list of all scanned directories (insert "\n(setq idlwave-path-alist\n '(") (let ((standard-output (current-buffer))) @@ -5148,7 +5608,7 @@ (when (file-directory-p dir) (setq files (nreverse (directory-files dir t "[^.]"))) (while (setq file (pop files)) - (if (file-directory-p file) + (if (file-directory-p file) (push (file-name-as-directory file) path))) (push dir path1))) path1)) @@ -5160,7 +5620,7 @@ (defun idlwave-scan-library-catalogs (&optional message-base no-load) - "Scan for library catalog files (.idlwave_catalog) and ingest. + "Scan for library catalog files (.idlwave_catalog) and ingest. All directories on `idlwave-path-alist' (or `idlwave-library-path' instead, if present) are searched. Print MESSAGE-BASE along with the @@ -5168,7 +5628,7 @@ NO-LOAD is non-nil. The variable `idlwave-use-library-catalogs' can be set to nil to disable library catalog scanning." (when idlwave-use-library-catalogs - (let ((dirs + (let ((dirs (if idlwave-library-path (idlwave-expand-path idlwave-library-path) (mapcar 'car idlwave-path-alist))) @@ -5177,7 +5637,7 @@ (if message-base (message message-base)) (while (setq dir (pop dirs)) (catch 'continue - (when (file-readable-p + (when (file-readable-p (setq catalog (expand-file-name ".idlwave_catalog" dir))) (unless no-load (setq idlwave-library-catalog-routines nil) @@ -5185,20 +5645,20 @@ (condition-case nil (load catalog t t t) (error (throw 'continue t))) - (when (and - message-base - (not (string= idlwave-library-catalog-libname + (when (and + message-base + (not (string= idlwave-library-catalog-libname old-libname))) - (message "%s" (concat message-base - idlwave-library-catalog-libname)) + (message "%s" (concat message-base + idlwave-library-catalog-libname)) (setq old-libname idlwave-library-catalog-libname)) (when idlwave-library-catalog-routines (setq all-routines - (append + (append (idlwave-sintern-rinfo-list idlwave-library-catalog-routines 'sys dir) all-routines)))) - + ;; Add a 'lib flag if on path-alist (when (and idlwave-path-alist (setq dir-entry (assoc dir idlwave-path-alist))) @@ -5209,17 +5669,28 @@ ;;----- Communicating with the Shell ------------------- ;; First, here is the idl program which can be used to query IDL for -;; defined routines. +;; defined routines. (defconst idlwave-routine-info.pro " ;; START OF IDLWAVE SUPPORT ROUTINES +pro idlwave_print_safe,item,limit + catch,err + if err ne 0 then begin + print,'Could not print item.' + return + endif + if n_elements(item) gt limit then $ + print,item[0:limit-1],'<... truncated at ',strtrim(limit,2),' elements>' $ + else print,item +end + pro idlwave_print_info_entry,name,func=func,separator=sep ;; See if it's an object method if name eq '' then return - func = keyword_set(func) + func = keyword_set(func) methsep = strpos(name,'::') meth = methsep ne -1 - + ;; Get routine info pars = routine_info(name,/parameters,functions=func) source = routine_info(name,/source,functions=func) @@ -5227,12 +5698,12 @@ nkw = pars.num_kw_args if nargs gt 0 then args = pars.args if nkw gt 0 then kwargs = pars.kw_args - + ;; Trim the class, and make the name - if meth then begin + if meth then begin class = strmid(name,0,methsep) name = strmid(name,methsep+2,strlen(name)-1) - if nargs gt 0 then begin + if nargs gt 0 then begin ;; remove the self argument wh = where(args ne 'SELF',nargs) if nargs gt 0 then args = args[wh] @@ -5241,7 +5712,7 @@ ;; No class, just a normal routine. class = \"\" endelse - + ;; Calling sequence cs = \"\" if func then cs = 'Result = ' @@ -5262,23 +5733,33 @@ kwstring = kwstring + ' ' + kwargs[j] endfor endif - + ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func] - + print,ret + ': ' + name + sep + class + sep + source[0].path $ + sep + cs + sep + kwstring end -pro idlwave_routine_info +pro idlwave_routine_info,file on_error,1 sep = '<@>' print,'>>>BEGIN OF IDLWAVE ROUTINE INFO (\"' + sep + '\" IS THE SEPARATOR)' all = routine_info() - for i=0,n_elements(all)-1 do $ - idlwave_print_info_entry,all[i],separator=sep + fileQ=n_elements(file) ne 0 + if fileQ then file=strtrim(file,2) + for i=0L,n_elements(all)-1L do begin + if fileQ then begin + if (routine_info(all[i],/SOURCE)).path eq file then $ + idlwave_print_info_entry,all[i],separator=sep + endif else idlwave_print_info_entry,all[i],separator=sep + endfor all = routine_info(/functions) - for i=0,n_elements(all)-1 do $ - idlwave_print_info_entry,all[i],/func,separator=sep + for i=0L,n_elements(all)-1L do begin + if fileQ then begin + if (routine_info(all[i],/FUNCTIONS,/SOURCE)).path eq file then $ + idlwave_print_info_entry,all[i],separator=sep,/FUNC + endif else idlwave_print_info_entry,all[i],separator=sep,/FUNC + endfor print,'>>>END OF IDLWAVE ROUTINE INFO' end @@ -5291,7 +5772,7 @@ help,/brief,output=s,/system_variables ; ? unsafe use of OUTPUT= s = strtrim(strjoin(s,' ',/single),2) ; make one line v = strsplit(s,' +',/regex,/extract) ; get variables - for i=0,n_elements(v)-1 do begin + for i=0L,n_elements(v)-1 do begin t = [''] ; get tag list a=execute('if n_tags('+v[i]+') gt 0 then t=tag_names('+v[i]+')') print, 'IDLWAVE-SYSVAR: '+v[i]+' '+strjoin(t,' ',/single) @@ -5304,7 +5785,7 @@ if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single) end ;; END OF IDLWAVE SUPPORT ROUTINES -" +" "The idl programs to get info from the shell.") (defvar idlwave-idlwave_routine_info-compiled nil @@ -5312,13 +5793,8 @@ (defvar idlwave-shell-temp-pro-file) (defvar idlwave-shell-temp-rinfo-save-file) -(defun idlwave-shell-update-routine-info (&optional quiet run-hooks wait) - "Query the shell for routine_info of compiled modules and update the lists." - ;; Save and compile the procedure. The compiled procedure is then - ;; saved into an IDL SAVE file, to allow for fast RESTORE. - ;; We need to RESTORE the procedure each time we use it, since - ;; the user may have killed or redefined it. In particular, - ;; .RESET_SESSION will kill all user procedures. + +(defun idlwave-shell-compile-helper-routines (&optional wait) (unless (and idlwave-idlwave_routine_info-compiled (file-readable-p (idlwave-shell-temp-file 'rinfo))) (save-excursion @@ -5327,20 +5803,37 @@ (erase-buffer) (insert idlwave-routine-info.pro) (save-buffer 0)) - (idlwave-shell-send-command - (concat ".run " idlwave-shell-temp-pro-file) + (idlwave-shell-send-command + (concat ".run \"" idlwave-shell-temp-pro-file "\"") nil 'hide wait) -; (message "SENDING SAVE") ; ???????????????????????? (idlwave-shell-send-command - (format "save,'idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" + (format "save,'idlwave_print_safe','idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" (idlwave-shell-temp-file 'rinfo)) - nil 'hide wait)) - - ;; Restore and execute the procedure, analyze the output -; (message "SENDING RESTORE & EXECUTE") ; ???????????????????????? + nil 'hide) + (setq idlwave-idlwave_routine_info-compiled t)) + + ;; Restore if necessary. Must use execute to hide lame routine_info + ;; errors on undefinded routine (idlwave-shell-send-command - (format "RESTORE, '%s' & idlwave_routine_info" + (format "if execute(\"_v=routine_info('idlwave_routine_info',/SOURCE)\") eq 0 then restore,'%s' else if _v.path eq '' then restore,'%s'" + idlwave-shell-temp-rinfo-save-file idlwave-shell-temp-rinfo-save-file) + nil 'hide)) + + +(defun idlwave-shell-update-routine-info (&optional quiet run-hooks wait file) + "Query the shell for routine_info of compiled modules and update the lists." + ;; Save and compile the procedure. The compiled procedure is then + ;; saved into an IDL SAVE file, to allow for fast RESTORE. We may + ;; need to test for and possibly RESTORE the procedure each time we + ;; use it, since the user may have killed or redefined it. In + ;; particular, .RESET_SESSION will kill all user procedures. If + ;; FILE is set, only update routine info for routines in that file. + + (idlwave-shell-compile-helper-routines wait) + ; execute the routine_info procedure, and analyze the output + (idlwave-shell-send-command + (format "idlwave_routine_info%s" (if file (concat ",'" file "'") "")) `(progn (idlwave-shell-routine-info-filter) (idlwave-concatenate-rinfo-lists ,quiet ,run-hooks)) @@ -5415,7 +5908,7 @@ (completion-regexp-list (if (equal arg '(16)) (list (read-string (concat "Completion Regexp: ")))))) - + (if (and module (string-match "::" module)) (setq class (substring module 0 (match-beginning 0)) module (substring module (match-end 0)))) @@ -5436,7 +5929,7 @@ ;; Check for any special completion functions ((and idlwave-complete-special (idlwave-call-special idlwave-complete-special))) - + ((null what) (error "Nothing to complete here")) @@ -5453,7 +5946,7 @@ (idlwave-all-class-inherits class-selector))) (isa (concat "procedure" (if class-selector "-method" ""))) (type-selector 'pro)) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'routine nil type-selector class-selector nil super-classes)) (idlwave-complete-in-buffer 'procedure (if class-selector 'method 'routine) @@ -5461,8 +5954,8 @@ (format "Select a %s name%s" isa (if class-selector - (format " (class is %s)" - (if (eq class-selector t) + (format " (class is %s)" + (if (eq class-selector t) "unknown" class-selector)) "")) isa @@ -5476,7 +5969,7 @@ (idlwave-all-class-inherits class-selector))) (isa (concat "function" (if class-selector "-method" ""))) (type-selector 'fun)) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'routine nil type-selector class-selector nil super-classes)) (idlwave-complete-in-buffer 'function (if class-selector 'method 'routine) @@ -5484,7 +5977,7 @@ (format "Select a %s name%s" isa (if class-selector - (format " (class is %s)" + (format " (class is %s)" (if (eq class-selector t) "unknown" class-selector)) "")) @@ -5512,18 +6005,18 @@ (unless (or entry (eq class t)) (error "Nothing known about procedure %s" (idlwave-make-full-name class name))) - (setq list (idlwave-fix-keywords name 'pro class list + (setq list (idlwave-fix-keywords name 'pro class list super-classes system)) (unless list (error "No keywords available for procedure %s" (idlwave-make-full-name class name))) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'keyword name type-selector class-selector entry super-classes)) (idlwave-complete-in-buffer 'keyword 'keyword list nil (format "Select keyword for procedure %s%s" (idlwave-make-full-name class name) (if (or (member '("_EXTRA") list) - (member '("_REF_EXTRA") list)) + (member '("_REF_EXTRA") list)) " (note _EXTRA)" "")) isa 'idlwave-attach-keyword-classes))) @@ -5546,7 +6039,7 @@ (unless (or entry (eq class t)) (error "Nothing known about function %s" (idlwave-make-full-name class name))) - (setq list (idlwave-fix-keywords name 'fun class list + (setq list (idlwave-fix-keywords name 'fun class list super-classes system)) ;; OBJ_NEW: Messages mention the proper Init method (setq msg-name (if (and (null class) @@ -5556,13 +6049,13 @@ (idlwave-make-full-name class name))) (unless list (error "No keywords available for function %s" msg-name)) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'keyword name type-selector class-selector nil super-classes)) (idlwave-complete-in-buffer 'keyword 'keyword list nil (format "Select keyword for function %s%s" msg-name (if (or (member '("_EXTRA") list) - (member '("_REF_EXTRA") list)) + (member '("_REF_EXTRA") list)) " (note _EXTRA)" "")) isa 'idlwave-attach-keyword-classes))) @@ -5600,10 +6093,10 @@ ("class"))) (module (idlwave-sintern-routine-or-method module class)) (class (idlwave-sintern-class class)) - (what (cond + (what (cond ((equal what 0) (setq what - (intern (completing-read + (intern (completing-read "Complete what? " what-list nil t)))) ((integerp what) (setq what (intern (car (nth (1- what) what-list))))) @@ -5625,7 +6118,7 @@ (super-classes nil) (type-selector 'pro) (pro (or module - (idlwave-completing-read + (idlwave-completing-read "Procedure: " (idlwave-routines) 'idlwave-selector)))) (setq pro (idlwave-sintern-routine pro)) (list nil-list nil-list 'procedure-keyword @@ -5639,7 +6132,7 @@ (super-classes nil) (type-selector 'fun) (func (or module - (idlwave-completing-read + (idlwave-completing-read "Function: " (idlwave-routines) 'idlwave-selector)))) (setq func (idlwave-sintern-routine func)) (list nil-list nil-list 'function-keyword @@ -5679,7 +6172,7 @@ ((eq what 'class) (list nil-list nil-list 'class nil-list nil)) - + (t (error "Invalid value for WHAT"))))) (defun idlwave-completing-read (&rest args) @@ -5702,7 +6195,7 @@ (stringp idlwave-shell-default-directory) (file-directory-p idlwave-shell-default-directory)) idlwave-shell-default-directory - default-directory))) + default-directory))) (comint-dynamic-complete-filename))) (defun idlwave-make-full-name (class name) @@ -5711,7 +6204,7 @@ (defun idlwave-rinfo-assoc (name type class list) "Like `idlwave-rinfo-assq', but sintern strings first." - (idlwave-rinfo-assq + (idlwave-rinfo-assq (idlwave-sintern-routine-or-method name class) type (idlwave-sintern-class class) list)) @@ -5735,7 +6228,7 @@ (setq classes nil))) rtn)) -(defun idlwave-best-rinfo-assq (name type class list &optional with-file +(defun idlwave-best-rinfo-assq (name type class list &optional with-file keep-system) "Like `idlwave-rinfo-assq', but get all twins and sort, then return first. If WITH-FILE is passed, find the best rinfo entry with a file @@ -5760,7 +6253,7 @@ twins))))) (car twins))) -(defun idlwave-best-rinfo-assoc (name type class list &optional with-file +(defun idlwave-best-rinfo-assoc (name type class list &optional with-file keep-system) "Like `idlwave-best-rinfo-assq', but sintern strings first." (idlwave-best-rinfo-assq @@ -5851,7 +6344,7 @@ Must accept two arguments: `apos' and `info'") (defun idlwave-determine-class (info type) - ;; Determine the class of a routine call. + ;; Determine the class of a routine call. ;; INFO is the `cw-list' structure as returned by idlwave-where. ;; The second element in this structure is the class. When nil, we ;; return nil. When t, try to get the class from text properties at @@ -5871,7 +6364,7 @@ (dassoc (cdr dassoc)) (t t))) (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) - (is-self + (is-self (and arrow (save-excursion (goto-char apos) (forward-word -1) @@ -5892,19 +6385,19 @@ (setq class (or (nth 2 (idlwave-current-routine)) class))) ;; Before prompting, try any special class determination routines - (when (and (eq t class) + (when (and (eq t class) idlwave-determine-class-special (not force-query)) - (setq special-class + (setq special-class (idlwave-call-special idlwave-determine-class-special apos)) - (if special-class + (if special-class (setq class (idlwave-sintern-class special-class) store idlwave-store-inquired-class))) - + ;; Prompt for a class, if we need to (when (and (eq class t) (or force-query query)) - (setq class-alist + (setq class-alist (mapcar 'list (idlwave-all-method-classes (car info) type))) (setq class (idlwave-sintern-class @@ -5913,9 +6406,9 @@ (error "No classes available with method %s" (car info))) ((and (= (length class-alist) 1) (not force-query)) (car (car class-alist))) - (t + (t (setq store idlwave-store-inquired-class) - (idlwave-completing-read + (idlwave-completing-read (format "Class%s: " (if (stringp (car info)) (format " for %s method %s" type (car info)) @@ -5927,9 +6420,9 @@ ;; We have a real class here (when (and store arrow) (condition-case () - (add-text-properties - apos (+ apos 2) - `(idlwave-class ,class face ,idlwave-class-arrow-face + (add-text-properties + apos (+ apos 2) + `(idlwave-class ,class face ,idlwave-class-arrow-face rear-nonsticky t)) (error nil))) (setf (nth 2 info) class)) @@ -5957,14 +6450,14 @@ (defun idlwave-where () - "Find out where we are. + "Find out where we are. The return value is a list with the following stuff: \(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) PRO-LIST (PRO POINT CLASS ARROW) FUNC-LIST (FUNC POINT CLASS ARROW) COMPLETE-WHAT a symbol indicating what kind of completion makes sense here -CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can +CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can be completed here. LAST-CHAR last relevant character before point (non-white non-comment, not part of current identifier or leading slash). @@ -5976,7 +6469,7 @@ CLASS: What class has the routine (nil=no, t=is method, but class unknown) ARROW: Location of the arrow" (idlwave-routines) - (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) + (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) (bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) (func-entry (idlwave-what-function bos)) (func (car func-entry)) @@ -5998,8 +6491,8 @@ ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" match-string) (setq cw 'class)) - ((string-match - "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" + ((string-match + "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" (if (> pro-point 0) (buffer-substring pro-point (point)) match-string)) @@ -6010,11 +6503,11 @@ nil) ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'" match-string) - (setq cw 'class)) + (setq cw 'class)) ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'" match-string) - (setq cw 'class)) - ((and func + (setq cw 'class)) + ((and func (> func-point pro-point) (= func-level 1) (memq last-char '(?\( ?,))) @@ -6060,7 +6553,7 @@ ;; searches to this point. (catch 'exit - (let (pos + (let (pos func-point (cnt 0) func arrow-start class) @@ -6075,18 +6568,18 @@ (setq pos (point)) (incf cnt) (when (and (= (following-char) ?\() - (re-search-backward + (re-search-backward "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" bound t)) (setq func (match-string 2) func-point (goto-char (match-beginning 2)) pos func-point) - (if (re-search-backward + (if (re-search-backward "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) (setq arrow-start (copy-marker (match-beginning 0)) class (or (match-string 2) t))) - (throw - 'exit + (throw + 'exit (list (idlwave-sintern-routine-or-method func class) (idlwave-sintern-class class) @@ -6102,18 +6595,18 @@ ;; searches to this point. (let ((pos (point)) pro-point pro class arrow-start string) - (save-excursion + (save-excursion ;;(idlwave-beginning-of-statement) (idlwave-start-of-substatement 'pre) (setq string (buffer-substring (point) pos)) - (if (string-match + (if (string-match "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) (setq pro (match-string 1 string) pro-point (+ (point) (match-beginning 1))) (if (and (idlwave-skip-object) (setq string (buffer-substring (point) pos)) - (string-match - "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" + (string-match + "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" string)) (setq pro (if (match-beginning 4) (match-string 4 string)) @@ -6157,7 +6650,7 @@ (throw 'exit nil)))) (goto-char pos) nil))) - + (defun idlwave-last-valid-char () "Return the last character before point which is not white or a comment and also not part of the current identifier. Since we do this in @@ -6247,23 +6740,23 @@ ((or (eq completion t) (and (= 1 (length (setq all-completions (idlwave-uniquify - (all-completions part list - (or special-selector + (all-completions part list + (or special-selector selector)))))) (equal dpart dcompletion))) ;; This is already complete (idlwave-after-successful-completion type slash beg) (message "%s is already the complete %s" part isa) nil) - (t + (t ;; We cannot add something - offer a list. (message "Making completion list...") - + (unless idlwave-completion-help-links ; already set somewhere? (mapcar (lambda (x) ; Pass link prop through to highlight-linked (let ((link (get-text-property 0 'link (car x)))) (if link - (push (cons (car x) link) + (push (cons (car x) link) idlwave-completion-help-links)))) list)) (let* ((list all-completions) @@ -6273,7 +6766,7 @@ ; (completion-fixup-function ; Emacs ; (lambda () (and (eq (preceding-char) ?>) ; (re-search-backward " <" beg t))))) - + (setq list (sort list (lambda (a b) (string< (downcase a) (downcase b))))) (if prepare-display-function @@ -6283,7 +6776,7 @@ idlwave-complete-empty-string-as-lower-case) (not idlwave-completion-force-default-case)) (setq list (mapcar (lambda (x) - (if (listp x) + (if (listp x) (setcar x (downcase (car x))) (setq x (downcase x))) x) @@ -6303,19 +6796,19 @@ (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" (- (point) 15) t) (goto-char (point-min)) - (re-search-forward + (re-search-forward "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) ;; Yank the full class specification (insert (match-string 2)) ;; Do the completion, using list gathered from `idlwave-routines' - (idlwave-complete-in-buffer - 'class 'class (idlwave-class-alist) nil + (idlwave-complete-in-buffer + 'class 'class (idlwave-class-alist) nil "Select a class" "class" '(lambda (list) ;; Push it to help-links if system help available (mapcar (lambda (x) (let* ((entry (idlwave-class-info x)) (link (nth 1 (assq 'link entry)))) - (if link (push (cons x link) + (if link (push (cons x link) idlwave-completion-help-links)) x)) list))))) @@ -6327,7 +6820,7 @@ ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. (if (or (null show-classes) ; don't want to see classes (null class-selector) ; not a method call - (and + (and (stringp class-selector) ; the class is already known (not super-classes))) ; no possibilities for inheritance ;; In these cases, we do not have to do anything @@ -6342,13 +6835,13 @@ (max (abs show-classes)) (lmax (if do-dots (apply 'max (mapcar 'length list)))) classes nclasses class-info space) - (mapcar + (mapcar (lambda (x) ;; get the classes (if (eq type 'class-tag) ;; Just one class for tags (setq classes - (list + (list (idlwave-class-or-superclass-with-tag class-selector x))) ;; Multiple classes for method or method-keyword (setq classes @@ -6357,7 +6850,7 @@ method-selector x type-selector) (idlwave-all-method-classes x type-selector))) (if inherit - (setq classes + (setq classes (delq nil (mapcar (lambda (x) (if (memq x inherit) x nil)) classes))))) @@ -6394,7 +6887,7 @@ (defun idlwave-attach-class-tag-classes (list) ;; Call idlwave-attach-classes with class structure tags (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes)) - + ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- @@ -6415,7 +6908,7 @@ ((= 1 (length list)) (setq rtn (car list))) ((featurep 'xemacs) - (if sort (setq list (sort list (lambda (a b) + (if sort (setq list (sort list (lambda (a b) (string< (upcase a) (upcase b)))))) (setq menu (append (list title) @@ -6426,7 +6919,7 @@ (setq resp (get-popup-menu-response menu)) (funcall (event-function resp) (event-object resp))) (t - (if sort (setq list (sort list (lambda (a b) + (if sort (setq list (sort list (lambda (a b) (string< (upcase a) (upcase b)))))) (setq menu (cons title (list @@ -6517,7 +7010,7 @@ (setq idlwave-before-completion-wconf (current-window-configuration))) (if (featurep 'xemacs) - (idlwave-display-completion-list-xemacs + (idlwave-display-completion-list-xemacs list) (idlwave-display-completion-list-emacs list)) @@ -6598,7 +7091,7 @@ (mapcar (lambda(x) (princ (nth 1 x)) (princ "\n")) - keys-alist)) + keys-alist)) (setq char (read-char))) (setq char (read-char))) (message nil) @@ -6718,7 +7211,7 @@ (defun idlwave-make-modified-completion-map-emacs (old-map) "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." (let ((new-map (copy-keymap old-map))) - (substitute-key-definition + (substitute-key-definition 'choose-completion 'idlwave-choose-completion new-map) (substitute-key-definition 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) @@ -6744,8 +7237,8 @@ ;; ;; - Go again over the documentation how to write a completion ;; plugin. It is in self.el, but currently still very bad. -;; This could be in a separate file in the distribution, or -;; in an appendix for the manual. +;; This could be in a separate file in the distribution, or +;; in an appendix for the manual. (defvar idlwave-struct-skip "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*" @@ -6784,7 +7277,7 @@ (beg (car borders)) (end (cdr borders)) (case-fold-search t)) - (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") + (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") end t))) (defun idlwave-struct-inherits () @@ -6799,7 +7292,7 @@ (goto-char beg) (save-restriction (narrow-to-region beg end) - (while (re-search-forward + (while (re-search-forward (concat "[{,]" ;leading comma/brace idlwave-struct-skip ; 4 groups "inherits" ; The INHERITS tag @@ -6849,9 +7342,9 @@ (concat "\\<" (regexp-quote (downcase var)) "\\>" ws) "\\(\\)") "=" ws "\\({\\)" - (if name + (if name (if (stringp name) - (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") + (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") ;; Just a generic name (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ",")) "")))) @@ -6862,8 +7355,7 @@ (goto-char (match-beginning 3)) (match-string-no-properties 5))))) -(defvar idlwave-class-info nil) -(defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo +(defvar idlwave-class-info nil) (defvar idlwave-class-reset nil) ; to reset buffer-local classes (add-hook 'idlwave-update-rinfo-hook @@ -6875,13 +7367,13 @@ (let (list entry) (if idlwave-class-info (if idlwave-class-reset - (setq + (setq idlwave-class-reset nil idlwave-class-info ; Remove any visited in a buffer - (delq nil (mapcar - (lambda (x) - (let ((filebuf - (idlwave-class-file-or-buffer + (delq nil (mapcar + (lambda (x) + (let ((filebuf + (idlwave-class-file-or-buffer (or (cdr (assq 'found-in x)) (car x))))) (if (cdr filebuf) nil @@ -6919,7 +7411,7 @@ (progn ;; For everything there (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point))) - (while (setq name + (while (setq name (idlwave-find-structure-definition nil t end-lim)) (funcall all-hook name))) (idlwave-find-structure-definition nil (or alt-class class)))))) @@ -6957,11 +7449,11 @@ (insert-file-contents file)) (save-excursion (goto-char 1) - (idlwave-find-class-definition class + (idlwave-find-class-definition class ;; Scan all of the structures found there (lambda (name) (let* ((this-class (idlwave-sintern-class name)) - (entry + (entry (list this-class (cons 'tags (idlwave-struct-tags)) (cons 'inherits (idlwave-struct-inherits))))) @@ -6986,7 +7478,7 @@ (condition-case err (apply 'append (mapcar 'idlwave-class-tags (cons class (idlwave-all-class-inherits class)))) - (error + (error (idlwave-class-tag-reset) (error "%s" (error-message-string err))))) @@ -7023,24 +7515,24 @@ all-inherits)))))) (defun idlwave-entry-keywords (entry &optional record-link) - "Return the flat entry keywords alist from routine-info entry. + "Return the flat entry keywords alist from routine-info entry. If RECORD-LINK is non-nil, the keyword text is copied and a text property indicating the link is added." (let (kwds) (mapcar - (lambda (key-list) + (lambda (key-list) (let ((file (car key-list))) (mapcar (lambda (key-cons) (let ((key (car key-cons)) (link (cdr key-cons))) (when (and record-link file) (setq key (copy-sequence key)) - (put-text-property + (put-text-property 0 (length key) - 'link - (concat - file - (if link + 'link + (concat + file + (if link (concat idlwave-html-link-sep (number-to-string link)))) key)) @@ -7053,13 +7545,13 @@ "Find keyword KEYWORD in entry ENTRY, and return (with link) if set" (catch 'exit (mapc - (lambda (key-list) + (lambda (key-list) (let ((file (car key-list)) (kwd (assoc keyword (cdr key-list)))) (when kwd - (setq kwd (cons (car kwd) + (setq kwd (cons (car kwd) (if (and file (cdr kwd)) - (concat file + (concat file idlwave-html-link-sep (number-to-string (cdr kwd))) (cdr kwd)))) @@ -7097,14 +7589,14 @@ ;; Check if we need to update the "current" class (if (not (equal class-selector idlwave-current-tags-class)) (idlwave-prepare-class-tag-completion class-selector)) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'idlwave-complete-class-structure-tag-help - (idlwave-sintern-routine + (idlwave-sintern-routine (concat class-selector "__define")) nil)) (let ((idlwave-cpl-bold idlwave-current-native-class-tags)) (idlwave-complete-in-buffer - 'class-tag 'class-tag + 'class-tag 'class-tag idlwave-current-class-tags nil (format "Select a tag of class %s" class-selector) "class tag" @@ -7139,12 +7631,6 @@ (add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset) (add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist) -(defvar idlwave-executive-commands-alist nil - "Alist of system variables and their help files.") - -(defvar idlwave-system-variables-alist nil - "Alist of system variables and the associated structure tags. -Gets set in `idlw-rinfo.el'.") (defun idlwave-complete-sysvar-or-tag () "Complete a system variable." @@ -7156,7 +7642,7 @@ (skip-chars-backward "[a-zA-Z0-9_$]") (equal (char-before) ?!)) (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help)) - (idlwave-complete-in-buffer 'sysvar 'sysvar + (idlwave-complete-in-buffer 'sysvar 'sysvar idlwave-system-variables-alist nil "Select a system variable" "system variable") @@ -7175,14 +7661,15 @@ (or tags (error "System variable !%s is not a structure" var)) (setq idlwave-completion-help-info (list 'idlwave-complete-sysvar-tag-help var)) - (idlwave-complete-in-buffer 'sysvartag 'sysvartag + (idlwave-complete-in-buffer 'sysvartag 'sysvartag tags nil "Select a system variable tag" "system variable tag") t)) ; return t to skip other completions (t nil)))) -(defvar link) ;dynamic +(defvar link) ;dynamic variables set by help callback +(defvar props) (defun idlwave-complete-sysvar-help (mode word) (let ((word (or (nth 1 idlwave-completion-help-info) word)) (entry (assoc word idlwave-system-variables-alist))) @@ -7203,13 +7690,19 @@ ((eq mode 'test) ; we can at least link the main (and (stringp word) entry main)) ((eq mode 'set) - (if entry - (setq link + (if entry + (setq link (if (setq target (cdr (assoc word tags))) (idlwave-substitute-link-target main target) main)))) ;; setting dynamic!!! (t (error "This should not happen"))))) +(defun idlwave-split-link-target (link) + "Split a given link into link file and anchor." + (if (string-match idlwave-html-link-sep link) + (cons (substring link 0 (match-beginning 0)) + (string-to-number (substring link (match-end 0)))))) + (defun idlwave-substitute-link-target (link target) "Substitute the target anchor for the given link." (let (main-base) @@ -7222,7 +7715,7 @@ ;; Fake help in the source buffer for class structure tags. ;; KWD AND NAME ARE GLOBAL-VARIABLES HERE. -(defvar name) +(defvar name) (defvar kwd) (defvar idlwave-help-do-class-struct-tag nil) (defun idlwave-complete-class-structure-tag-help (mode word) @@ -7231,11 +7724,11 @@ nil) ((eq mode 'set) (let (class-with found-in) - (when (setq class-with - (idlwave-class-or-superclass-with-tag + (when (setq class-with + (idlwave-class-or-superclass-with-tag idlwave-current-tags-class word)) - (if (assq (idlwave-sintern-class class-with) + (if (assq (idlwave-sintern-class class-with) idlwave-system-class-info) (error "No help available for system class tags")) (if (setq found-in (idlwave-class-found-in class-with)) @@ -7248,7 +7741,7 @@ (defun idlwave-class-or-superclass-with-tag (class tag) "Find and return the CLASS or one of its superclass with the associated TAG, if any." - (let ((sclasses (cons class (cdr (assq 'all-inherits + (let ((sclasses (cons class (cdr (assq 'all-inherits (idlwave-class-info class))))) cl) (catch 'exit @@ -7257,7 +7750,7 @@ (let ((tags (idlwave-class-tags cl))) (while tags (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t)) - (throw 'exit cl)) + (throw 'exit cl)) (setq tags (cdr tags)))))))) @@ -7280,8 +7773,8 @@ (setcar entry (idlwave-sintern-sysvar (car entry) 'set)) (setq tags (assq 'tags entry)) (if tags - (setcdr tags - (mapcar (lambda (x) + (setcdr tags + (mapcar (lambda (x) (cons (idlwave-sintern-sysvartag (car x) 'set) (cdr x))) (cdr tags))))))) @@ -7298,19 +7791,19 @@ text start) (setq start (match-end 0) var (match-string 1 text) - tags (if (match-end 3) + tags (if (match-end 3) (idlwave-split-string (match-string 3 text)))) ;; Maintain old links, if present (setq old-entry (assq (idlwave-sintern-sysvar var) old)) (setq link (assq 'link old-entry)) (setq idlwave-system-variables-alist - (cons (list var - (cons - 'tags - (mapcar (lambda (x) - (cons x - (cdr (assq - (idlwave-sintern-sysvartag x) + (cons (list var + (cons + 'tags + (mapcar (lambda (x) + (cons x + (cdr (assq + (idlwave-sintern-sysvartag x) (cdr (assq 'tags old-entry)))))) tags)) link) idlwave-system-variables-alist))) @@ -7332,9 +7825,9 @@ (defun idlwave-uniquify (list) (let ((ht (make-hash-table :size (length list) :test 'equal))) - (delq nil + (delq nil (mapcar (lambda (x) - (unless (gethash x ht) + (unless (gethash x ht) (puthash x t ht) x)) list)))) @@ -7362,11 +7855,11 @@ nil))) ;; Restore the pre-completion window configuration if this is safe. - - (if (or (eq verify 'force) ; force - (and + + (if (or (eq verify 'force) ; force + (and (get-buffer-window "*Completions*") ; visible - (idlwave-local-value 'idlwave-completion-p + (idlwave-local-value 'idlwave-completion-p "*Completions*") ; cib-buffer (eq (marker-buffer idlwave-completion-mark) (current-buffer)) ; buffer OK @@ -7464,7 +7957,7 @@ (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" resolve) (setq type (match-string 1 resolve) - class (if (match-beginning 2) + class (if (match-beginning 2) (match-string 3 resolve) nil) name (match-string 4 resolve))) @@ -7473,15 +7966,15 @@ (cond ((null class) - (idlwave-shell-send-command + (idlwave-shell-send-command (format "resolve_routine,'%s'%s" (downcase name) kwd) 'idlwave-update-routine-info nil t)) (t - (idlwave-shell-send-command + (idlwave-shell-send-command (format "resolve_routine,'%s__define'%s" (downcase class) kwd) - (list 'idlwave-shell-send-command - (format "resolve_routine,'%s__%s'%s" + (list 'idlwave-shell-send-command + (format "resolve_routine,'%s__%s'%s" (downcase class) (downcase name) kwd) '(idlwave-update-routine-info) nil t)))))) @@ -7502,19 +7995,19 @@ (this-buffer (equal arg '(4))) (module (idlwave-fix-module-if-obj_new (idlwave-what-module))) (default (if module - (concat (idlwave-make-full-name + (concat (idlwave-make-full-name (nth 2 module) (car module)) (if (eq (nth 1 module) 'pro) "<p>" "<f>")) "none")) - (list + (list (idlwave-uniquify (delq nil - (mapcar (lambda (x) + (mapcar (lambda (x) (if (eq 'system (car-safe (nth 3 x))) ;; Take out system routines with no source. nil (list - (concat (idlwave-make-full-name + (concat (idlwave-make-full-name (nth 2 x) (car x)) (if (eq (nth 1 x) 'pro) "<p>" "<f>"))))) (if this-buffer @@ -7543,10 +8036,10 @@ (t t))) (idlwave-do-find-module name type class nil this-buffer))) -(defun idlwave-do-find-module (name type class +(defun idlwave-do-find-module (name type class &optional force-source this-buffer) (let ((name1 (idlwave-make-full-name class name)) - source buf1 entry + source buf1 entry (buf (current-buffer)) (pos (point)) file name2) @@ -7556,11 +8049,11 @@ name2 (if (nth 2 entry) (idlwave-make-full-name (nth 2 entry) name) name1)) - (if source + (if source (setq file (idlwave-routine-source-file source))) (unless file ; Try to find it on the path. - (setq file - (idlwave-expand-lib-file-name + (setq file + (idlwave-expand-lib-file-name (if class (format "%s__define.pro" (downcase class)) (format "%s.pro" (downcase name)))))) @@ -7568,14 +8061,14 @@ ((or (null name) (equal name "")) (error "Abort")) ((eq (car source) 'system) - (error "Source code for system routine %s is not available" + (error "Source code for system routine %s is not available" name2)) ((or (not file) (not (file-regular-p file))) (error "Source code for routine %s is not available" name2)) (t (when (not this-buffer) - (setq buf1 + (setq buf1 (idlwave-find-file-noselect file 'find)) (pop-to-buffer buf1 t)) (goto-char (point-max)) @@ -7585,7 +8078,7 @@ (cond ((eq type 'fun) "function") ((eq type 'pro) "pro") (t "\\(pro\\|function\\)")) - "\\>[ \t]+" + "\\>[ \t]+" (regexp-quote (downcase name2)) "[^a-zA-Z0-9_$]") nil t) @@ -7622,17 +8115,17 @@ (cond ((and (eq cw 'procedure) (not (equal this-word ""))) - (setq this-word (idlwave-sintern-routine-or-method + (setq this-word (idlwave-sintern-routine-or-method this-word (nth 2 (nth 3 where)))) (list this-word 'pro - (idlwave-determine-class + (idlwave-determine-class (cons this-word (cdr (nth 3 where))) 'pro))) - ((and (eq cw 'function) + ((and (eq cw 'function) (not (equal this-word "")) (or (eq next-char ?\() ; exclude arrays, vars. (looking-at "[a-zA-Z0-9_]*[ \t]*("))) - (setq this-word (idlwave-sintern-routine-or-method + (setq this-word (idlwave-sintern-routine-or-method this-word (nth 2 (nth 3 where)))) (list this-word 'fun (idlwave-determine-class @@ -7669,7 +8162,7 @@ class))) (defun idlwave-fix-module-if-obj_new (module) - "Check if MODULE points to obj_new. + "Check if MODULE points to obj_new. If yes, and if the cursor is in the keyword region, change to the appropriate Init method." (let* ((name (car module)) @@ -7690,7 +8183,7 @@ (idlwave-sintern-class class))))) module)) -(defun idlwave-fix-keywords (name type class keywords +(defun idlwave-fix-keywords (name type class keywords &optional super-classes system) "Update a list of keywords. Translate OBJ_NEW, adding all super-class keywords, or all keywords @@ -7711,34 +8204,34 @@ string) (setq class (idlwave-sintern-class (match-string 1 string))) (setq idlwave-current-obj_new-class class) - (setq keywords - (append keywords + (setq keywords + (append keywords (idlwave-entry-keywords (idlwave-rinfo-assq (idlwave-sintern-method "INIT") 'fun class (idlwave-routines)) 'do-link)))))) - + ;; If the class is `t', combine all keywords of all methods NAME (when (eq class t) (mapc (lambda (entry) (and (nth 2 entry) ; non-nil class (eq (nth 1 entry) type) ; correct type - (setq keywords - (append keywords + (setq keywords + (append keywords (idlwave-entry-keywords entry 'do-link))))) (idlwave-all-assq name (idlwave-routines))) (setq keywords (idlwave-uniquify keywords))) - + ;; If we have inheritance, add all keywords from superclasses, if ;; the user indicated that method in `idlwave-keyword-class-inheritance' - (when (and + (when (and super-classes idlwave-keyword-class-inheritance (stringp class) - (or + (or system (assq (idlwave-sintern-keyword "_extra") keywords) (assq (idlwave-sintern-keyword "_ref_extra") keywords)) @@ -7756,7 +8249,7 @@ (mapcar (lambda (k) (add-to-list 'keywords k)) (idlwave-entry-keywords entry 'do-link)))) (setq keywords (idlwave-uniquify keywords))) - + ;; Return the final list keywords)) @@ -7781,14 +8274,14 @@ (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) (completion-ignore-case t) candidates) - (cond ((assq kwd kwd-alist) + (cond ((assq kwd kwd-alist) kwd) ((setq candidates (all-completions kwd kwd-alist)) (if (= (length candidates) 1) (car candidates) candidates)) ((and entry extra) - ;; Inheritance may cause this keyword to be correct + ;; Inheritance may cause this keyword to be correct keyword) (entry ;; We do know the function, which does not have the keyword. @@ -7800,13 +8293,13 @@ (defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) (defvar idlwave-rinfo-map (make-sparse-keymap)) -(define-key idlwave-rinfo-mouse-map +(define-key idlwave-rinfo-mouse-map (if (featurep 'xemacs) [button2] [mouse-2]) 'idlwave-mouse-active-rinfo) -(define-key idlwave-rinfo-mouse-map +(define-key idlwave-rinfo-mouse-map (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) 'idlwave-mouse-active-rinfo-shift) -(define-key idlwave-rinfo-mouse-map +(define-key idlwave-rinfo-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) 'idlwave-mouse-active-rinfo-right) (define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) @@ -7832,7 +8325,7 @@ (let* ((initial-class (or initial-class class)) (entry (or (idlwave-best-rinfo-assq name type class (idlwave-routines)) - (idlwave-rinfo-assq name type class + (idlwave-rinfo-assq name type class idlwave-unresolved-routines))) (name (or (car entry) name)) (class (or (nth 2 entry) class)) @@ -7855,9 +8348,9 @@ (col 0) (data (list name type class (current-buffer) nil initial-class)) (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) - (face 'idlwave-help-link-face) + (face 'idlwave-help-link) beg props win cnt total) - ;; Fix keywords, but don't add chained super-classes, since these + ;; Fix keywords, but don't add chained super-classes, since these ;; are shown separately for that super-class (setq keywords (idlwave-fix-keywords name type class keywords)) (cond @@ -7899,7 +8392,7 @@ km-prop idlwave-rinfo-mouse-map 'help-echo help-echo-use 'data (cons 'usage data))) - (if html-file (setq props (append (list 'face face 'link html-file) + (if html-file (setq props (append (list 'face face 'link html-file) props))) (insert "Usage: ") (setq beg (point)) @@ -7908,14 +8401,14 @@ (format calling-seq name name name name)) "\n") (add-text-properties beg (point) props) - + (insert "Keywords:") (if (null keywords) (insert " No keywords accepted.") (setq col 9) (mapcar (lambda (x) - (if (>= (+ col 1 (length (car x))) + (if (>= (+ col 1 (length (car x))) (window-width)) (progn (insert "\n ") @@ -7933,7 +8426,7 @@ (add-text-properties beg (point) props) (setq col (+ col 1 (length (car x))))) keywords)) - + (setq cnt 1 total (length all)) ;; Here entry is (key file (list of type-conses)) (while (setq entry (pop all)) @@ -7946,7 +8439,7 @@ (cdr (car (nth 2 entry)))) 'data (cons 'source data))) (idlwave-insert-source-location - (format "\n%-8s %s" + (format "\n%-8s %s" (if (equal cnt 1) (if (> total 1) "Sources:" "Source:") "") @@ -7955,7 +8448,7 @@ (incf cnt) (when (and all (> cnt idlwave-rinfo-max-source-lines)) ;; No more source lines, please - (insert (format + (insert (format "\n Source information truncated to %d entries." idlwave-rinfo-max-source-lines)) (setq all nil))) @@ -7969,7 +8462,7 @@ (unwind-protect (progn (select-window win) - (enlarge-window (- (/ (frame-height) 2) + (enlarge-window (- (/ (frame-height) 2) (window-height))) (shrink-window-if-larger-than-buffer)) (select-window ww))))))))) @@ -8006,9 +8499,9 @@ ((and (not file) shell-flag) (insert "Unresolved")) - ((null file) + ((null file) (insert "ERROR")) - + ((idlwave-syslib-p file) (if (string-match "obsolete" (file-name-directory file)) (insert "Obsolete ") @@ -8022,7 +8515,7 @@ ;; Old special syntax: a matching regexp ((setq special (idlwave-special-lib-test file)) (insert (format "%-10s" special))) - + ;; Catch-all with file ((idlwave-lib-p file) (insert "Library ")) @@ -8037,7 +8530,7 @@ (if shell-flag "S" "-") (if buffer-flag "B" "-") "] "))) - (when (> ndupl 1) + (when (> ndupl 1) (setq beg (point)) (insert (format "(%dx) " ndupl)) (add-text-properties beg (point) (list 'face 'bold))) @@ -8061,7 +8554,7 @@ alist nil))) rtn) (t nil)))) - + (defun idlwave-mouse-active-rinfo-right (ev) (interactive "e") (idlwave-mouse-active-rinfo ev 'right)) @@ -8080,7 +8573,7 @@ was pressed." (interactive "e") (if ev (mouse-set-point ev)) - (let (data id name type class buf bufwin source link keyword + (let (data id name type class buf bufwin source link keyword word initial-class) (setq data (get-text-property (point) 'data) source (get-text-property (point) 'source) @@ -8095,9 +8588,9 @@ (cond ((eq id 'class) ; Switch class being displayed (if (window-live-p bufwin) (select-window bufwin)) - (idlwave-display-calling-sequence + (idlwave-display-calling-sequence (idlwave-sintern-method name) - type (idlwave-sintern-class word) + type (idlwave-sintern-class word) initial-class)) ((eq id 'usage) ; Online help on this routine (idlwave-online-help link name type class)) @@ -8138,9 +8631,9 @@ (setq bwin (get-buffer-window buffer))) (if (eq (preceding-char) ?/) (insert keyword) - (unless (save-excursion + (unless (save-excursion (re-search-backward - "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" + "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" (min (- (point) 100) (point-min)) t)) (insert ", ")) (if shift (insert "/")) @@ -8192,7 +8685,7 @@ command can be used to detect possible name clashes during this process." (idlwave-routines) ; Make sure everything is loaded. (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines) - (or (y-or-n-p + (or (y-or-n-p "You don't have any user or library catalogs. Continue anyway? ") (error "Abort"))) (let* ((routines (append idlwave-system-routines @@ -8205,11 +8698,10 @@ (keymap (make-sparse-keymap)) (props (list 'mouse-face 'highlight km-prop keymap - 'help-echo "Mouse2: Find source")) + 'help-echo "Mouse2: Find source")) (nroutines (length (or special-routines routines))) - (step (/ nroutines 99)) + (step (/ nroutines 100)) (n 0) - (next-perc 1) (cnt 0) (idlwave-sort-prefer-buffer-info nil) routine twins dtwins twin done props1 lroutines) @@ -8229,13 +8721,13 @@ (message "Sorting routines...done") (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) - (lambda (ev) + (lambda (ev) (interactive "e") (mouse-set-point ev) (apply 'idlwave-do-find-module (get-text-property (point) 'find-args)))) (define-key keymap [(return)] - (lambda () + (lambda () (interactive) (apply 'idlwave-do-find-module (get-text-property (point) 'find-args)))) @@ -8245,11 +8737,9 @@ (setq buffer-read-only nil) (erase-buffer) (while (setq routine (pop routines)) - (setq n (1+ n)) - (if (= (* next-perc step) n) - (progn - (message "Compiling list...(%2d%%)" next-perc) - (setq next-perc (1+ next-perc)))) + (if (= (mod (setq n (1+ n)) step) 0) + (message "Compiling list...(%2d%%)" (/ (* n 100) nroutines))) + ;; Get a list of all twins (setq twins (idlwave-routine-twins routine (or lroutines routines))) (if (memq routine done) @@ -8263,13 +8753,13 @@ (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1)) (incf cnt) (insert (format "\n%s%s" - (idlwave-make-full-name (nth 2 routine) + (idlwave-make-full-name (nth 2 routine) (car routine)) (if (eq (nth 1 routine) 'fun) "()" ""))) (while (setq twin (pop dtwins)) (setq props1 (append (list 'find-args - (list (nth 0 routine) - (nth 1 routine) + (list (nth 0 routine) + (nth 1 routine) (nth 2 routine))) props)) (idlwave-insert-source-location "\n - " twin props1)))) @@ -8292,7 +8782,7 @@ (or (not (stringp sfile)) (not (string-match "\\S-" sfile)))) (setq stype 'unresolved)) - (princ (format " %-10s %s\n" + (princ (format " %-10s %s\n" stype (if sfile sfile "No source code available"))))) @@ -8311,20 +8801,20 @@ (eq type (nth 1 candidate)) (eq class (nth 2 candidate))) (push candidate twins))) - (if (setq candidate (idlwave-rinfo-assq name type class + (if (setq candidate (idlwave-rinfo-assq name type class idlwave-unresolved-routines)) (push candidate twins)) (cons entry (nreverse twins)))) (defun idlwave-study-twins (entries) - "Return dangerous twins of first entry in ENTRIES. + "Return dangerous twins of first entry in ENTRIES. Dangerous twins are routines with same name, but in different files on the load path. If a file is in the system library and has an entry in the `idlwave-system-routines' list, we omit the latter as non-dangerous because many IDL routines are implemented as library routines, and may have been scanned." (let* ((entry (car entries)) - (name (car entry)) ; + (name (car entry)) ; (type (nth 1 entry)) ; Must be bound for (class (nth 2 entry)) ; idlwave-routine-twin-compare (cnt 0) @@ -8342,23 +8832,23 @@ (t 'unresolved))) ;; Check for an entry in the system library - (if (and file + (if (and file (not syslibp) (idlwave-syslib-p file)) (setq syslibp t)) - + ;; If there's more than one matching entry for the same file, just ;; append the type-cons to the type list. (if (setq entry (assoc key alist)) (push type-cons (nth 2 entry)) (push (list key file (list type-cons)) alist))) - + (setq alist (nreverse alist)) - + (when syslibp ;; File is in system *library* - remove any 'system entry (setq alist (delq (assq 'system alist) alist))) - + ;; If 'system remains and we've scanned the syslib, it's a builtin ;; (rather than a !DIR/lib/.pro file bundled as source). (when (and (idlwave-syslib-scanned-p) @@ -8394,7 +8884,7 @@ ((not (eq type (nth 1 b))) ;; Type decides (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) - (t + (t ;; A and B are twins - so the decision is more complicated. ;; Call twin-compare with the proper arguments. (idlwave-routine-entry-compare-twins a b))))) @@ -8446,7 +8936,7 @@ (tpath-alist (idlwave-true-path-alist)) (apathp (and (stringp akey) (assoc (file-name-directory akey) tpath-alist))) - (bpathp (and (stringp bkey) + (bpathp (and (stringp bkey) (assoc (file-name-directory bkey) tpath-alist))) ;; How early on search path? High number means early since we ;; measure the tail of the path list @@ -8482,7 +8972,7 @@ (t nil)))) ; Default (defun idlwave-routine-source-file (source) - (if (nth 2 source) + (if (nth 2 source) (expand-file-name (nth 1 source) (nth 2 source)) (nth 1 source))) @@ -8572,7 +9062,7 @@ (forward-sexp 2) (forward-sexp -1) (let ((begin (point))) - (re-search-forward + (re-search-forward "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") (if (fboundp 'buffer-substring-no-properties) (buffer-substring-no-properties begin (point)) @@ -8611,13 +9101,16 @@ (interactive) (start-process "idldeclient" nil idlwave-shell-explicit-file-name "-c" "-e" - (buffer-file-name) "&")) - + (buffer-file-name))) + +(defvar idlwave-help-use-assistant) (defun idlwave-launch-idlhelp () "Start the IDLhelp application." (interactive) - (start-process "idlhelp" nil idlwave-help-application)) - + (if idlwave-help-use-assistant + (idlwave-help-assistant-raise) + (start-process "idlhelp" nil idlwave-help-application))) + ;; Menus - using easymenu.el (defvar idlwave-mode-menu-def `("IDLWAVE" @@ -8636,8 +9129,10 @@ ["Block" idlwave-mark-block t] ["Header" idlwave-mark-doclib t]) ("Format" + ["Indent Entire Statement" idlwave-indent-statement + :active t :keys "C-u \\[indent-for-tab-command]" ] ["Indent Subprogram" idlwave-indent-subprogram t] - ["(Un)Comment Region" idlwave-toggle-comment-region "C-c ;"] + ["(Un)Comment Region" idlwave-toggle-comment-region t] ["Continue/Split line" idlwave-split-line t] "--" ["Toggle Auto Fill" idlwave-auto-fill-mode :style toggle @@ -8656,7 +9151,7 @@ ["Close Block" idlwave-close-block t]) ("Completion" ["Complete" idlwave-complete t] - ("Complete Special" + ("Complete Specific" ["1 Procedure Name" (idlwave-complete 'procedure) t] ["2 Procedure Keyword" (idlwave-complete 'procedure-keyword) t] "--" @@ -8678,6 +9173,7 @@ ["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)] "--" ["Update Routine Info" idlwave-update-routine-info t] + ["Rescan XML Help Catalog" idlwave-convert-xml-system-routine-info t] "--" "IDL User Catalog" ["Select Catalog Directories" (idlwave-create-user-catalog-file nil) t] @@ -8696,7 +9192,6 @@ ["Insert TAB character" idlwave-hard-tab t]) "--" ("External" - ["Generate IDL tags" idlwave-make-tags t] ["Start IDL shell" idlwave-shell t] ["Edit file in IDLDE" idlwave-edit-in-idlde t] ["Launch IDL Help" idlwave-launch-idlhelp t]) @@ -8704,7 +9199,7 @@ ("Customize" ["Browse IDLWAVE Group" idlwave-customize t] "--" - ["Build Full Customize Menu" idlwave-create-customize-menu + ["Build Full Customize Menu" idlwave-create-customize-menu (fboundp 'customize-menu-create)]) ("Documentation" ["Describe Mode" describe-mode t] @@ -8721,22 +9216,22 @@ '("Debug" ["Start IDL shell" idlwave-shell t] ["Save and .RUN buffer" idlwave-shell-save-and-run - (and (boundp 'idlwave-shell-automatic-start) + (and (boundp 'idlwave-shell-automatic-start) idlwave-shell-automatic-start)])) (if (or (featurep 'easymenu) (load "easymenu" t)) (progn - (easy-menu-define idlwave-mode-menu idlwave-mode-map - "IDL and WAVE CL editing menu" + (easy-menu-define idlwave-mode-menu idlwave-mode-map + "IDL and WAVE CL editing menu" idlwave-mode-menu-def) - (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map - "IDL and WAVE CL editing menu" + (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map + "IDL and WAVE CL editing menu" idlwave-mode-debug-menu-def))) (defun idlwave-customize () "Call the customize function with idlwave as argument." (interactive) - ;; Try to load the code for the shell, so that we can customize it + ;; Try to load the code for the shell, so that we can customize it ;; as well. (or (featurep 'idlw-shell) (load "idlw-shell" t)) @@ -8747,11 +9242,11 @@ (interactive) (if (fboundp 'customize-menu-create) (progn - ;; Try to load the code for the shell, so that we can customize it + ;; Try to load the code for the shell, so that we can customize it ;; as well. (or (featurep 'idlw-shell) (load "idlw-shell" t)) - (easy-menu-change + (easy-menu-change '("IDLWAVE") "Customize" `(["Browse IDLWAVE group" idlwave-customize t] "--" @@ -8799,7 +9294,7 @@ (let ((table (symbol-value 'idlwave-mode-abbrev-table)) abbrevs str rpl func fmt (len-str 0) (len-rpl 0)) - (mapatoms + (mapatoms (lambda (sym) (if (symbol-value sym) (progn @@ -8825,7 +9320,7 @@ (with-output-to-temp-buffer "*Help*" (if arg (progn - (princ "Abbreviations and Actions in IDLWAVE-Mode\n") + (princ "Abbreviations and Actions in IDLWAVE-Mode\n") (princ "=========================================\n\n") (princ (format fmt "KEY" "REPLACE" "HOOK")) (princ (format fmt "---" "-------" "----"))) @@ -8852,7 +9347,7 @@ ;; Will only work on systems which support this. (or idlwave-routines (idlwave-start-load-rinfo-timer)) -;;;###autoload(add-to-list 'auto-mode-alist '("\\.[Pp][Rr][Oo]\\'" . idlwave-mode)) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.[Pp][Rr][Oo]\\'" . idlwave-mode)) ;; Run the hook (run-hooks 'idlwave-load-hook)