Browse files

Major re-organization and cleanup.

Supporting files added:
   menus, routine, scan, variables, binding, and complete.
  • Loading branch information...
1 parent 8832087 commit 0dfa005130896fad1cd957b57820f172d0ffa3d9 @jdtsmith committed Jan 27, 2014
Showing with 8,314 additions and 8,373 deletions.
  1. +460 −0 idlw-bindings.el
  2. +949 −0 idlw-complete.el
  3. +0 −206 idlw-help.el
  4. +260 −0 idlw-menus.el
  5. +1,460 −0 idlw-routine.el
  6. +1,757 −0 idlw-scan.el
  7. +1,358 −0 idlw-variables.el
  8. +2,070 −8,167 idlwave.el
View
460 idlw-bindings.el
@@ -0,0 +1,460 @@
+;; IDLWAVE keyboard/mouse bindings, syntax tables, templates, and abbreviations.
+
+(fset 'idlwave-debug-map (make-sparse-keymap))
+
+;;----------------------------------------------------
+;; Keyboard bindings, in buffer
+(defvar idlwave-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c " 'idlwave-hard-tab)
+ (define-key map [(control tab)] 'idlwave-hard-tab)
+ ;;(define-key map "\C-c\C- " 'idlwave-hard-tab)
+ (define-key map "'" 'idlwave-show-matching-quote)
+ (define-key map "\"" 'idlwave-show-matching-quote)
+ (define-key map "\C-g" 'idlwave-keyboard-quit)
+ (define-key map "\C-c;" 'idlwave-toggle-comment-region)
+ (define-key map "\C-\M-a" 'idlwave-beginning-of-subprogram)
+ (define-key map "\C-\M-e" 'idlwave-end-of-subprogram)
+ (define-key map "\C-c{" 'idlwave-beginning-of-block)
+ (define-key map "\C-c}" 'idlwave-end-of-block)
+ (define-key map "\C-c]" 'idlwave-close-block)
+ (define-key map [(meta control h)] 'idlwave-mark-subprogram)
+ (define-key map "\M-\C-n" 'idlwave-forward-block)
+ (define-key map "\M-\C-p" 'idlwave-backward-block)
+ (define-key map "\M-\C-d" 'idlwave-down-block)
+ (define-key map "\M-\C-u" 'idlwave-backward-up-block)
+ (define-key map "\M-\r" 'idlwave-split-line)
+ (define-key map "\M-\C-q" 'idlwave-indent-subprogram)
+ (define-key map "\C-c\C-p" 'idlwave-previous-statement)
+ (define-key map "\C-c\C-n" 'idlwave-next-statement)
+ ;; (define-key map "\r" 'idlwave-newline)
+ ;; (define-key map "\t" 'idlwave-indent-line)
+ (define-key map [(shift iso-lefttab)] 'idlwave-indent-statement)
+ (define-key map "\C-c\C-a" 'idlwave-auto-fill-mode)
+ (define-key map "\M-q" 'idlwave-fill-paragraph)
+ (define-key map "\M-s" 'idlwave-edit-in-idlde)
+ (define-key map "\C-c\C-h" 'idlwave-doc-header)
+ (define-key map "\C-c\C-m" 'idlwave-doc-modification)
+ (define-key map "\C-c\C-c" 'idlwave-case)
+ (define-key map "\C-c\C-d" 'idlwave-debug-map)
+ (when (and (listp idlwave-shell-debug-modifiers)
+ (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 (copy-sequence idlwave-shell-debug-modifiers))))
+ (define-key map
+ (vector (append mods-noshift (list (if shift ?C ?c))))
+ 'idlwave-shell-save-and-run)
+ (define-key map
+ (vector (append mods-noshift (list (if shift ?B ?b))))
+ 'idlwave-shell-break-here)
+ (define-key map
+ (vector (append mods-noshift (list (if shift ?E ?e))))
+ 'idlwave-shell-run-region)))
+ (define-key map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run)
+ (define-key map "\C-c\C-d\C-b" 'idlwave-shell-break-here)
+ (define-key map "\C-c\C-d\C-e" 'idlwave-shell-run-region)
+ (define-key map "\C-c\C-f" 'idlwave-for)
+ ;; (define-key map "\C-c\C-f" 'idlwave-function)
+ ;; (define-key map "\C-c\C-p" 'idlwave-procedure)
+ (define-key map "\C-c\C-r" 'idlwave-repeat)
+ (define-key map "\C-c\C-w" 'idlwave-while)
+ (define-key map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers)
+ (define-key map "\C-c\C-s" 'idlwave-shell)
+ (define-key map "\C-c\C-l" 'idlwave-shell-recenter-shell-window)
+ (define-key map "\C-c\C-b" 'idlwave-list-buffer-load-path-shadows)
+ (define-key map "\C-c\C-v" 'idlwave-find-module)
+ (define-key map "\C-c\C-t" 'idlwave-find-module-this-file)
+ (define-key map "\C-c?" 'idlwave-routine-info)
+ (define-key map "\M-?" 'idlwave-context-help)
+ (define-key map [(control meta ?\?)]
+ 'idlwave-help-with-topic)
+ ;; Pickup both forms of Esc/Meta binding
+ (define-key map [(meta tab)] 'idlwave-complete)
+ (define-key map [?\e?\t] 'idlwave-complete)
+ (define-key map "\M-\C-i" 'idlwave-complete)
+ (define-key map "\C-c\C-i" 'idlwave-update-routine-info)
+ (define-key map "\C-c=" 'idlwave-resolve)
+ (define-key map
+ (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])
+ 'idlwave-mouse-context-help)
+ map)
+ "Keymap used in IDL mode.")
+
+;;----------------------------------------------------
+;; Keyboard bindings, in routine info window
+(defvar idlwave-rinfo-mouse-map (make-sparse-keymap))
+(defvar idlwave-rinfo-map (make-sparse-keymap))
+(define-key idlwave-rinfo-mouse-map
+ (if (featurep 'xemacs) [button2] [mouse-2])
+ 'idlwave-mouse-active-rinfo)
+(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
+ (if (featurep 'xemacs) [button3] [mouse-3])
+ 'idlwave-mouse-active-rinfo-right)
+(define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space)
+(define-key idlwave-rinfo-map "q" 'idlwave-quit-help)
+(define-key idlwave-rinfo-mouse-map "q" 'idlwave-quit-help)
+
+;;----------------------------------------------------
+;; Keyboard bindings, in source-help window
+(defvar idlwave-help-mode-map (make-sparse-keymap)
+ "The keymap used in idlwave-help-mode.")
+
+(define-key idlwave-help-mode-map "q" 'idlwave-help-quit)
+(define-key idlwave-help-mode-map "w" 'widen)
+(define-key idlwave-help-mode-map "\C-m" (lambda (arg)
+ (interactive "p")
+ (scroll-up arg)))
+(define-key idlwave-help-mode-map " " 'scroll-up)
+(define-key idlwave-help-mode-map [delete] 'scroll-down)
+(define-key idlwave-help-mode-map "h" 'idlwave-help-find-header)
+(define-key idlwave-help-mode-map "H" 'idlwave-help-find-first-header)
+(define-key idlwave-help-mode-map "." 'idlwave-help-toggle-header-match-and-def)
+(define-key idlwave-help-mode-map "F" 'idlwave-help-fontify)
+(define-key idlwave-help-mode-map "\M-?" 'idlwave-help-return-to-calling-frame)
+(define-key idlwave-help-mode-map "x" 'idlwave-help-return-to-calling-frame)
+
+
+;;----------------------------------------------------
+;; Keyboard utility callbacks
+(defun idlwave-keyboard-quit ()
+ (interactive)
+ (unwind-protect
+ (if (eq (car-safe last-command) 'idlwave-display-completion-list)
+ (idlwave-restore-wconf-after-completion))
+ (keyboard-quit)))
+
+
+;;----------------------------------------------------
+;; Syntax
+(defvar idlwave-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?+ "." st)
+ (modify-syntax-entry ?- "." st)
+ (modify-syntax-entry ?* "." st)
+ (modify-syntax-entry ?/ "." st)
+ (modify-syntax-entry ?^ "." st)
+ (modify-syntax-entry ?# "." st)
+ (modify-syntax-entry ?= "." st)
+ (modify-syntax-entry ?% "." st)
+ (modify-syntax-entry ?< "." st)
+ (modify-syntax-entry ?> "." st)
+ (modify-syntax-entry ?\' "\"" st)
+ (modify-syntax-entry ?\" "\"" st)
+ (modify-syntax-entry ?\\ "." st)
+ (modify-syntax-entry ?_ "_" st)
+ (modify-syntax-entry ?{ "(}" st)
+ (modify-syntax-entry ?} "){" st)
+ (modify-syntax-entry ?$ "_" st)
+ (modify-syntax-entry ?. "." st)
+ (modify-syntax-entry ?\; "<" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?\f ">" st)
+ st)
+ "Syntax table in use in `idlwave-mode' buffers.")
+
+(defvar idlwave-find-symbol-syntax-table
+ (let ((st (copy-syntax-table idlwave-mode-syntax-table)))
+ (modify-syntax-entry ?$ "w" st)
+ (modify-syntax-entry ?_ "w" st)
+ (modify-syntax-entry ?! "w" st)
+ (modify-syntax-entry ?. "w" st)
+ st)
+ "Syntax table that treats symbol characters as word characters.")
+
+(defmacro idlwave-with-special-syntax (&rest body)
+ "Execute BODY with a different syntax table."
+ `(let ((saved-syntax (syntax-table)))
+ (unwind-protect
+ (progn
+ (set-syntax-table idlwave-find-symbol-syntax-table)
+ ,@body)
+ (set-syntax-table saved-syntax))))
+
+;(defmacro idlwave-with-special-syntax1 (&rest body)
+; "Execute BODY with a different syntax table."
+; `(let ((saved-syntax (syntax-table)))
+; (unwind-protect
+; (progn
+; (set-syntax-table idlwave-find-symbol-syntax-table)
+; ,@body)
+; (set-syntax-table saved-syntax))))
+
+(defun idlwave-action-and-binding (key cmd &optional select)
+ "KEY and CMD are made into a key binding and an indent action.
+KEY is a string - same as for the `define-key' function. CMD is a
+function of no arguments or a list to be evaluated. CMD is bound to
+KEY in `idlwave-mode-map' by defining an anonymous function calling
+`self-insert-command' followed by CMD. If KEY contains more than one
+character a binding will only be set if SELECT is 'both.
+
+\(KEY . CMD\) is also placed in the `idlwave-indent-expand-table',
+replacing any previous value for KEY. If a binding is not set then it
+will instead be placed in `idlwave-indent-action-table'.
+
+If the optional argument SELECT is nil then an action and binding are
+created. If SELECT is 'noaction, then a binding is always set and no
+action is created. If SELECT is 'both then an action and binding
+will both be created even if KEY contains more than one character.
+Otherwise, if SELECT is non-nil then only an action is created.
+
+Some examples:
+No spaces before and 1 after a comma
+ (idlwave-action-and-binding \",\" '(idlwave-surround 0 1))
+A minimum of 1 space before and after `=' (see `idlwave-expand-equal').
+ (idlwave-action-and-binding \"=\" '(idlwave-expand-equal -1 -1))
+Capitalize system variables - action only
+ (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t)"
+ (if (not (equal select 'noaction))
+ ;; Add action
+ (let* ((table (if select 'idlwave-indent-action-table
+ 'idlwave-indent-expand-table))
+ (table-key (regexp-quote key))
+ (cell (assoc table-key (eval table))))
+ (if cell
+ ;; Replace action command
+ (setcdr cell cmd)
+ ;; New action
+ (set table (append (eval table) (list (cons table-key cmd)))))))
+ ;; Make key binding for action
+ (if (or (and (null select) (= (length key) 1))
+ (equal select 'noaction)
+ (equal select 'both))
+ (define-key idlwave-mode-map key
+ `(lambda ()
+ (interactive)
+ (self-insert-command 1)
+ ,(if (listp cmd) cmd (list cmd))))))
+
+;; Set action and key bindings.
+;; See description of the function `idlwave-action-and-binding'.
+;; Automatically add spaces for the following characters
+
+;; 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))
+
+
+;;----------------------------------------------------
+;; Abbreviations
+;;
+;; When expanding abbrevs and the abbrev hook moves backward, an extra
+;; space is inserted (this is the space typed by the user to expanded
+;; the abbrev).
+;;
+(defvar idlwave-mode-abbrev-table nil
+ "Abbreviation table used for IDLWAVE mode.")
+(define-abbrev-table 'idlwave-mode-abbrev-table ())
+
+(defun idlwave-check-abbrev (arg &optional reserved)
+ "Reverse abbrev expansion if in comment or string.
+Argument ARG is the number of characters to move point
+backward if `idlwave-abbrev-move' is non-nil.
+If optional argument RESERVED is non-nil then the expansion
+consists of reserved words, which will be capitalized if
+`idlwave-reserved-word-upcase' is non-nil.
+Otherwise, the abbrev will be capitalized if `idlwave-abbrev-change-case'
+is non-nil, unless its value is \`down in which case the abbrev will be
+made into all lowercase.
+Returns non-nil if abbrev is left expanded."
+ (if (idlwave-quoted)
+ (progn (unexpand-abbrev)
+ nil)
+ (if (and reserved idlwave-reserved-word-upcase)
+ (upcase-region last-abbrev-location (point))
+ (cond
+ ((equal idlwave-abbrev-change-case 'down)
+ (downcase-region last-abbrev-location (point)))
+ (idlwave-abbrev-change-case
+ (upcase-region last-abbrev-location (point)))))
+ (if (and idlwave-abbrev-move (> arg 0))
+ (if (boundp 'post-command-hook)
+ (setq idlwave-command-hook (list 'backward-char (1+ arg)))
+ (backward-char arg)))
+ t))
+
+(defun idlwave-define-abbrev (name expansion hook &optional noprefix table)
+ "Define-abbrev with backward compatibility.
+
+If NOPREFIX is non-nil, don't prepend prefix character. Installs into
+`idlwave-mode-abbrev-table' unless TABLE is non-nil."
+ (let ((abbrevs-changed nil) ;; mask the current value to avoid save
+ (args (list (or table idlwave-mode-abbrev-table)
+ (if noprefix name (concat idlwave-abbrev-start-char name))
+ expansion
+ hook)))
+ (condition-case nil
+ (apply 'define-abbrev (append args '(0 t)))
+ (error (apply 'define-abbrev args)))))
+
+(defun idlwave-expand-region-abbrevs (start end)
+ "Expand each abbrev occurrence in the region.
+Calling from a program, arguments are START END."
+ (interactive "r")
+ (save-excursion
+ (goto-char (min start end))
+ (let ((idlwave-show-block nil) ;Do not blink
+ (idlwave-abbrev-move nil)) ;Do not move
+ (expand-region-abbrevs start end 'noquery))))
+
+(defmacro idlwave-keyword-abbrev (&rest args)
+ "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args."
+ `(quote (lambda ()
+ ,(append '(idlwave-check-abbrev) args))))
+
+;; If I take the time I can replace idlwave-keyword-abbrev with
+;; idlwave-code-abbrev and remove the quoted abbrev check from
+;; idlwave-check-abbrev. Then, e.g, (idlwave-keyword-abbrev 0 t) becomes
+;; (idlwave-code-abbrev idlwave-check-abbrev 0 t). In fact I should change
+;; the name of idlwave-check-abbrev to something like idlwave-modify-abbrev.
+
+(defmacro idlwave-code-abbrev (&rest args)
+ "Creates a function for abbrev hooks that ensures abbrevs are not quoted.
+Specifically, if the abbrev is in a comment or string it is unexpanded.
+Otherwise ARGS forms a list that is evaluated."
+ ;; FIXME: it would probably be better to rely on the new :enable-function
+ ;; to enforce the "don't expand in comments or strings".
+ `(lambda ()
+ ,(prin1-to-string args) ;; Puts the code in the doc string
+ (if (idlwave-quoted)
+ (progn (unexpand-abbrev) nil)
+ ,(append args))))
+
+
+(condition-case nil
+ (modify-syntax-entry (string-to-char idlwave-abbrev-start-char)
+ "w" idlwave-mode-syntax-table)
+ (error nil))
+
+
+;;----------------------------------------------------
+;; Templates
+
+(idlwave-define-abbrev "c" "" (idlwave-code-abbrev idlwave-case))
+(idlwave-define-abbrev "sw" "" (idlwave-code-abbrev idlwave-switch))
+(idlwave-define-abbrev "f" "" (idlwave-code-abbrev idlwave-for))
+(idlwave-define-abbrev "fe" "" (idlwave-code-abbrev idlwave-foreach))
+(idlwave-define-abbrev "fu" "" (idlwave-code-abbrev idlwave-function))
+(idlwave-define-abbrev "pr" "" (idlwave-code-abbrev idlwave-procedure))
+(idlwave-define-abbrev "r" "" (idlwave-code-abbrev idlwave-repeat))
+(idlwave-define-abbrev "w" "" (idlwave-code-abbrev idlwave-while))
+(idlwave-define-abbrev "i" "" (idlwave-code-abbrev idlwave-if))
+(idlwave-define-abbrev "elif" "" (idlwave-code-abbrev idlwave-elif))
+;;
+;; Keywords, system functions, conversion routines
+;;
+(idlwave-define-abbrev "ap" "arg_present()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "b" "begin" (idlwave-keyword-abbrev 0 t))
+(idlwave-define-abbrev "co" "common" (idlwave-keyword-abbrev 0 t))
+(idlwave-define-abbrev "cb" "byte()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "cx" "fix()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "cl" "long()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "cf" "float()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "cs" "string()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "cc" "complex()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "cd" "double()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "e" "else" (idlwave-keyword-abbrev 0 t))
+(idlwave-define-abbrev "ec" "endcase" 'idlwave-show-begin)
+(idlwave-define-abbrev "es" "endswitch" 'idlwave-show-begin)
+(idlwave-define-abbrev "ee" "endelse" 'idlwave-show-begin)
+(idlwave-define-abbrev "ef" "endfor" 'idlwave-show-begin)
+(idlwave-define-abbrev "ei" "endif else if" 'idlwave-show-begin)
+(idlwave-define-abbrev "el" "endif else" 'idlwave-show-begin)
+(idlwave-define-abbrev "en" "endif" 'idlwave-show-begin)
+(idlwave-define-abbrev "er" "endrep" 'idlwave-show-begin)
+(idlwave-define-abbrev "ew" "endwhile" 'idlwave-show-begin)
+(idlwave-define-abbrev "g" "goto," (idlwave-keyword-abbrev 0 t))
+(idlwave-define-abbrev "h" "help," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "k" "keyword_set()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "n" "n_elements()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "on" "on_error," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "oi" "on_ioerror," (idlwave-keyword-abbrev 0 1))
+(idlwave-define-abbrev "ow" "openw," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "or" "openr," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "ou" "openu," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "p" "print," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "pt" "plot," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "re" "read," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "rf" "readf," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "ru" "readu," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "rt" "return" (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "sc" "strcompress()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "sn" "strlen()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "sl" "strlowcase()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "su" "strupcase()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "sm" "strmid()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "sp" "strpos()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "st" "strput()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "sr" "strtrim()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "t" "then" (idlwave-keyword-abbrev 0 t))
+(idlwave-define-abbrev "u" "until" (idlwave-keyword-abbrev 0 t))
+(idlwave-define-abbrev "wu" "writeu," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "iap" "if arg_present() then" (idlwave-keyword-abbrev 6))
+(idlwave-define-abbrev "ik" "if keyword_set() then" (idlwave-keyword-abbrev 6))
+(idlwave-define-abbrev "ine" "if n_elements() eq 0 then" (idlwave-keyword-abbrev 11))
+(idlwave-define-abbrev "inn" "if n_elements() ne 0 then" (idlwave-keyword-abbrev 11))
+(idlwave-define-abbrev "np" "n_params()" (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "s" "size()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0))
+(idlwave-define-abbrev "pv" "ptr_valid()" (idlwave-keyword-abbrev 1))
+(idlwave-define-abbrev "ipv" "if ptr_valid() then" (idlwave-keyword-abbrev 6))
+
+;; This section is reserved words only. (From IDL user manual)
+;;
+(idlwave-define-abbrev "and" "and" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "begin" "begin" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "break" "break" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "case" "case" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "common" "common" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "continue" "continue" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "do" "do" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "else" "else" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "end" "end" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endcase" "endcase" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endelse" "endelse" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endfor" "endfor" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endforeach" "endforeach" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endif" "endif" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endrep" "endrep" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endswitch" "endswitch" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endwhi" "endwhi" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endwhile" "endwhile" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "eq" "eq" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "for" "for" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "function" "function" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "ge" "ge" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "goto" "goto" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "gt" "gt" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "if" "if" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "le" "le" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "lt" "lt" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "mod" "mod" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "ne" "ne" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "not" "not" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "of" "of" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "on_ioerror" "on_ioerror" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "or" "or" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "pro" "pro" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "repeat" "repeat" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "switch" "switch" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "then" "then" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "until" "until" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "while" "while" (idlwave-keyword-abbrev 0 t) t)
+(idlwave-define-abbrev "xor" "xor" (idlwave-keyword-abbrev 0 t) t)
+
+(provide 'idlw-bindings)
+(provide 'idlwave-bindings)
View
949 idlw-complete.el
@@ -0,0 +1,949 @@
+;; IDLWAVE code for completion
+
+;; ---------------------------------------------------------------------------
+;;
+;; Completion and displaying routine calling sequences
+
+;;----------------------------------------------------
+;; Internal variables
+(defvar idlwave-completion-help-info nil
+ "Global variable passing information for invoking help during completions.
+Format: (what name type class kwd super-classes)"
+)
+(defvar idlwave-completion-help-links nil)
+(defvar idlwave-current-obj_new-class nil)
+(defvar idlwave-complete-special nil)
+(defvar method-selector)
+(defvar class-selector)
+(defvar type-selector)
+(defvar super-classes)
+(defvar idlwave-before-completion-wconf nil
+ "The window configuration just before the completion buffer was displayed.")
+(defvar idlwave-complete-special nil
+ "List of special completion functions.
+These functions are called for each completion. Each function must
+check if its own special completion context is present. If yes, it
+should use `idlwave-complete-in-buffer' to do some completion and
+return t. If such a function returns t, *no further* attempts to
+complete other contexts will be done. If the function returns nil,
+other completions will be tried.")
+(defvar idlwave-complete-after-success-form nil
+ "A form to evaluate after successful completion.")
+(defvar idlwave-complete-after-success-form-force nil
+ "A form to evaluate after completion selection in *Completions* buffer.")
+(defconst idlwave-completion-mark (make-marker)
+ "A mark pointing to the beginning of the completion string.")
+(defvar completion-highlight-first-word-only) ;XEmacs.
+(defvar idlwave-completion-setup-hook nil)
+
+;;----------------------------------------------------
+;; General Completion system
+
+(defun idlwave-complete (&optional arg module class)
+ "Complete a function, procedure (method) or keyword name at point.
+This function is smart and figures out what can be completed at
+this point. Extensions are supported.
+
+- At the beginning of a statement it completes procedure names.
+- In the middle of a statement it completes function names.
+- After a `(' or `,' in the argument list of a function or procedure,
+ it completes a keyword of the relevant function or procedure.
+- In the first arg of `OBJ_NEW', it completes a class name.
+
+When several completions are possible, a list will be displayed in
+the *Completions* buffer. If this list is too long to fit into the
+window, scrolling can be achieved by repeatedly pressing
+\\[idlwave-complete].
+
+The function also knows about object methods. When it needs a class
+name, the action depends upon `idlwave-query-class', which see. You
+can force IDLWAVE to ask you for a class name with a
+\\[universal-argument] prefix argument to this command.
+
+See also the customizable variables
+`idlwave-keyword-completion-adds-equal' and
+`idlwave-function-completion-adds-paren'.
+
+The optional ARG can be used to force the completion type in order
+to override IDLWAVE's idea of what should be completed at point.
+Possible values are:
+
+0 <=> query for the completion type
+1 <=> 'procedure
+2 <=> 'procedure-keyword
+3 <=> 'function
+4 <=> 'function-keyword
+5 <=> 'procedure-method
+6 <=> 'procedure-method-keyword
+7 <=> 'function-method
+8 <=> 'function-method-keyword
+9 <=> 'class
+
+As a special case, the universal argument C-u forces completion
+of function names in places where the default would be, e.g., a
+keyword.
+
+Two prefix argument, C-u C-u, prompts for a regexp by which to
+limit completion list, limited to the list of completions which
+would have been generated.
+
+For Lisp programmers only:
+When we force a keyword, optional argument MODULE can contain the module name.
+When we force a method or a method keyword, CLASS can specify the class."
+ (interactive "P")
+ (idlwave-routines)
+ (let* ((where-list
+ (if (and arg
+ (or (and (integerp arg) (not (equal arg '(16))))
+ (symbolp arg)))
+ ;; Force the idea of "where" we are
+ (idlwave-make-force-complete-where-list arg module class)
+ (idlwave-where)))
+ (what (nth 2 where-list))
+ (idlwave-force-class-query (equal arg '(4)))
+ (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))))
+
+ (cond
+
+ ((and (null arg)
+ (eq (car-safe last-command) 'idlwave-display-completion-list)
+ (get-buffer-window "*Completions*"))
+ (setq this-command last-command)
+ (idlwave-scroll-completions))
+
+ ;; Complete a filename in quotes
+ ((and (idlwave-in-quote)
+ (not (eq what 'class)))
+ (idlwave-complete-filename))
+
+ ;; Check for any special completion functions
+ ((and idlwave-complete-special
+ (idlwave-call-special idlwave-complete-special)))
+
+ ((null what)
+ (error "Nothing to complete here"))
+
+ ;; Complete a class
+ ((eq what 'class)
+ (setq idlwave-completion-help-info '(class))
+ (idlwave-complete-class))
+
+ ((eq what 'procedure)
+ ;; Complete a procedure name
+ (let* ((cw-list (nth 3 where-list))
+ (class-selector (idlwave-determine-class cw-list 'pro))
+ (super-classes (unless (idlwave-explicit-class-listed cw-list)
+ (idlwave-all-class-inherits class-selector)))
+ (isa (concat "procedure" (if class-selector "-method" "")))
+ (type-selector 'pro))
+ (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)
+ (idlwave-routines) 'idlwave-selector
+ (format "Select a %s name%s"
+ isa
+ (if class-selector
+ (format " (class is %s)"
+ (if (eq class-selector t)
+ "unknown" class-selector))
+ ""))
+ isa
+ 'idlwave-attach-method-classes 'idlwave-add-file-link-selector)))
+
+ ((eq what 'function)
+ ;; Complete a function name
+ (let* ((cw-list (nth 3 where-list))
+ (class-selector (idlwave-determine-class cw-list 'fun))
+ (super-classes (unless (idlwave-explicit-class-listed cw-list)
+ (idlwave-all-class-inherits class-selector)))
+ (isa (concat "function" (if class-selector "-method" "")))
+ (type-selector 'fun))
+ (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)
+ (idlwave-routines) 'idlwave-selector
+ (format "Select a %s name%s"
+ isa
+ (if class-selector
+ (format " (class is %s)"
+ (if (eq class-selector t)
+ "unknown" class-selector))
+ ""))
+ isa
+ 'idlwave-attach-method-classes 'idlwave-add-file-link-selector)))
+
+ ((and (memq what '(procedure-keyword function-keyword)) ; Special Case
+ (equal arg '(4)))
+ (idlwave-complete 3))
+
+ ((eq what 'procedure-keyword)
+ ;; Complete a procedure keyword
+ (let* ((where (nth 3 where-list))
+ (name (car where))
+ (method-selector name)
+ (type-selector 'pro)
+ (class (idlwave-determine-class where 'pro))
+ (class-selector class)
+ (super-classes (idlwave-all-class-inherits class-selector))
+ (isa (format "procedure%s-keyword" (if class "-method" "")))
+ (entry (idlwave-best-rinfo-assq
+ name 'pro class (idlwave-routines)))
+ (system (if entry (eq (car (nth 3 entry)) 'system)))
+ (list (idlwave-entry-keywords entry 'do-link)))
+ (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
+ super-classes system))
+ (unless list (error "No keywords available for procedure %s"
+ (idlwave-make-full-name class name)))
+ (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))
+ " (note _EXTRA)" ""))
+ isa
+ 'idlwave-attach-keyword-classes)))
+
+ ((eq what 'function-keyword)
+ ;; Complete a function keyword
+ (let* ((where (nth 3 where-list))
+ (name (car where))
+ (method-selector name)
+ (type-selector 'fun)
+ (class (idlwave-determine-class where 'fun))
+ (class-selector class)
+ (super-classes (idlwave-all-class-inherits class-selector))
+ (isa (format "function%s-keyword" (if class "-method" "")))
+ (entry (idlwave-best-rinfo-assq
+ name 'fun class (idlwave-routines)))
+ (system (if entry (eq (car (nth 3 entry)) 'system)))
+ (list (idlwave-entry-keywords entry 'do-link))
+ msg-name)
+ (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
+ super-classes system))
+ ;; OBJ_NEW: Messages mention the proper Init method
+ (setq msg-name (if (and (null class)
+ (string= (upcase name) "OBJ_NEW"))
+ (concat idlwave-current-obj_new-class
+ "::Init (via OBJ_NEW)")
+ (idlwave-make-full-name class name)))
+ (unless list (error "No keywords available for function %s"
+ msg-name))
+ (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))
+ " (note _EXTRA)" ""))
+ isa
+ 'idlwave-attach-keyword-classes)))
+
+ (t (error "This should not happen (idlwave-complete)")))))
+
+(defun idlwave-complete-in-buffer (type stype list selector prompt isa
+ &optional prepare-display-function
+ special-selector)
+ "Perform TYPE completion of word before point against LIST.
+SELECTOR is the PREDICATE argument for the completion function. Show
+PROMPT in echo area. TYPE is one of the intern types, e.g. 'function,
+'procedure, 'class-tag, 'keyword, 'sysvar, etc. SPECIAL-SELECTOR is
+used only once, for `all-completions', and can be used to, e.g.,
+accumulate information on matching completions."
+ (let* ((completion-ignore-case t)
+ beg (end (point)) slash part spart completion all-completions
+ dpart dcompletion)
+
+ (unless list
+ (error (concat prompt ": No completions available")))
+
+ ;; What is already in the buffer?
+ (save-excursion
+ (skip-chars-backward "a-zA-Z0-9_$")
+ (setq slash (eq (preceding-char) ?/)
+ beg (point)
+ idlwave-complete-after-success-form
+ (list 'idlwave-after-successful-completion
+ (list 'quote type) slash beg)
+ idlwave-complete-after-success-form-force
+ (list 'idlwave-after-successful-completion
+ (list 'quote type) slash (list 'quote 'force))))
+
+ ;; Try a completion
+ (setq part (buffer-substring beg end)
+ dpart (downcase part)
+ spart (idlwave-sintern stype part)
+ completion (try-completion part list selector)
+ dcompletion (if (stringp completion) (downcase completion))
+ idlwave-completion-help-links nil)
+ (cond
+ ((null completion)
+ ;; nothing available.
+ (error (concat prompt ": no completion for \"%s\"") part))
+ ((and (not (equal dpart dcompletion))
+ (not (eq t completion)))
+ ;; We can add something
+ (delete-region beg end)
+ (insert (if (and (string= part dpart)
+ (or (not (string= part ""))
+ idlwave-complete-empty-string-as-lower-case)
+ (not idlwave-completion-force-default-case))
+ dcompletion
+ completion))
+ (if (eq t (try-completion completion list selector))
+ ;; Now this is a unique match
+ (idlwave-after-successful-completion type slash beg))
+ t)
+ ((or (eq completion t)
+ (and (= 1 (length (setq all-completions
+ (idlwave-uniquify
+ (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
+ ;; We cannot add something - offer a list.
+ (message "Making completion list...")
+
+ (unless idlwave-completion-help-links ; already set somewhere?
+ (mapc (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)
+ idlwave-completion-help-links))))
+ list))
+ (let* ((list all-completions)
+ ;; "complete" means, this is already a valid completion
+ (complete (memq spart all-completions))
+ (completion-highlight-first-word-only t)) ; XEmacs
+ ;; (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
+ (setq list (funcall prepare-display-function list)))
+ (if (and (string= part dpart)
+ (or (not (string= part ""))
+ idlwave-complete-empty-string-as-lower-case)
+ (not idlwave-completion-force-default-case))
+ (setq list (mapcar (lambda (x)
+ (if (listp x)
+ (setcar x (downcase (car x)))
+ (setq x (downcase x)))
+ x)
+ list)))
+ (idlwave-display-completion-list list prompt beg complete))
+ t))))
+
+(defun idlwave-scroll-completions (&optional message)
+ "Scroll the completion window on this frame."
+ (let ((cwin (get-buffer-window "*Completions*" 'visible))
+ (win (selected-window)))
+ (unwind-protect
+ (progn
+ (select-window cwin)
+ (condition-case nil
+ (scroll-up)
+ (error (if (and (listp last-command)
+ (nth 2 last-command))
+ (progn
+ (select-window win)
+ (eval idlwave-complete-after-success-form))
+ (set-window-start cwin (point-min)))))
+ (and message (message "%s" message)))
+ (select-window win))))
+
+(defun idlwave-display-completion-list (list &optional message beg complete)
+ "Display the completions in LIST in the completions buffer and echo MESSAGE."
+ (unless (and (get-buffer-window "*Completions*")
+ (idlwave-local-value 'idlwave-completion-p "*Completions*"))
+ (move-marker idlwave-completion-mark beg)
+ (setq idlwave-before-completion-wconf (current-window-configuration)))
+
+ (idlwave-display-completion-list-emacs list)
+
+ ;; Store a special value in `this-command'. When `idlwave-complete'
+ ;; finds this in `last-command', it will scroll the *Completions* buffer.
+ (setq this-command (list 'idlwave-display-completion-list message complete))
+
+ ;; Mark the completions buffer as created by cib
+ (idlwave-set-local 'idlwave-completion-p t "*Completions*")
+
+ ;; Fontify the classes
+ (if (and idlwave-completion-fontify-classes
+ (consp (car list)))
+ (idlwave-completion-fontify-classes))
+
+ ;; Run the hook
+ (run-hooks 'idlwave-completion-setup-hook)
+
+ ;; Display the message
+ (message "%s" (or message "Making completion list...done")))
+
+(defun idlwave-add-file-link-selector (a)
+ ;; Record a file link, if any, for the tested names during selection.
+ (let ((sel (idlwave-selector a)) file)
+ (if (and sel (setq file (idlwave-entry-has-help a)))
+ (push (cons (car a) file) idlwave-completion-help-links))
+ sel))
+
+(defun idlwave-after-successful-completion (type slash &optional verify)
+ "Add `=' or `(' after successful completion of keyword and function.
+Restore the pre-completion window configuration if possible."
+ (cond
+ ((eq type 'procedure)
+ nil)
+ ((eq type 'function)
+ (cond
+ ((equal idlwave-function-completion-adds-paren nil) nil)
+ ((or (equal idlwave-function-completion-adds-paren t)
+ (equal idlwave-function-completion-adds-paren 1))
+ (insert "("))
+ ((equal idlwave-function-completion-adds-paren 2)
+ (insert "()")
+ (backward-char 1))
+ (t nil)))
+ ((eq type 'keyword)
+ (if (and idlwave-keyword-completion-adds-equal
+ (not slash))
+ (progn (insert "=") t)
+ nil)))
+
+ ;; Restore the pre-completion window configuration if this is safe.
+ (if (or (eq verify 'force) ; force
+ (and
+ (get-buffer-window "*Completions*") ; visible
+ (idlwave-local-value 'idlwave-completion-p
+ "*Completions*") ; cib-buffer
+ (eq (marker-buffer idlwave-completion-mark)
+ (current-buffer)) ; buffer OK
+ (equal (marker-position idlwave-completion-mark)
+ verify))) ; pos OK
+ (idlwave-restore-wconf-after-completion))
+ (move-marker idlwave-completion-mark nil)
+ (setq idlwave-before-completion-wconf nil))
+
+(defun idlwave-make-force-complete-where-list (what &optional module class)
+ ;; Return an artificial WHERE specification to force the completion
+ ;; routine to complete a specific item independent of context.
+ ;; WHAT is the prefix arg of `idlwave-complete', see there for details.
+ ;; MODULE and CLASS can be used to specify the routine name and class.
+ ;; The class name will also be found in MODULE if that is like "class::mod".
+ (let* ((what-list '(("procedure") ("procedure-keyword")
+ ("function") ("function-keyword")
+ ("procedure-method") ("procedure-method-keyword")
+ ("function-method") ("function-method-keyword")
+ ("class")))
+ (module (idlwave-sintern-routine-or-method module class))
+ (class (idlwave-sintern-class class))
+ (what (cond
+ ((equal what 0)
+ (setq what
+ (intern (completing-read
+ "Complete what? " what-list nil t))))
+ ((integerp what)
+ (setq what (intern (car (nth (1- what) what-list)))))
+ ((and what
+ (symbolp what)
+ (assoc (symbol-name what) what-list))
+ what)
+ (t (error "Invalid WHAT"))))
+ (nil-list '(nil nil nil nil))
+ (class-list (list nil nil (or class t) nil)))
+
+ (cond
+
+ ((eq what 'procedure)
+ (list nil-list nil-list 'procedure nil-list nil))
+
+ ((eq what 'procedure-keyword)
+ (let* ((class-selector nil)
+ (super-classes nil)
+ (type-selector 'pro)
+ (pro (or module
+ (idlwave-completing-read
+ "Procedure: " (idlwave-routines) 'idlwave-selector))))
+ (setq pro (idlwave-sintern-routine pro))
+ (list nil-list nil-list 'procedure-keyword
+ (list pro nil nil nil) nil)))
+
+ ((eq what 'function)
+ (list nil-list nil-list 'function nil-list nil))
+
+ ((eq what 'function-keyword)
+ (let* ((class-selector nil)
+ (super-classes nil)
+ (type-selector 'fun)
+ (func (or module
+ (idlwave-completing-read
+ "Function: " (idlwave-routines) 'idlwave-selector))))
+ (setq func (idlwave-sintern-routine func))
+ (list nil-list nil-list 'function-keyword
+ (list func nil nil nil) nil)))
+
+ ((eq what 'procedure-method)
+ (list nil-list nil-list 'procedure class-list nil))
+
+ ((eq what 'procedure-method-keyword)
+ (let* ((class (idlwave-determine-class class-list 'pro))
+ (class-selector class)
+ (super-classes (idlwave-all-class-inherits class-selector))
+ (type-selector 'pro)
+ (pro (or module
+ (idlwave-completing-read
+ (format "Procedure in %s class: " class-selector)
+ (idlwave-routines) 'idlwave-selector))))
+ (setq pro (idlwave-sintern-method pro))
+ (list nil-list nil-list 'procedure-keyword
+ (list pro nil class nil) nil)))
+
+ ((eq what 'function-method)
+ (list nil-list nil-list 'function class-list nil))
+
+ ((eq what 'function-method-keyword)
+ (let* ((class (idlwave-determine-class class-list 'fun))
+ (class-selector class)
+ (super-classes (idlwave-all-class-inherits class-selector))
+ (type-selector 'fun)
+ (func (or module
+ (idlwave-completing-read
+ (format "Function in %s class: " class-selector)
+ (idlwave-routines) 'idlwave-selector))))
+ (setq func (idlwave-sintern-method func))
+ (list nil-list nil-list 'function-keyword
+ (list func nil class nil) nil)))
+
+ ((eq what 'class)
+ (list nil-list nil-list 'class nil-list nil))
+
+ (t (error "Invalid value for WHAT")))))
+
+(defun idlwave-call-special (functions &rest args)
+ (let ((funcs functions)
+ fun ret)
+ (catch 'exit
+ (while (setq fun (pop funcs))
+ (if (setq ret (apply fun args))
+ (throw 'exit ret)))
+ nil)))
+
+(defun idlwave-completing-read (&rest args)
+ ;; Completing read, case insensitive
+ (let ((old-value (default-value 'completion-ignore-case)))
+ (unwind-protect
+ (progn
+ (setq-default completion-ignore-case t)
+ (apply 'completing-read args))
+ (setq-default completion-ignore-case old-value))))
+
+(defun idlwave-choose (function &rest args)
+ "Call FUNCTION as a completion chooser and pass ARGS to it."
+ (let ((completion-ignore-case t)) ; install correct value
+ (apply function args))
+ (if (and (eq major-mode 'idlwave-shell-mode)
+ (boundp 'font-lock-mode)
+ (not font-lock-mode))
+ ;; For the shell, remove the fontification of the word before point
+ (let ((beg (save-excursion
+ (skip-chars-backward "a-zA-Z0-9_")
+ (point))))
+ (remove-text-properties beg (point) '(face nil))))
+ (eval idlwave-complete-after-success-form-force))
+
+(defun idlwave-choose-completion (&rest args)
+ "Choose the completion that point is in or next to."
+ (interactive)
+ (apply 'idlwave-choose 'choose-completion args))
+
+;;----------------------------------------------------
+;; Mouse/Interaction/Fontification
+
+(defvar idlwave-completion-map nil
+ "Keymap for `completion-list-mode' with `idlwave-complete'.")
+
+(defun idlwave-default-choose-completion (&rest args)
+ "Execute `default-choose-completion' and then restore the win-conf."
+ (apply 'idlwave-choose 'default-choose-completion args))
+
+(defun idlwave-display-completion-list-emacs (list)
+ "Display completion list and install the choose wrappers."
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list list))
+ (with-current-buffer "*Completions*"
+ (use-local-map
+ (or idlwave-completion-map
+ (setq idlwave-completion-map
+ (idlwave-make-modified-completion-map-emacs
+ (current-local-map)))))))
+
+(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
+ 'choose-completion 'idlwave-choose-completion new-map)
+ (substitute-key-definition
+ 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map)
+ (define-key new-map [mouse-3] 'idlwave-mouse-completion-help)
+ new-map))
+
+(defun idlwave-mouse-choose-completion (&rest args)
+ "Click on an alternative in the `*Completions*' buffer to choose it."
+ (interactive "e")
+ (apply 'idlwave-choose 'mouse-choose-completion args))
+
+(defun idlwave-restore-wconf-after-completion ()
+ "Restore the old (before completion) window configuration."
+ (and idlwave-completion-restore-window-configuration
+ idlwave-before-completion-wconf
+ (set-window-configuration idlwave-before-completion-wconf)))
+
+(defun idlwave-completion-fontify-classes ()
+ "Goto the *Completions* buffer and fontify the class info."
+ (when (featurep 'font-lock)
+ (with-current-buffer "*Completions*"
+ (save-excursion
+ (goto-char (point-min))
+ (let ((buffer-read-only nil))
+ (while (re-search-forward "\\.*<[^>]+>" nil t)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face 'font-lock-string-face)))))))
+
+
+;;----------------------------------------------------
+;; Filenames
+
+(defvar idlwave-shell-default-directory)
+(defun idlwave-complete-filename ()
+ "Use the comint stuff to complete a file name."
+ (require 'comint)
+ (let* ((comint-file-name-chars "~/A-Za-z0-9+@:_.$#%={}\\-")
+ (comint-completion-addsuffix nil)
+ (default-directory
+ (if (and (boundp 'idlwave-shell-default-directory)
+ (stringp idlwave-shell-default-directory)
+ (file-directory-p idlwave-shell-default-directory))
+ idlwave-shell-default-directory
+ default-directory)))
+ (comint-dynamic-complete-filename)))
+
+;;----------------------------------------------------
+;; Classes
+
+(defun idlwave-complete-class ()
+ "Complete a class at point."
+ (interactive)
+ ;; Call `idlwave-routines' to make sure the class list will be available
+ (idlwave-routines)
+ ;; Check for the special case of completing empty string after pro/function
+ (if (let ((case-fold-search t))
+ (save-excursion
+ (and
+ (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\="
+ (- (point) 15) t)
+ (goto-char (point-min))
+ (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
+ "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)
+ idlwave-completion-help-links))
+ x))
+ list)))))
+
+;; Completion selector/predicate function
+(defun idlwave-selector (a)
+ (and (eq (nth 1 a) type-selector)
+ (or (and (nth 2 a) (eq class-selector t))
+ (eq (nth 2 a) class-selector)
+ (memq (nth 2 a) super-classes))))
+
+(defun idlwave-attach-classes (list type show-classes)
+ ;; Attach the proper class list to a LIST of completion items.
+ ;; TYPE, when 'kwd, shows classes for method keywords, when
+ ;; 'class-tag, for class tags, and otherwise for methods.
+ ;; 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
+ (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
+ list
+ (let* ((do-prop (and (>= show-classes 0)
+ (>= emacs-major-version 21)))
+ (do-buf (not (= show-classes 0)))
+ ;; (do-dots (featurep 'xemacs))
+ (do-dots t)
+ (inherit (if (and (not (eq type 'class-tag)) super-classes)
+ (cons class-selector super-classes)))
+ (max (abs show-classes))
+ (lmax (if do-dots (apply 'max (mapcar 'length list))))
+ classes nclasses class-info space)
+ (mapcar
+ (lambda (x)
+ ;; get the classes
+ (if (eq type 'class-tag)
+ ;; Just one class for tags
+ (setq classes
+ (list
+ (idlwave-class-or-superclass-with-tag class-selector x)))
+ ;; Multiple classes for method or method-keyword
+ (setq classes
+ (if (eq type 'kwd)
+ (idlwave-all-method-keyword-classes
+ method-selector x type-selector)
+ (idlwave-all-method-classes x type-selector)))
+ (if inherit
+ (setq classes
+ (delq nil
+ (mapcar (lambda (x) (if (memq x inherit) x nil))
+ classes)))))
+ (setq nclasses (length classes))
+ ;; Make the separator between item and class-info
+ (if do-dots
+ (setq space (concat " " (make-string (- lmax (length x)) ?.)))
+ (setq space " "))
+ (if do-buf
+ ;; We do want info in the buffer
+ (if (<= nclasses max)
+ (setq class-info (concat
+ space
+ "<" (mapconcat 'identity classes ",") ">"))
+ (setq class-info (format "%s<%d classes>" space nclasses)))
+ (setq class-info nil))
+ (when do-prop
+ ;; We do want properties
+ (setq x (copy-sequence x))
+ (put-text-property 0 (length x)
+ 'help-echo (mapconcat 'identity classes " ")
+ x))
+ (if class-info
+ (list x class-info)
+ x))
+ list))))
+
+(defun idlwave-attach-method-classes (list)
+ ;; Call idlwave-attach-classes with method parameters
+ (idlwave-attach-classes list 'method idlwave-completion-show-classes))
+
+(defun idlwave-attach-keyword-classes (list)
+ ;; Call idlwave-attach-classes with keyword parameters
+ (idlwave-attach-classes list 'kwd idlwave-completion-show-classes))
+
+(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))
+
+;;----------------------------------------------------
+;; Class structure tags
+
+(defvar idlwave-current-tags-class nil)
+(defvar idlwave-current-class-tags nil)
+(defvar idlwave-current-native-class-tags nil)
+(defvar idlwave-sint-class-tags nil)
+(declare-function idlwave-sintern-class-tag "idlwave" t t)
+(add-hook 'idlwave-load-hook
+ (lambda () (idlwave-new-sintern-type 'class-tag)))
+(add-to-list 'idlwave-complete-special 'idlwave-complete-class-structure-tag)
+(add-hook 'idlwave-update-rinfo-hook 'idlwave-class-tag-reset)
+
+(defun idlwave-complete-class-structure-tag ()
+ "Complete a structure tag on a `self' argument in an object method."
+ (interactive)
+ (let ((pos (point))
+ (case-fold-search t))
+ (if (save-excursion
+ ;; Check if the context is right
+ (skip-chars-backward "a-zA-Z0-9._$")
+ (and (< (point) (- pos 4))
+ (looking-at "self\\.")))
+ (let* ((class-selector (nth 2 (idlwave-current-routine)))
+ (super-classes (idlwave-all-class-inherits class-selector)))
+ ;; Check if we are in a class routine
+ (unless class-selector
+ (error "Not in a method procedure or function"))
+ ;; 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
+ (list 'idlwave-complete-class-structure-tag-help
+ (idlwave-sintern-routine
+ (concat class-selector "__define"))
+ nil))
+ (let ((idlwave-current-native-class-tags))
+ (idlwave-complete-in-buffer
+ 'class-tag 'class-tag
+ idlwave-current-class-tags nil
+ (format "Select a tag of class %s" class-selector)
+ "class tag"
+ 'idlwave-attach-class-tag-classes))
+ t) ; return t to skip other completions
+ nil)))
+
+;; Fake help in the source buffer for class structure tags.
+(defun idlwave-complete-class-structure-tag-help (mode word)
+ (cond
+ ((eq mode 'test) ; nothing gets fontified for class tags
+ nil)
+ ((eq mode 'set)
+ (let (class-with found-in)
+ (when (setq class-with
+ (idlwave-class-or-superclass-with-tag
+ idlwave-current-tags-class
+ word))
+ (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))
+ (setq name (cons (concat found-in "__define") class-with))
+ (setq name (concat class-with "__define")))))
+ (setq kwd word
+ idlwave-help-do-class-struct-tag t))
+ (t (error "This should not happen"))))
+
+(defun idlwave-class-tag-reset ()
+ (setq idlwave-current-tags-class nil))
+
+(defun idlwave-prepare-class-tag-completion (class)
+ "Find and parse the necessary class definitions for class structure tags."
+ (setq idlwave-sint-class-tags nil)
+ (setq idlwave-current-tags-class class)
+ (setq idlwave-current-class-tags
+ (mapcar (lambda (x)
+ (list (idlwave-sintern-class-tag x 'set)))
+ (idlwave-all-class-tags class)))
+ (setq idlwave-current-native-class-tags
+ (mapcar 'downcase (idlwave-class-tags class))))
+
+(defun idlwave-class-add-init-special ()
+ ;; Create special entries for Class::Init() methods as Class()
+ ;; (syntactic sugar in IDL >=8).
+ (idlwave-routines)
+ (setcdr (last idlwave-routines)
+ (idlwave-sintern-rinfo-list
+ (mapcar
+ (lambda (entry)
+ (let ((new-entry (copy-sequence entry)))
+ (setcar new-entry (nth 2 entry)) ;; Function is class name
+ (setcar (cddr new-entry) nil) ;; No class
+ new-entry))
+ (idlwave-all-assq (idlwave-sintern-method "Init")
+ idlwave-routines))
+ 'set)))
+
+;;----------------------------------------------------
+;; System variables/fields
+
+(defvar idlwave-sint-sysvars nil)
+(defvar idlwave-sint-sysvartags nil)
+(declare-function idlwave-sintern-sysvar "idlwave" t t)
+(declare-function idlwave-sintern-sysvartag "idlwave" t t)
+(add-hook 'idlwave-load-hook
+ (lambda ()
+ (idlwave-new-sintern-type 'sysvar)
+ (idlwave-new-sintern-type 'sysvartag)))
+(add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag)
+(add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset)
+(add-hook 'idlwave-update-rinfo-hook 'idlwave-class-add-init-special)
+(add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist)
+
+(defun idlwave-complete-sysvar-or-tag ()
+ "Complete a system variable."
+ (interactive)
+ (let ((pos (point))
+ (case-fold-search t))
+ (cond ((save-excursion
+ ;; Check if the context is right for system variable
+ (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-system-variables-alist nil
+ "Select a system variable"
+ "system variable")
+ t) ; return t to skip other completions
+ ((save-excursion
+ ;; Check if the context is right for sysvar tag
+ (skip-chars-backward "a-zA-Z0-9_$.")
+ (and (equal (char-before) ?!)
+ (looking-at "\\([a-zA-Z][a-zA-Z0-9_$]*\\)\\.")
+ (<= (match-end 0) pos)))
+ ;; Complete a system variable tag
+ (let* ((var (idlwave-sintern-sysvar (match-string 1)))
+ (entry (assq var idlwave-system-variables-alist))
+ (tags (cdr (assq 'tags entry))))
+ (or entry (error "!%s is not a known system variable" var))
+ (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
+ tags nil
+ "Select a system variable tag"
+ "system variable tag")
+ t)) ; return t to skip other completions
+ (t nil))))
+
+(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)))
+ (cond
+ ((eq mode 'test)
+ (and (stringp word) entry (nth 1 (assq 'link entry))))
+ ((eq mode 'set)
+ (if entry (setq link (nth 1 (assq 'link entry))))) ;; setting dynamic!!!
+ (t (error "This should not happen")))))
+
+(defun idlwave-complete-sysvar-tag-help (mode word)
+ (let* ((var (nth 1 idlwave-completion-help-info))
+ (entry (assoc var idlwave-system-variables-alist))
+ (tags (cdr (assq 'tags entry)))
+ (main (nth 1 (assq 'link entry)))
+ target)
+ (cond
+ ((eq mode 'test) ; we can at least link the main
+ (and (stringp word) entry main))
+ ((eq mode 'set)
+ (if entry
+ (setq link
+ (if (setq target (cdr (assoc-ignore-case word tags)))
+ (idlwave-substitute-link-target main target)
+ main)))) ;; setting dynamic!!!
+ (t (error "This should not happen")))))
+
+(defvar idlwave-help-do-class-struct-tag nil)
+
+(provide 'idlw-complete)
+(provide 'idlwave-complete)
View
206 idlw-help.el
@@ -43,152 +43,9 @@
(require 'browse-url)
-(defgroup idlwave-online-help nil
- "Online Help options for IDLWAVE mode."
- :group 'idlwave)
-
-(defcustom idlwave-html-help-pre-v6 nil
- "Whether pre or post-v6.0 IDL help documents are being used.
-OBSOLETE. The full link anchor is now stored."
- :group 'idlwave-online-help
- :type 'boolean)
(defvar idlwave-html-link-sep "#")
-(defcustom idlwave-html-system-help-location nil
- "The directory, relative to idlwave-system-directory, where the
-idl HTML help files live, for IDL 7.0 and later. By default,
-this location is discovered automatically from the installation.
-This location, if found, is used in preference to the old
-idlwave-html-help-location. Note that IDL v6.3-v7.0 used
-help/online_help."
- :group 'idlwave-online-help
- :type 'directory)
-
-(defcustom idlwave-html-help-location
- (if (memq system-type '(ms-dos windows-nt))
- nil
- "/usr/local/etc/")
- "The directory where the idl_html_help/ dir lives.
-OBSOLETE (see idlwave-html-system-help-location)."
- :group 'idlwave-online-help
- :type 'directory)
-
-(defvar idlwave-help-use-hh nil
- "Obsolete variable.")
-
-(defcustom idlwave-help-browser-function browse-url-browser-function
- "Function to use to display html help.
-Defaults to `browse-url-browser-function', which see."
- :group 'idlwave-online-help
- :type 'function)
-
-(defcustom idlwave-help-browser-generic-program browse-url-generic-program
- "Program to run if using browse-url-generic-program."
- :group 'idlwave-online-help
- :type 'string)
-
-(defvar browse-url-generic-args)
-
-(defcustom idlwave-help-browser-generic-args
- (if (boundp 'browse-url-generic-args)
- browse-url-generic-args "")
- "Program args to use if using browse-url-generic-program."
- :group 'idlwave-online-help
- :type 'string)
-
-(defcustom idlwave-help-browser-is-local nil
- "Whether the browser will display locally in an Emacs window.
-Several browsers run and/or display inside Emacs windows, but most are
-external programs. If the browser name contains \"-w3\", it is
-assumed to be local to Emacs. For other local browsers, this variable
-must be explicitly set non-nil in order for the variable
-`idlwave-help-use-dedicated-frame' to function."
- :group 'idlwave-online-help
- :type 'boolean)
-
-(defvar idlwave-help-directory ""
- "Obsolete variable. See idlwave-html-help-location.")
-
-(defcustom idlwave-help-use-dedicated-frame t
- "*Non-nil means, use a separate frame for Online Help if possible."
- :group 'idlwave-online-help
- :type 'boolean)
-
-(defcustom idlwave-help-frame-parameters
- '((height . 32) (unsplittable . t))
- "The frame parameters for the special Online Help frame.
-See also `idlwave-help-use-dedicated-frame'.
-If you do not set the frame width here, the value specified in
-`idlw-help.el' will be used."
- :group 'idlwave-online-help
- :type '(repeat
- (cons symbol sexp)))
-
-(defcustom idlwave-max-popup-menu-items 20
- "Maximum number of items per pane in popup menus.
-Currently only used for class selection during completion help."
- :group 'idlwave-online-help
- :type 'integer)
-
-(defcustom idlwave-extra-help-function 'idlwave-help-with-source
- "The function to call for online help if the normal help fails.
-Online help works only for system routines which are described in the
-IDL manuals. A function may be specified to access help from other sources.
-
-The function must accept four arguments: NAME, TYPE, CLASS, KEYWORD.
-The Help buffer is current when this function is called, and the help
-text should be loaded into this buffer. If help is found, the
-function should return the buffer position which should be used as
-`window-start' in the help window. Also, the variable
-`idlwave-help-mode-line-indicator' should be set to a useful string,
-which will be displayed in the mode line of the help window. If
-should also set the variable `idlwave-help-min-frame-width' to a
-positive integer. IDLWAVE will ensure that the help frame is at least
-that many columns wide. Failure to find help should be indicated by
-throwing an error.
-
-When this variable is non-nil, IDLWAVE will allow the mouse-3 help click
-for every routine and keyword, even though the item may not be highlighted
-in blue (indicating the availability of system documentation).
-
-The default value for this function is `idlwave-help-with-source' which
-loads the routine source file into the help buffer. If you try to write
-a different function which accesses a special help file or so, it is
-probably a good idea to still call this function as a fallback."
- :group 'idlwave-online-help
- :type 'symbol)
-
-(defcustom idlwave-help-fontify-source-code t
- "*Non-nil means, fontify source code displayed as help like normal code."
- :group 'idlwave-online-help
- :type 'boolean)
-
-(defcustom idlwave-help-source-try-header t
- "*Non-nil means, try to find help in routine header when displaying source.
-Routines which are not documented in the system manual use their source as
-help text. When this variable is non-nil, we try to find a description of
-the help item in the first routine doclib header above the routine definition.
-If the variable is nil, or if we cannot find/parse the header, the routine
-definition is displayed instead."
- :group 'idlwave-online-help
- :type 'boolean)
-
-
-(defcustom idlwave-help-doclib-name "name"
- "*A regexp for the heading word to search for in doclib headers
-which specifies the `name' section. Can be used for localization
-support."
- :group 'idlwave-online-help
- :type 'string)
-
-(defcustom idlwave-help-doclib-keyword "KEYWORD"
- "*A regexp for the heading word to search for in doclib headers
-which specifies the `keywords' section. Can be used for localization
-support."
- :group 'idlwave-online-help
- :type 'string)
-
(defface idlwave-help-link
'((((class color)) (:foreground "Blue"))
(t (:weight bold)))
@@ -214,74 +71,11 @@ support."
(defvar idlwave-help-window-configuration nil)
(defvar idlwave-help-special-topic-words nil) ; defined by get_rinfo
-;; Define the key bindings for the Help application
-
-(defvar idlwave-help-mode-map (make-sparse-keymap)
- "The keymap used in idlwave-help-mode.")
-
-(define-key idlwave-help-mode-map "q" 'idlwave-help-quit)
-(define-key idlwave-help-mode-map "w" 'widen)
-(define-key idlwave-help-mode-map "\C-m" (lambda (arg)
- (interactive "p")
- (scroll-up arg)))
-(define-key idlwave-help-mode-map " " 'scroll-up)
-(define-key idlwave-help-mode-map [delete] 'scroll-down)
-(define-key idlwave-help-mode-map "h" 'idlwave-help-find-header)
-(define-key idlwave-help-mode-map "H" 'idlwave-help-find-first-header)
-(define-key idlwave-help-mode-map "." 'idlwave-help-toggle-header-match-and-def)
-(define-key idlwave-help-mode-map "F" 'idlwave-help-fontify)
-(define-key idlwave-help-mode-map "\M-?" 'idlwave-help-return-to-calling-frame)
-(define-key idlwave-help-mode-map "x" 'idlwave-help-return-to-calling-frame)
-
-;; Define the menu for the Help application
-
-(easy-menu-define
- idlwave-help-menu idlwave-help-mode-map
- "Menu for Help IDLWAVE system"
- '("IDLHelp"
- ["Definition <-> Help Text" idlwave-help-toggle-header-match-and-def t]
- ["Find DocLib Header" idlwave-help-find-header t]
- ["Find First DocLib Header" idlwave-help-find-first-header t]
- ["Fontify help buffer" idlwave-help-fontify t]
- "--"
- ["Quit" idlwave-help-quit t]))
(defvar idlwave-help-def-pos)
(defvar idlwave-help-args)
(defvar idlwave-help-in-header)
(declare-function idlwave-prepare-structure-tag-completion "idlw-complete-structtag")
-(declare-function idlwave-all-method-classes "idlwave")
-(declare-function idlwave-all-method-keyword-classes "idlwave")
-(declare-function idlwave-beginning-of-statement "idlwave")
-(declare-function idlwave-best-rinfo-assoc "idlwave")
-(declare-function idlwave-class-found-in "idlwave")
-(declare-function idlwave-class-or-superclass-with-tag "idlwave")
-(declare-function idlwave-completing-read "idlwave")
-(declare-function idlwave-current-routine "idlwave")
-(declare-function idlwave-downcase-safe "idlwave")
-(declare-function idlwave-entry-find-keyword "idlwave")
-(declare-function idlwave-expand-keyword "idlwave")
-(declare-function idlwave-find-class-definition "idlwave")
-(declare-function idlwave-find-inherited-class "idlwave")
-(declare-function idlwave-find-struct-tag "idlwave")
-(declare-function idlwave-get-buffer-visiting "idlwave")
-(declare-function idlwave-in-quote "idlwave")
-(declare-function idlwave-make-full-name "idlwave")
-(declare-function idlwave-members-only "idlwave")
-(declare-function idlwave-popup-select "idlwave")
-(declare-function idlwave-routine-source-file "idlwave")
-(declare-function idlwave-routines "idlwave")
-(declare-function idlwave-sintern-class "idlwave")
-(declare-function idlwave-sintern-keyword "idlwave")
-(declare-function idlwave-sintern-method "idlwave")
-(declare-function idlwave-sintern-routine-or-method "idlwave")
-(declare-function idlwave-sintern-sysvar "idlwave" t t);idlwave-new-sintern-type
-(declare-function idlwave-sintern-sysvartag "idlwave" t t)
-(declare-function idlwave-substitute-link-target "idlwave")
-(declare-function idlwave-sys-dir "idlwave")
-(declare-function idlwave-this-word "idlwave")
-(declare-function idlwave-what-module-find-class "idlwave")
-(declare-function idlwave-where "idlwave")
(defun idlwave-help-mode ()
"Major mode for displaying IDL Help.
View
260 idlw-menus.el
@@ -0,0 +1,260 @@
+;; IDLWAVE menus and associated code
+
+;; Define - using easymenu.el
+(defvar idlwave-mode-menu)
+(defvar idlwave-mode-debug-menu)
+
+(defalias 'idlwave-function-menu
+ (condition-case nil
+ (progn
+ (require 'imenu)
+ 'imenu)
+ (error nil)))
+(defvar idlwave-mode-menu-def
+ `("IDLWAVE"
+ ["PRO/FUNC menu" idlwave-function-menu t]
+ ("Motion"
+ ["Subprogram Start" idlwave-beginning-of-subprogram t]
+ ["Subprogram End" idlwave-end-of-subprogram t]
+ ["Block Start" idlwave-beginning-of-block t]
+ ["Block End" idlwave-end-of-block t]
+ ["Up Block" idlwave-backward-up-block t]
+ ["Down Block" idlwave-down-block t]
+ ["Skip Block Backward" idlwave-backward-block t]
+ ["Skip Block Forward" idlwave-forward-block t])
+ ("Mark"
+ ["Subprogram" idlwave-mark-subprogram t]
+ ["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 t]
+ ["Continue/Split line" idlwave-split-line t]
+ "--"
+ ["Toggle Auto Fill" idlwave-auto-fill-mode :style toggle
+ :selected (symbol-value idlwave-fill-function)])
+ ("Templates"
+ ["Procedure" idlwave-procedure t]
+ ["Function" idlwave-function t]
+ ["Doc Header" idlwave-doc-header t]
+ ["Log" idlwave-doc-modification t]
+ "--"
+ ["Case" idlwave-case t]
+ ["For" idlwave-for t]
+ ["Repeat" idlwave-repeat t]
+ ["While" idlwave-while t]
+ "--"
+ ["Close Block" idlwave-close-block t])
+ ("Completion"
+ ["Complete" idlwave-complete t]
+ ("Complete Specific"
+ ["1 Procedure Name" (idlwave-complete 'procedure) t]
+ ["2 Procedure Keyword" (idlwave-complete 'procedure-keyword) t]
+ "--"
+ ["3 Function Name" (idlwave-complete 'function) t]
+ ["4 Function Keyword" (idlwave-complete 'function-keyword) t]
+ "--"
+ ["5 Procedure Method Name" (idlwave-complete 'procedure-method) t]
+ ["6 Procedure Method Keyword" (idlwave-complete 'procedure-method-keyword) t]
+ "--"
+ ["7 Function Method Name" (idlwave-complete 'function-method) t]
+ ["8 Function Method Keyword" (idlwave-complete 'function-method-keyword) t]
+ "--"
+ ["9 Class Name" idlwave-complete-class t]))
+ ("Routine Info"
+ ["Show Routine Info" idlwave-routine-info t]
+ ["Online Context Help" idlwave-context-help t]
+ "--"
+ ["Find Routine Source" idlwave-find-module t]
+ ["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)]
+ "--"
+ ["Update Routine Info" idlwave-update-routine-info t]
+ ["Rescan XML Help Catalog" idlwave-rescan-xml-routine-info t]
+ "--"
+ "IDL User Catalog"
+ ["Select Catalog Directories" (idlwave-create-user-catalog-file nil) t]
+ ["Scan Directories" (idlwave-update-routine-info '(16))
+ (and idlwave-path-alist (not idlwave-catalog-process))]
+ ["Scan Directories &" (idlwave-update-routine-info '(64))
+ (and idlwave-path-alist (not idlwave-catalog-process))]
+ "--"
+ "Routine Shadows"
+ ["Check Current Buffer" idlwave-list-buffer-load-path-shadows t]
+ ["Check Compiled Routines" idlwave-list-shell-load-path-shadows t]
+ ["Check Everything" idlwave-list-all-load-path-shadows t])
+ ("Misc"
+ ["Kill auto-created buffers" idlwave-kill-autoloaded-buffers t]
+ "--"
+ ["Insert TAB character" idlwave-hard-tab t])
+ "--"
+ ("External"
+ ["Start IDL shell" idlwave-shell t]
+ ["Edit file in IDLDE" idlwave-edit-in-idlde t])
+ "--"
+ ("Customize"
+ ["Browse IDLWAVE Group" idlwave-customize t]
+ "--"
+ ["Build Full Customize Menu" idlwave-create-customize-menu
+ (fboundp 'customize-menu-create)])
+ ("Documentation"
+ ["Describe Mode" describe-mode t]
+ ["Abbreviation List" idlwave-list-abbrevs t]
+ "--"
+ ["Commentary in idlwave.el" idlwave-show-commentary t]
+ ["Commentary in idlw-shell.el" idlwave-shell-show-commentary t]
+ "--"
+ ["Info" idlwave-info t]
+ "--"
+ ["Help with Topic" idlwave-help-with-topic t]
+ ["Launch IDL Help" idlwave-launch-idlhelp t])))
+
+(defvar idlwave-mode-debug-menu-def
+ '("Debug"
+ ["Start IDL shell" idlwave-shell t]
+ ["Save and .RUN buffer" idlwave-shell-save-and-run
+ (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"
+ idlwave-mode-menu-def)
+ (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
+ "IDL and WAVE CL editing menu"
+ idlwave-mode-debug-menu-def)))
+
+
+;;----------------------------------------------------
+;; IDLWAVE menu and support functions
+(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
+ ;; as well.
+ (or (featurep 'idlw-shell)
+ (load "idlw-shell" t))
+ (customize-browse 'idlwave))
+
+(defun idlwave-create-customize-menu ()
+ "Create a full customization menu for IDLWAVE, insert it into the menu."
+ (interactive)
+ (if (fboundp 'customize-menu-create)
+ (progn
+ ;; 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
+ '("IDLWAVE") "Customize"
+ `(["Browse IDLWAVE group" idlwave-customize t]
+ "--"
+ ,(customize-menu-create 'idlwave)
+ ["Set" Custom-set t]
+ ["Save" Custom-save t]
+ ["Reset to Current" Custom-reset-current t]
+ ["Reset to Saved" Custom-reset-saved t]
+ ["Reset to Standard Settings" Custom-reset-standard t]))
+ (message "\"IDLWAVE\"-menu now contains full customization menu"))
+ (error "Cannot expand menu (outdated version of cus-edit.el)")))
+
+(defun idlwave-show-commentary ()
+ "Use the finder to view the file documentation from `idlwave.el'."
+ (interactive)
+ (finder-commentary "idlwave.el"))
+
+(defun idlwave-shell-show-commentary ()
+ "Use the finder to view the file documentation from `idlw-shell.el'."
+ (interactive)
+ (finder-commentary "idlw-shell.el"))
+
+(defun idlwave-info ()
+ "Read documentation for IDLWAVE in the info system."
+ (interactive)
+ (info "idlwave"))
+
+(defun idlwave-list-abbrevs (arg)
+ "Show the code abbreviations define in IDLWAVE mode.
+This lists all abbrevs where the replacement text differs from the input text.
+These are the ones the users want to learn to speed up their writing.
+
+The function does *not* list abbrevs which replace a word with itself
+to call a hook. These hooks are used to change the case of words or
+to blink the matching `begin', and the user does not need to know them.
+
+With arg, list all abbrevs with the corresponding hook.
+
+This function was written since `list-abbrevs' looks terrible for IDLWAVE mode."
+
+ (interactive "P")
+ (let ((table (symbol-value 'idlwave-mode-abbrev-table))
+ abbrevs
+ str rpl func fmt (len-str 0) (len-rpl 0))
+ (mapatoms
+ (lambda (sym)
+ (if (symbol-value sym)
+ (progn
+ (setq str (symbol-name sym)
+ rpl (symbol-value sym)
+ func (symbol-function sym))
+ (if arg
+ (setq func (prin1-to-string func))
+ (if (and (listp func) (stringp (nth 2 func)))
+ (setq rpl (concat "EVAL: " (nth 2 func))
+ func "")
+ (setq func "")))
+ (if (or arg (not (string= rpl str)))
+ (progn
+ (setq len-str (max len-str (length str)))
+ (setq len-rpl (max len-rpl (length rpl)))
+ (setq abbrevs (cons (list str rpl func) abbrevs)))))))
+ table)
+ ;; sort the list
+ (setq abbrevs (sort abbrevs (lambda (a b) (string< (car a) (car b)))))
+ ;; Make the format
+ (setq fmt (format "%%-%ds %%-%ds %%s\n" len-str len-rpl))
+ (with-output-to-temp-buffer "*Help*"
+ (if arg
+ (progn
+ (princ "Abbreviations and Actions in IDLWAVE-Mode\n")
+ (princ "=========================================\n\n")
+ (princ (format fmt "KEY" "REPLACE" "HOOK"))
+ (princ (format fmt "---" "-------" "----")))
+ (princ "Code Abbreviations and Templates in IDLWAVE-Mode\n")
+ (princ "================================================\n\n")
+ (princ (format fmt "KEY" "ACTION" ""))
+ (princ (format fmt "---" "------" "")))
+ (mapcar
+ (lambda (list)
+ (setq str (car list)
+ rpl (nth 1 list)
+ func (nth 2 list))
+ (princ (format fmt str rpl func)))
+ abbrevs)))
+ ;; Make sure each abbreviation uses only one display line
+ (with-current-buffer "*Help*"
+ (setq truncate-lines t)))
+
+;;----------------------------------------------------
+;; IDLWAVE help menus
+;; Define the key bindings for the Help application
+
+
+;; Define the menu for the Help application
+
+(easy-menu-define
+ idlwave-help-menu idlwave-help-mode-map
+ "Menu for Help IDLWAVE system"
+ '("IDLHelp"
+ ["Definition <-> Help Text" idlwave-help-toggle-header-match-and-def t]
+ ["Find DocLib Header" idlwave-help-find-header t]
+ ["Find First DocLib Header" idlwave-help-find-first-header t]
+ ["Fontify help buffer" idlwave-help-fontify t]
+ "--"
+ ["Quit" idlwave-help-quit t]))
+
+
+(provide 'idlw-menus)
+(provide 'idlwave-menus)
View
1,460 idlw-routine.el
@@ -0,0 +1,1460 @@
+;; IDLWAVE Routine Information code and variables
+
+;; Format for all routine info user catalog, library catalogs, etc.:
+;;
+;; ("ROUTINE" type class
+;; (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") |
+;; (buffer pro_file dir) | (compiled pro_file dir)
+;; "calling_string" ("LINKFILE" (("KWD1" . anchorlink1) ...))
+;; ("LINKFILE2" (("KWD2" . ancorlink2) ...)) ...)
+;;
+;; DIR will be supplied dynamically while loading library catalogs,
+;; and is sinterned to save space, as is LIBNAME. PRO_FILE can be a
+;; complete filepath, in which case DIR is unnecessary. HELPFILE can
+;; be nil, as can LINKFILE, etc., if no HTML help is available for
+;; that routine. Since keywords can be referenced in multiples files
+;; (e.g. Graphics Keywords), there are multiple keyword link lists.
+
+
+;;----------------------------------------------------
+;; Routine Info
+
+(defun idlwave-routine-info (&optional arg external)
+ "Display a routine's calling sequence and list of keywords.
+When point is on the name a function or procedure, or in the argument
+list of a function or procedure, this command displays a help buffer with
+the information. When called with prefix arg, enforce class query.
+
+When point is on an object operator `->', display the class stored in
+this arrow, if any (see `idlwave-store-inquired-class'). With a prefix
+arg, the class property is cleared out."
+ (interactive "P")
+ (idlwave-routines)
+ (if (string-match "->" (buffer-substring
+ (max (point-min) (1- (point)))
+ (min (+ 2 (point)) (point-max))))
+ ;; Cursor is on an arrow
+ (if (get-text-property (point) 'idlwave-class)
+ ;; arrow has class property
+ (if arg
+ ;; Remove property
+ (save-excursion
+ (backward-char 1)
+ (when (looking-at ".?\\(->\\)")
+ (remove-text-properties (match-beginning 1) (match-end 1)
+ '(idlwave-class nil face nil))
+ (message "Class property removed from arrow")))
+ ;; Echo class property
+ (message "Arrow has text property identifying object to be class %s"
+ (get-text-property (point) 'idlwave-class)))
+ ;; No property found
+ (message "Arrow has no class text property"))
+
+ ;; Not on an arrow...
+ (let* ((idlwave-query-class nil)
+ (idlwave-force-class-query (equal arg '(4)))
+ (module (idlwave-what-module)))
+ (if (car module)
+ (apply 'idlwave-display-calling-sequence
+ (idlwave-fix-module-if-obj_new module))
+ (error "Don't know which calling sequence to show")))))
+
+;;----------------------------------------------------
+;; Selecting/matching routines
+
+(defun idlwave-rinfo-assoc (name type class list)
+ "Like `idlwave-rinfo-assq', but sintern strings first."
+ (idlwave-rinfo-assq
+ (idlwave-sintern-routine-or-method name class)
+ type (idlwave-sintern-class class) list))
+
+(defun idlwave-rinfo-assq (name type class list)
+ ;; Works like assq, but also checks type and class
+ (catch 'exit
+ (let (match)
+ (while (setq match (assq name list))
+ (and (or (eq type t)
+ (eq (nth 1 match) type))
+ (eq (nth 2 match) class)
+ (throw 'exit match))
+ (setq list (cdr (memq match list)))))))
+
+(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
+included. If KEEP-SYSTEM is set, don't prune system for compiled
+syslib files."
+ (let ((twins (idlwave-routine-twins
+ (idlwave-rinfo-assq-any-class name type class list)
+ list))
+ syslibp)
+ (when (> (length twins) 1)
+ (setq twins (sort twins 'idlwave-routine-entry-compare-twins))
+ (if (and (null keep-system)
+ (eq 'system (car (nth 3 (car twins))))
+ (setq syslibp (idlwave-any-syslib (cdr twins)))
+ (not (equal 1 syslibp)))
+ ;; Its a compiled syslib, so we need to remove the system entry
+ (setq twins (cdr twins)))
+ (if with-file
+ (setq twins (delq nil
+ (mapcar (lambda (x)
+ (if (nth 1 (nth 3 x)) x))
+ twins)))))
+ (car twins)))
+
+(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
+ (idlwave-sintern-routine-or-method name class)
+ type (idlwave-sintern-class class) list with-file keep-system))
+
+(defun idlwave-rinfo-assq-any-class (name type class list)
+ ;; Return the first matching method on the inheritance list
+ (let* ((classes (cons class (idlwave-all-class-inherits class)))
+ class rtn)
+ (while classes
+ (if (setq rtn (idlwave-rinfo-assq name type (pop classes) list))
+ (setq classes nil)))
+ rtn))
+
+;;----------------------------------------------------
+;; Routine Shadows
+
+;; Routine shadows aka twins: same routine name, different routines on
+;; path (or in IDL distributed system)
+
+(defun idlwave-routine-twins (entry &optional list)
+ "Return all twin entries of ENTRY in LIST.
+LIST defaults to `idlwave-routines'.
+Twin entries are those which have the same name, type, and class.
+ENTRY will also be returned, as the first item of this list."
+ (let* ((name (car entry))
+ (type (nth 1 entry))
+ (class (nth 2 entry))
+ (candidates (idlwave-all-assq name (or list (idlwave-routines))))
+ twins candidate)
+ (while (setq candidate (pop candidates))
+ (if (and (not (eq candidate entry))
+ (eq type (nth 1 candidate))
+ (eq class (nth 2 candidate)))
+ (push candidate twins)))
+ (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.
+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)) ;
+ (type (nth 1 entry)) ; Must be bound for
+ (class (nth 2 entry)) ; idlwave-routine-twin-compare
+ (cnt 0)
+ source type type-cons file alist syslibp key)
+ (while (setq entry (pop entries))
+ (incf cnt)
+ (setq source (nth 3 entry)
+ type (car source)
+ type-cons (cons type (nth 3 source))
+ file (idlwave-routine-source-file source))
+
+ ;; Make KEY to index entry properly
+ (setq key (cond ((eq type 'system) type)
+ (file (file-truename file))
+ (t 'unresolved)))
+
+ ;; Check for an entry in the system library
+ (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)
+ (setq entry (assoc 'system alist)))
+ (setcar entry 'builtin))
+ (sort alist 'idlwave-routine-twin-compare)))
+
+(defun idlwave-routine-entry-compare (a b)
+ "Compare two routine info entries for sorting.
+This is the general case. It first compares class, names, and type.
+If it turns out that A and B are twins (same name, class, and type),
+calls another routine which compares twins on the basis of their file
+names and path locations."
+ (let ((name (car a)) (type (nth 1 a)) (class (nth 2 a)))
+ (cond
+ ((not (equal (idlwave-downcase-safe class)
+ (idlwave-downcase-safe (nth 2 b))))
+ ;; Class decides
+ (cond ((null (nth 2 b)) nil)
+ ((null class) t)
+ (t (string< (downcase class) (downcase (nth 2 b))))))
+ ((not (equal (downcase name) (downcase (car b))))
+ ;; Name decides
+ (string< (downcase name) (downcase (car b))))
+ ((not (eq type (nth 1 b)))
+ ;; Type decides
+ (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0)))
+ (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)))))
+
+(defun idlwave-routine-entry-compare-twins (a b)
+ "Compare two routine entries, under the assumption that they are twins.
+This basically calls `idlwave-routine-twin-compare' with the correct args."
+ (let* ((name (car a)) (type (nth 1 a)) (class (nth 2 a)) ; needed outside
+ (asrc (nth 3 a))
+ (atype (car asrc))
+ (bsrc (nth 3 b))
+ (btype (car bsrc))
+ (afile (idlwave-routine-source-file asrc))
+ (bfile (idlwave-routine-source-file bsrc)))
+ (idlwave-routine-twin-compare
+ (if (stringp afile)
+ (list (file-truename afile) afile (list atype))
+ (list atype afile (list atype)))
+ (if (stringp bfile)
+ (list (file-truename bfile) bfile (list btype))
+ (list btype bfile (list btype))))
+ ))
+
+;; Bound in idlwave-study-twins,idlwave-routine-entry-compare-twins.
+;; FIXME: Dynamically scoped vars need to use the `idlwave-' prefix.
+(defvar class)
+
+(defun idlwave-routine-twin-compare (a b)
+ "Compare two routine twin entries for sorting.
+In here, A and B are not normal routine info entries, but special
+lists (KEY FILENAME (TYPES...)).
+This expects NAME TYPE CLASS to be bound to the right values."
+ (let* (;; Dis-assemble entries
+ (akey (car a)) (bkey (car b))
+ (afile (nth 1 a)) (bfile (nth 1 b))
+ (atypes (nth 2 a)) (btypes (nth 2 b))
+ ;; System routines?
+ (asysp (memq akey '(builtin system)))
+ (bsysp (memq bkey '(builtin system)))
+ ;; Compiled routines?
+ (acompp (memq 'compiled atypes))
+ (bcompp (memq 'compiled btypes))
+ ;; Unresolved?
+ (aunresp (or (eq akey 'unresolved)
+ (and acompp (not afile))))
+ (bunresp (or (eq bkey 'unresolved)
+ (and bcompp (not bfile))))
+ ;; Buffer info available?
+ (abufp (memq 'buffer atypes))
+ (bbufp (memq 'buffer btypes))
+ ;; On search path?
+ (tpath-alist (idlwave-true-path-alist))
+ (apathp (and (stringp akey)
+ (assoc (file-name-directory akey) tpath-alist)))
+ (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
+ (anpath (length (memq apathp tpath-alist)))
+ (bnpath (length (memq bpathp tpath-alist)))
+ ;; Look at file names
+ (aname (if (stringp afile) (downcase (file-name-nondirectory afile)) ""))
+ (bname (if (stringp bfile) (downcase (file-name-nondirectory bfile)) ""))
+ (fname-re (if class (format "\\`%s__\\(%s\\|define\\)\\.pro\\'"
+ (regexp-quote (downcase class))
+ (regexp-quote (downcase name)))
+ (format "\\`%s\\.pro" (regexp-quote (downcase name)))))
+ ;; Is file name derived from the routine name?
+ ;; Method file or class definition file?
+ (anamep (string-match fname-re aname))
+ (adefp (and class anamep (string= "define" (match-string 1 aname))))
+ (bnamep (string-match fname-re bname))
+ (bdefp (and class bnamep (string= "define" (match-string 1 bname)))))
+
+ ;; Now: follow JD's ideas about sorting. Looks really simple now,
+ ;; doesn't it? The difficult stuff is hidden above...
+ (cond
+ ((idlwave-xor asysp bsysp) asysp) ; System entries first
+ ((idlwave-xor aunresp bunresp) bunresp) ; Unresolved last
+ ((and idlwave-sort-prefer-buffer-info
+ (idlwave-xor abufp bbufp)) abufp) ; Buffers before non-buffers
+ ((idlwave-xor acompp bcompp) acompp) ; Compiled entries
+ ((idlwave-xor apathp bpathp) apathp) ; Library before non-library
+ ((idlwave-xor anamep bnamep) anamep) ; Correct file names first
+ ((and class anamep bnamep ; both file names match ->
+ (idlwave-xor adefp bdefp)) bdefp) ; __define after __method
+ ((> anpath bnpath) t) ; Who is first on path?
+ (t nil)))) ; Default
+
+(defun idlwave-list-buffer-load-path-shadows (&optional arg)
+ "List the load path shadows of all routines defined in current buffer."
+ (interactive "P")
+ (idlwave-routines)
+ (if (eq major-mode 'idlwave-mode)
+ (idlwave-list-load-path-shadows
+ nil (idlwave-update-current-buffer-info 'save-buffer)
+ "in current buffer")
+ (error "Current buffer is not in idlwave-mode")))
+
+(defun idlwave-list-shell-load-path-shadows (&optional arg)
+ "List the load path shadows of all routines compiled under the shell.
+This is very useful for checking an IDL application. Just compile the
+application, do RESOLVE_ALL, and `C-c C-i' to compile all referenced
+routines and update IDLWAVE internal info. Then check for shadowing
+with this command."
+ (interactive "P")
+ (cond
+ ((or (not (fboundp 'idlwave-shell-is-running))
+ (not (idlwave-shell-is-running)))
+ (error "Shell is not running"))
+ ((null idlwave-compiled-routines)
+ (error "No compiled routines. Maybe you need to update with `C-c C-i'"))
+ (t
+ (idlwave-list-load-path-shadows nil idlwave-compiled-routines
+ "in the shell"))))
+
+(defun idlwave-list-all-load-path-shadows (&optional arg)
+ "List the load path shadows of all routines known to IDLWAVE."
+ (interactive "P")
+ (idlwave-list-load-path-shadows nil nil "globally"))
+
+(defvar idlwave-sort-prefer-buffer-info t
+ "Internal variable used to influence `idlwave-routine-twin-compare'.")
+
+(defun idlwave-list-load-path-shadows (arg &optional special-routines loc)
+ "List the routines which are defined multiple times.
+Search the information IDLWAVE has about IDL routines for multiple
+definitions.
+When SPECIAL-ROUTINES in non-nil, only look for shadows of these routines.
+
+When IDL hits a routine call which is not defined, it will search on
+the load path in order to find a definition. The output of this 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
+ "You don't have any user or library catalogs. Continue anyway? ")
+ (error "Abort")))
+ (let* ((routines (append idlwave-system-routines
+ idlwave-compiled-routines
+ idlwave-library-catalog-routines
+ idlwave-user-catalog-routines
+ idlwave-buffer-routines
+ nil))
+ (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
+ (keymap (make-sparse-keymap))
+ (props (list 'mouse-face 'highlight
+ km-prop keymap
+ 'help-echo "Mouse2: Find source"))
+ (nroutines (length (or special-routines routines)))
+ (step (max 1 (/ nroutines 100)))
+ (n 0)
+ (cnt 0)
+ (idlwave-sort-prefer-buffer-info nil)
+ routine twins dtwins twin done props1 lroutines)
+
+ (if special-routines
+ ;; Just looking for shadows of a few special routines
+ (setq lroutines routines
+ routines special-routines))
+
+ (message "Sorting routines...")
+ (setq routines (sort routines
+ (lambda (a b)
+ (string< (downcase (idlwave-make-full-name
+ (nth 2 a) (car a)))
+ (downcase (idlwave-make-full-name
+ (nth 2 b) (car b)))))))
+ (message "Sorting routines...done")
+
+ (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)])
+ (lambda (ev)
+ (interactive "e")
+ (mouse-set-point ev)
+ (apply 'idlwave-do-find-module
+ (get-text-property (point) 'find-args))))
+ (define-key keymap [(return)]
+ (lambda ()
+ (interactive)
+ (apply 'idlwave-do-find-module
+ (get-text-property (point) 'find-args))))
+ (message "Compiling list...( 0%%)")
+ (with-current-buffer (get-buffer-create "*Shadows*")
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (while (setq routine (pop routines))
+ (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)
+ (setq dtwins nil)
+ (setq dtwins (idlwave-study-twins twins)))
+ ;; Mark all twins as dealt with
+ (setq done (append twins done))
+ (when (or (> (length dtwins) 1)
+ (> (idlwave-count-memq 'lib (nth 2 (car dtwins))) 1)
+ (> (idlwave-count-memq 'user (nth 2 (car dtwins))) 1)
+ (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1))
+ (incf cnt)
+ (insert (format "\n%s%s"
+ (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)
+ (nth 2 routine)))
+ props))
+ (idlwave-insert-source-location "\n - " twin props1))))
+ (goto-char (point-min))
+ (setq buffer-read-only t))
+ (setq loc (or loc ""))
+ (if (> cnt 0)
+ (progn
+ (display-buffer (get-buffer "*Shadows*"))
+ (message "%d case%s of shadowing found %s"
+ cnt (if (= cnt 1) "" "s") loc))
+ (message "No shadowing conflicts found %s" loc))))
+
+;;----------------------------------------------------
+;; Routine data structure tools
+
+(defun idlwave-routine-source-file (source)
+ (if (nth 2 source)
+ (expand-file-name (nth 1 source) (nth 2 source))
+ (nth 1 source)))
+
+(defun idlwave-any-syslib (entries)
+ "Does the entry list ENTRIES contain a syslib entry?
+If yes, return the index (>=1)."
+ (let (file (cnt 0))
+ (catch 'exit
+ (while entries
+ (incf cnt)
+ (setq file (idlwave-routine-source-file (nth 3 (car entries))))
+ (if (and file (idlwave-syslib-p file))
+ (throw 'exit cnt)
+ (setq entries (cdr entries))))
+ nil)))
+
+(defun idlwave-all-method-classes (method &optional type)
+ "Return all classes which have a method METHOD.
+TYPE is 'fun or 'pro.
+When TYPE is not specified, both procedures and functions will be considered."
+ (if (null method)
+ (mapcar 'car (idlwave-class-alist))
+ (let (rtn)
+ (mapc (lambda (x)
+ (and (nth 2 x)
+ (or (not type)
+ (eq type (nth 1 x)))
+ (push (nth 2 x) rtn)))
+ (idlwave-all-assq method (idlwave-routines)))
+ (idlwave-uniquify rtn))))
+
+(defun idlwave-all-method-keyword-classes (method keyword &optional type)
+ "Return all classes which have a method METHOD with keyword KEYWORD.
+TYPE is 'fun or 'pro.
+When TYPE is not specified, both procedures and functions will be considered."
+ (if (or (null method)
+ (null keyword))
+ nil
+ (let (rtn)
+ (mapc (lambda (x)
+ (and (nth 2 x) ; non-nil class
+ (or (not type) ; correct or unspecified type
+ (eq type (nth 1 x)))
+ (assoc keyword (idlwave-entry-keywords x))
+ (push (nth 2 x) rtn)))
+ (idlwave-all-assq method (idlwave-routines)))
+ (idlwave-uniquify rtn))))
+
+(defun idlwave-make-full-name (class &optional name)
+ (let (class)
+ (when (listp class)
+ ;; a routine info or idlwave-what-module entry