idlw-complete.el

;; 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 idlwave-link) ;dynamic variables set by help callback
(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 idlwave-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)

;;----------------------------------------------------
;; Specialized completion in the shell

(defun idlwave-shell-complete (&optional arg)
  "Do completion in the idlwave-shell buffer.
Calls `idlwave-shell-complete-filename' after some executive commands or
in strings.  Otherwise, calls `idlwave-complete' to complete modules and
keywords."
  (interactive "P")
  (let (exec-cmd)
    (cond
     ((and
       (setq exec-cmd (idlwave-shell-executive-command))
       (cdr exec-cmd)
       (member (upcase (cadr exec-cmd))
	       '(".R" ".RU" ".RUN" ".RN" ".RNE" ".RNEW"
		 ".COM" ".COMP" ".COMPI" ".COMPIL" ".COMPILE")))
      ;; We are in a command line with an executive command
      (idlwave-shell-complete-filename (not (idlwave-in-quote))))

     ((car-safe exec-cmd)
      (setq idlwave-completion-help-info
	    '(idlwave-shell-complete-execcomm-help))
      (idlwave-complete-in-buffer 'execcomm 'execcomm
				  idlwave-executive-commands-alist nil
				  "Select an executive command"
				  "system variable"))

     ((idlwave-shell-batch-command)
      (idlwave-shell-complete-filename))

     ((idlwave-shell-shell-command)
      (idlwave-shell-complete-filename))

     ((and (idlwave-shell-filename-string)
	   (save-excursion
	     (beginning-of-line)
	     (let ((case-fold-search t))
	       (not (looking-at ".*obj_new")))))
      (idlwave-shell-complete-filename))

     (t
      ;; Default completion of modules and keywords
      (idlwave-complete arg)))))

(defun idlwave-shell-complete-execcomm-help (mode word)
  (let ((word (or (nth 1 idlwave-completion-help-info) word))
	(entry (assoc-string word idlwave-executive-commands-alist t)))
    (cond
     ((eq mode 'test)
      (and (stringp word) entry (cdr entry)))
     ((eq mode 'set)
      (if entry (setq idlwave-link (cdr entry)))) ;; setting dynamic variable!!!
     (t (error "This should not happen")))))

(defun idlwave-shell-complete-filename (&optional nospace)
  "Complete a file name at point if after a file name.
We assume that we are after a file name when completing one of the
args of an executive .run, .rnew or .compile."
  ;; CWD might have changed, resync, to set default directory
  (idlwave-shell-resync-dirs)
  (let ((comint-file-name-chars 
	 (if (and nospace (string-match "[ ]" idlwave-shell-file-name-chars))
	     (replace-match "" nil t idlwave-shell-file-name-chars)
	   idlwave-shell-file-name-chars)))
    (comint-dynamic-complete-as-filename)))


(provide 'idlw-complete)
(provide 'idlwave-complete)