/[emacs]/emacs/lisp/progmodes/idlwave.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/idlwave.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3.17.2.5 by miles, Thu Nov 4 13:12:43 2004 UTC revision 3.17.2.6 by miles, Wed Dec 8 23:31:45 2004 UTC
# Line 1  Line 1 
1  ;;; idlwave.el --- IDL editing mode for GNU Emacs  ;; idlwave.el --- IDL editing mode for GNU Emacs
2  ;; Copyright (c) 1999, 2000, 2001,2002 Free Software Foundation  ;; Copyright (c) 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation
3    
4  ;; Author: Carsten Dominik <dominik@astro.uva.nl>  ;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
5  ;;         Chris Chase <chase@att.com>  ;;          Carsten Dominik <dominik@astro.uva.nl>
6    ;;          Chris Chase <chase@att.com>
7  ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>  ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>
8  ;; Version: 4.15  ;; Version: 5.5
9  ;; Keywords: languages  ;; Keywords: languages
10    
11  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 26  Line 27 
27    
28  ;;; Commentary:  ;;; Commentary:
29    
30  ;; In distant past, based on pascal.el.  Though bears little  ;; In the remotely distant past, based on pascal.el, though bears
31  ;; resemblance to that now.  ;; little resemblance to it now.
32  ;;  ;;
33  ;; Incorporates many ideas, such as abbrevs, action routines, and  ;; Incorporates many ideas, such as abbrevs, action routines, and
34  ;; continuation line indenting, from wave.el.  ;; continuation line indenting, from wave.el.
# Line 57  Line 58 
58  ;; ======  ;; ======
59  ;;  ;;
60  ;; The newest version of this file is available from the maintainer's  ;; The newest version of this file is available from the maintainer's
61  ;; Webpage.  ;; Webpage:
62  ;;  ;;
63  ;;   http://idlwave.org  ;;   http://idlwave.org
64  ;;  ;;
65  ;; DOCUMENTATION  ;; DOCUMENTATION
66  ;; =============  ;; =============
67  ;;  ;;
68  ;; IDLWAVE is documented online in info format.  ;; IDLWAVE is documented online in info format.  A printable version
69  ;; A printable version of the documentation is available from the  ;; of the documentation is available from the maintainers webpage (see
70  ;; maintainers webpage (see under SOURCE)  ;; SOURCE).
 ;;  
71  ;;  ;;
72    ;;
73  ;; ACKNOWLEDGMENTS  ;; ACKNOWLEDGMENTS
74  ;; ===============  ;; ===============
75  ;;  ;;
76  ;;  Thanks to the following people for their contributions and comments:  ;;  Thanks to the following people for their contributions and comments:
77  ;;  ;;
78  ;;    Ulrik Dickow <dickow@nbi.dk>  ;;    Ulrik Dickow <dickow_at_nbi.dk>
79  ;;    Eric E. Dors <edors@lanl.gov>  ;;    Eric E. Dors <edors_at_lanl.gov>
80  ;;    Stein Vidar H. Haugan <s.v.h.haugan@astro.uio.no>  ;;    Stein Vidar H. Haugan <s.v.h.haugan_at_astro.uio.no>
81  ;;    David Huenemoerder <dph@space.mit.edu>  ;;    David Huenemoerder <dph_at_space.mit.edu>
82  ;;    Kevin Ivory <Kevin.Ivory@linmpi.mpg.de>  ;;    Kevin Ivory <Kevin.Ivory_at_linmpi.mpg.de>
83  ;;    Xuyong Liu <liu@stsci.edu>  ;;    Dick Jackson <dick_at_d-jackson.com>
84  ;;    Simon Marshall <Simon.Marshall@esrin.esa.it>  ;;    Xuyong Liu <liu_at_stsci.edu>
85  ;;    Laurent Mugnier <mugnier@onera.fr>  ;;    Simon Marshall <Simon.Marshall_at_esrin.esa.it>
86  ;;    Lubos Pochman <lubos@rsinc.com>  ;;    Laurent Mugnier <mugnier_at_onera.fr>
87  ;;    Bob Portmann <portmann@al.noaa.gov>  ;;    Lubos Pochman <lubos_at_rsinc.com>
88  ;;    Patrick M. Ryan <pat@jaameri.gsfc.nasa.gov>  ;;    Bob Portmann <portmann_at_al.noaa.gov>
89  ;;    Marty Ryba <ryba@ll.mit.edu>  ;;    Patrick M. Ryan <pat_at_jaameri.gsfc.nasa.gov>
90  ;;    Phil Williams <williams@irc.chmcc.org>  ;;    Marty Ryba <ryba_at_ll.mit.edu>
91  ;;    Phil Sterne <sterne@dublin.llnl.gov>  ;;    Paul Sorenson <aardvark62_at_msn.com>
92    ;;    Phil Sterne <sterne_at_dublin.llnl.gov>
93    ;;    Phil Williams <williams_at_irc.chmcc.org>
94  ;;  ;;
95  ;; CUSTOMIZATION:  ;; CUSTOMIZATION:
96  ;; =============  ;; =============
97  ;;  ;;
98  ;; IDLWAVE has extensive customize support - so if you want to learn  ;; IDLWAVE has extensive customize support; to learn about the
99  ;; about the variables which control the behavior of the mode, use  ;; variables which control the mode's behavior, use `M-x
100  ;; `M-x idlwave-customize'.  ;; idlwave-customize'.
101  ;;  ;;
102  ;; You can set your own preferred values with Customize, or with Lisp  ;; You can set your own preferred values with Customize, or with Lisp
103  ;; code in .emacs.  For an example of what to put into .emacs, check  ;; code in .emacs.  For an example of what to put into .emacs, check
104  ;; the TexInfo documentation or see a complete .emacs at  ;; the TexInfo documentation or see a complete .emacs available at the
105  ;; http://idlwave.org.  ;; website.
106  ;;  ;;
107  ;; KNOWN PROBLEMS:  ;; KNOWN PROBLEMS:
108  ;; ==============  ;; ==============
# Line 107  Line 110 
110  ;;   IDLWAVE support for the IDL-derived PV-WAVE CL language of Visual  ;;   IDLWAVE support for the IDL-derived PV-WAVE CL language of Visual
111  ;;   Numerics, Inc. is growing less and less complete as the two  ;;   Numerics, Inc. is growing less and less complete as the two
112  ;;   languages grow increasingly apart.  The mode probably shouldn't  ;;   languages grow increasingly apart.  The mode probably shouldn't
113  ;;   even have "WAVE" in it's title, but it's catchy, and required to  ;;   even have "WAVE" in it's title, but it's catchy, and was required
114  ;;   avoid conflict with the CORBA idl.el mode.  Caveat WAVEor.  ;;   to avoid conflict with the CORBA idl.el mode.  Caveat WAVEor.
115  ;;  ;;
116  ;;   Moving the point backwards in conjunction with abbrev expansion  ;;   Moving the point backwards in conjunction with abbrev expansion
117  ;;   does not work as I would like it, but this is a problem with  ;;   does not work as I would like it, but this is a problem with
# Line 116  Line 119 
119  ;;   up inserting the character that expanded the abbrev after moving  ;;   up inserting the character that expanded the abbrev after moving
120  ;;   point backward, e.g., "\cl" expanded with a space becomes  ;;   point backward, e.g., "\cl" expanded with a space becomes
121  ;;   "LONG( )" with point before the close paren.  This is solved by  ;;   "LONG( )" with point before the close paren.  This is solved by
122  ;;   using a temporary function in `post-command-hook' - not pretty,  ;;   using a temporary function in `post-command-hook' - not pretty,
123  ;;   but it works.  ;;   but it works.
124  ;;  ;;
125  ;;   Tabs and spaces are treated equally as whitespace when filling a  ;;   Tabs and spaces are treated equally as whitespace when filling a
# Line 126  Line 129 
129  ;;   limited to comments only and occurs only when a comment  ;;   limited to comments only and occurs only when a comment
130  ;;   paragraph is filled via `idlwave-fill-paragraph'.  ;;   paragraph is filled via `idlwave-fill-paragraph'.
131  ;;  ;;
132  ;;   Avoid muti-statement lines (using "&") on block begin and end  ;;   Muti-statement lines (using "&") on block begin and end lines can
133  ;;   lines.  Multi-statement lines can mess up the formatting, for  ;;   ruin the formatting.  For example, multiple end statements on a
134  ;;   example, multiple end statements on a line: endif & endif.  ;;   line: endif & endif.  Using "&" outside of block begin/end lines
135  ;;   Using "&" outside of block begin/end lines should be okay.  ;;   should be okay.
136  ;;  ;;
137  ;;   Determining the expression at point for printing and other  ;;   Determining the expression at point for printing and other
138  ;;   examination commands is somewhat rough: currently only fairly  ;;   examination commands is somewhat rough: currently only fairly
139  ;;   simple entities are found.  You can always drag-select or examine  ;;   simple entities are found.  You can always drag-select or examine
140  ;;   a region.  ;;   a pre-selected region.
141  ;;  ;;
142  ;;   When forcing completion of method keywords, the initial  ;;   When forcing completion of method keywords, the initial
143  ;;   query for a method has multiple entries for some methods.  Would  ;;   query for a method has multiple entries for some methods.  Would
# Line 143  Line 146 
146    
147  ;;; Code:  ;;; Code:
148    
149    
150  (eval-when-compile (require 'cl))  (eval-when-compile (require 'cl))
151    (require 'idlw-help)
152    
153    ;; For XEmacs
154    (unless (fboundp 'line-beginning-position)
155      (defalias 'line-beginning-position 'point-at-bol))
156    (unless (fboundp 'line-end-position)
157      (defalias 'line-end-position 'point-at-eol))
158    (unless (fboundp 'char-valid-p)
159      (defalias 'char-valid-p 'characterp))
160    
161  (eval-and-compile  (eval-and-compile
162    ;; Kludge to allow `defcustom' for Emacs 19.    ;; Kludge to allow `defcustom' for Emacs 19.
# Line 152  Line 165 
165        nil ;; We've got what we needed        nil ;; We've got what we needed
166      ;; We have the old or no custom-library, hack around it!      ;; We have the old or no custom-library, hack around it!
167      (defmacro defgroup (&rest args) nil)      (defmacro defgroup (&rest args) nil)
168      (defmacro defcustom (var value doc &rest args)      (defmacro defcustom (var value doc &rest args)
169        `(defvar ,var ,value ,doc))))        `(defvar ,var ,value ,doc))))
170    
171  (defgroup idlwave nil  (defgroup idlwave nil
172    "Major mode for editing IDL .pro files"    "Major mode for editing IDL .pro files"
173    :tag "IDLWAVE"    :tag "IDLWAVE"
174    :link '(url-link :tag "Home Page"    :link '(url-link :tag "Home Page"
175                     "http://idlwave.org")                     "http://idlwave.org")
176    :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el"    :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el"
177                                  "idlw-shell.el")                                  "idlw-shell.el")
# Line 167  Line 180 
180    :prefix "idlwave"    :prefix "idlwave"
181    :group 'languages)    :group 'languages)
182    
183    
184  ;;; Variables for indentation behavior ---------------------------------------  ;;; Variables for indentation behavior ---------------------------------------
185    
186  (defgroup idlwave-code-formatting nil  (defgroup idlwave-code-formatting nil
# Line 209  maximum amount by which this special ind Line 223  maximum amount by which this special ind
223  standard continuation indentation, otherwise defaulting to a fixed  standard continuation indentation, otherwise defaulting to a fixed
224  offset.  Set to 0 to effectively disable all special continuation  offset.  Set to 0 to effectively disable all special continuation
225  indentation, or to a large number (like 100) to enable it in all  indentation, or to a large number (like 100) to enable it in all
226  cases.  See also `idlwave-indent-top-open-paren', which can override  cases.  See also `idlwave-indent-to-open-paren', which can override
227  this variable."  this variable."
228    :group 'idlwave-code-formatting    :group 'idlwave-code-formatting
229    :type 'integer)    :type 'integer)
# Line 238  yield: Line 252  yield:
252   :group 'idlwave-code-formatting   :group 'idlwave-code-formatting
253    :type 'boolean)    :type 'boolean)
254    
255    (defcustom idlwave-indent-parens-nested nil
256      "*Non-nil means, indent continuation lines with parens by nesting
257    lines at consecutively deeper levels."
258     :group 'idlwave-code-formatting
259      :type 'boolean)
260    
261    
262  (defcustom idlwave-hanging-indent t  (defcustom idlwave-hanging-indent t
263    "*If set non-nil then comment paragraphs are indented under the    "*If set non-nil then comment paragraphs are indented under the
264  hanging indent given by `idlwave-hang-indent-regexp' match in the first line  hanging indent given by `idlwave-hang-indent-regexp' match in the first line
# Line 264  extends to the end of the match for the Line 285  extends to the end of the match for the
285    
286  (defcustom idlwave-auto-fill-split-string t  (defcustom idlwave-auto-fill-split-string t
287    "*If non-nil then auto fill will split strings with the IDL `+' operator.    "*If non-nil then auto fill will split strings with the IDL `+' operator.
288  When the line end falls within a string, string concatenation with the  When the line end falls within a string, string concatenation with the
289  '+' operator will be used to distribute a long string over lines.  '+' operator will be used to distribute a long string over lines.  
290  If nil and a string is split then a terminal beep and warning are issued.  If nil and a string is split then a terminal beep and warning are issued.
291    
292  This variable is ignored when `idlwave-fill-comment-line-only' is  This variable is ignored when `idlwave-fill-comment-line-only' is
# Line 308  the comment is not preceded by whitespac Line 329  the comment is not preceded by whitespac
329  ;; Comments not matching any of the above will be indented as a  ;; Comments not matching any of the above will be indented as a
330  ;; right-margin comment, i.e., to a minimum of `comment-column'.  ;; right-margin comment, i.e., to a minimum of `comment-column'.
331    
   
332  ;;; Routine Info and Completion ---------------------------------------  ;;; Routine Info and Completion ---------------------------------------
333    
334  (defgroup idlwave-routine-info nil  (defgroup idlwave-routine-info nil
335    "Routine Info options for IDLWAVE mode."    "Routine Info options for IDLWAVE mode."
336    :group 'idlwave)    :group 'idlwave)
337    
338    (defcustom idlwave-use-library-catalogs t
339      "*Non-nil means search the IDL path for library catalog files.
340    
341    These files, named .idlwave_catalog, document routine information for
342    individual directories and libraries of IDL .pro files.  Many popular
343    libraries come with catalog files by default, so leaving this on is a
344    usually a good idea.."
345      :group 'idlwave-routine-info
346      :type 'boolean)
347    
348  (defcustom idlwave-init-rinfo-when-idle-after 10  (defcustom idlwave-init-rinfo-when-idle-after 10
349    "*Seconds of idle time before routine info is automatically initialized.    "*Seconds of idle time before routine info is automatically initialized.
350  Initializing the routine info can take long, in particular if a large  Initializing the routine info can take long, in particular if a large
351  library catalog is involved.  When Emacs is idle for more than the number  library catalog is involved.  When Emacs is idle for more than the number
352  of seconds specified by this variable, it starts the initialization.  of seconds specified by this variable, it starts the initialization.
353  The process is split into five steps, in order to keep possible work  The process is split into five steps, in order to keep possible work
354  interruption as short as possible.  If one of the steps finishes, and no  interruption as short as possible.  If one of the steps finishes, and no
355  user input has arrived in the mean time, initialization proceeds immediately  user input has arrived in the mean time, initialization proceeds immediately
356  to the next step.  to the next step.
# Line 373  t         All available Line 402  t         All available
402                 (const :tag "When saving a buffer" save-buffer)                 (const :tag "When saving a buffer" save-buffer)
403                 (const :tag "After a buffer was killed" kill-buffer)                 (const :tag "After a buffer was killed" kill-buffer)
404                 (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer))))                 (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer))))
405                  
406  (defcustom idlwave-rinfo-max-source-lines 5  (defcustom idlwave-rinfo-max-source-lines 5
407    "*Maximum number of source files displayed in the Routine Info window.    "*Maximum number of source files displayed in the Routine Info window.
408  When an integer, it is the maximum number of source files displayed.  When an integer, it is the maximum number of source files displayed.
# Line 382  t means to show all source files." Line 411  t means to show all source files."
411    :type 'integer)    :type 'integer)
412    
413  (defcustom idlwave-library-path nil  (defcustom idlwave-library-path nil
414    "Library path for Windows and MacOS.  Not needed under Unix.    "Library path for Windows and MacOS.  Not needed under Unix.  When
415  When selecting the directories to scan for IDL library routine info,  selecting the directories to scan for IDL user catalog routine info,
416  IDLWAVE can under UNIX query the shell for the exact search path.  IDLWAVE can, under UNIX, query the shell for the exact search path
417  However, under Windows and MacOS, the IDLWAVE shell does not work.  In this  \(the value of !PATH).  However, under Windows and MacOS (pre-OSX),
418  case, this variable specifies the path where IDLWAVE can find library files.  the IDLWAVE shell does not work.  In this case, this variable can be
419  The shell will only be asked when this variable is nil.  set to specify the paths where IDLWAVE can find PRO files.  The shell
420  The value is a list of directories.  A directory preceeded by a `+' will  will only be asked for a list of paths when this variable is nil.  The
421  be searched recursively.  If you set this variable on a UNIX system, the shell  value is a list of directories.  A directory preceeded by a `+' will
422  will not be asked.  be searched recursively.  If you set this variable on a UNIX system,
423  See also `idlwave-system-directory'."  the shell will not be queried.  See also `idlwave-system-directory'."
424    :group 'idlwave-routine-info    :group 'idlwave-routine-info
425    :type '(repeat (directory)))    :type '(repeat (directory)))
426    
427  (defcustom idlwave-system-directory ""  (defcustom idlwave-system-directory ""
428    "The IDL system directory for Windows and MacOS.  Not needed under UNIX.    "The IDL system directory for Windows and MacOS.  Not needed under
429  Set this to the value of the `!DIR' system variable in IDL.  IDLWAVE uses  UNIX.  Set this to the value of the `!DIR' system variable in IDL.
430  this to find out which of the library routines belong to the official system  IDLWAVE uses this to find out which of the library routines belong to
431  library.  All files inside the `lib' subdirectory are considered system  the official system library.  All files inside the `lib' subdirectory
432  library files - so don't install private stuff in this directory.  are considered system library files - so don't install private stuff
433  On UNIX systems, IDLWAVE queries the shell for the value of `!DIR'.  in this directory.  On UNIX systems, IDLWAVE queries the shell for the
434  See also `idlwave-library-path'."  value of `!DIR'.  See also `idlwave-library-path'."
435    :group 'idlwave-routine-info    :group 'idlwave-routine-info
436    :type 'directory)    :type 'directory)
437    
438  (defcustom idlwave-libinfo-file "~/.idlcat.el"  (defcustom idlwave-config-directory
439    "*File for routine information of the IDL library.    (convert-standard-filename "~/.idlwave")
440  When this points to a file, the file will be loaded when IDLWAVE first    "*Directory for configuration files and user-library catalog."
 accesses routine info (or does completion).  
 When you scan the library with `idlwave-create-libinfo-file', this file  
 will be used to store the result."  
441    :group 'idlwave-routine-info    :group 'idlwave-routine-info
442    :type 'file)    :type 'file)
443    
444    (defvar idlwave-user-catalog-file "idlusercat.el")
445    (defvar idlwave-path-file "idlpath.el")
446    
447    (defvar idlwave-libinfo-file nil
448      "*Obsolete variable, no longer used.")
449    
450  (defcustom idlwave-special-lib-alist nil  (defcustom idlwave-special-lib-alist nil
451    "Alist of regular expressions matching special library directories.    "Alist of regular expressions matching special library directories.
452  When listing routine source locations, IDLWAVE gives a short hint where  When listing routine source locations, IDLWAVE gives a short hint where
453  the file defining the routine is located.  By default it lists `SystemLib'  the file defining the routine is located.  By default it lists `SystemLib'
454  for routines in the system library `!DIR/lib' and `Library' for anything  for routines in the system library `!DIR/lib' and `Library' for anything
455  else.  This variable can define additional types.  The car of each entry  else.  This variable can define additional types.  The car of each entry
456  is a regular expression matching the file name (they normally will match  is a regular expression matching the file name (they normally will match
# Line 428  chars are allowed." Line 460  chars are allowed."
460    :type '(repeat    :type '(repeat
461            (cons regexp string)))            (cons regexp string)))
462    
463  (defgroup idlwave-online-help nil  (defcustom idlwave-auto-write-paths t
464    "Online Help options for IDLWAVE mode."    "Write out path (!PATH) and system directory (!DIR) info automatically.  
465    :group 'idlwave)  Path info is needed to locate library catalog files.  If non-nil,
466    whenever the path-list changes as a result of shell-query, etc., it is
467  (defcustom idlwave-help-directory ""  written to file.  Otherwise, the menu option \"Write Paths\" can be
468    "The directory where idlw-help.txt and idlw-help.el are stored."  used to force a write."
469    :group 'idlwave-online-help    :group 'idlwave-routine-info
   :type 'file)  
   
 (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 . 20) (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-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 nil  
   "*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)  
   
 (defface idlwave-help-link-face  
   '((((class color)) (:foreground "Blue"))  
     (t (:weight bold)))  
   "Face for highlighting links into IDLWAVE online help."  
   :group 'idlwave-online-help)  
   
 (defcustom idlwave-help-activate-links-aggressively t  
   "*Non-nil means, make all possible links in help active.  
 This just activates all words which are also a help topic - some links may  
 be misleading."  
   :group 'idlwave-online-help  
470    :type 'boolean)    :type 'boolean)
471    
   
472  (defgroup idlwave-completion nil  (defgroup idlwave-completion nil
473    "Completion options for IDLWAVE mode."    "Completion options for IDLWAVE mode."
474    :prefix "idlwave"    :prefix "idlwave"
# Line 537  be misleading." Line 492  be misleading."
492  This variable determines the case (UPPER/lower/Capitalized...) of  This variable determines the case (UPPER/lower/Capitalized...) of
493  words inserted into the buffer by completion.  The preferred case can  words inserted into the buffer by completion.  The preferred case can
494  be specified separately for routine names, keywords, classes and  be specified separately for routine names, keywords, classes and
495  methods.  methods.
496  This alist should therefore have entries for `routine' (normal  This alist should therefore have entries for `routine' (normal
497  functions and procedures, i.e. non-methods), `keyword', `class', and  functions and procedures, i.e. non-methods), `keyword', `class', and
498  `method'.  Plausible values are  `method'.  Plausible values are
# Line 624  certain methods this assumption is almos Line 579  certain methods this assumption is almos
579  for which to assume this can be set here."  for which to assume this can be set here."
580    :group 'idlwave-routine-info    :group 'idlwave-routine-info
581    :type '(repeat (regexp :tag "Match method:")))    :type '(repeat (regexp :tag "Match method:")))
582      
583    
584  (defcustom idlwave-completion-show-classes 1  (defcustom idlwave-completion-show-classes 1
585    "*Number of classes to show when completing object methods and keywords.    "*Number of classes to show when completing object methods and keywords.
# Line 689  should contain at least two elements: (m Line 644  should contain at least two elements: (m
644  specify if the class should be found during method and keyword  specify if the class should be found during method and keyword
645  completion, respectively.  completion, respectively.
646    
647  The alist may have additional entries specifying exceptions from the  The alist may have additional entries specifying exceptions from the
648  keyword completion rule for specific methods, like INIT or  keyword completion rule for specific methods, like INIT or
649  GETPROPERTY.  In order to turn on class specification for the INIT  GETPROPERTY.  In order to turn on class specification for the INIT
650  method, add an entry (\"INIT\" . t).  The method name must be ALL-CAPS."  method, add an entry (\"INIT\" . t).  The method name must be ALL-CAPS."
# Line 713  particular object method call.  This hap Line 668  particular object method call.  This hap
668  value of the variable `idlwave-query-class'.  value of the variable `idlwave-query-class'.
669    
670  When you specify a class, this information can be stored as a text  When you specify a class, this information can be stored as a text
671  property on the `->' arrow in the source code, so that during the same  property on the `->' arrow in the source code, so that during the same
672  editing session, IDLWAVE will not have to ask again.  When this  editing session, IDLWAVE will not have to ask again.  When this
673  variable is non-nil, IDLWAVE will store and reuse the class information.  variable is non-nil, IDLWAVE will store and reuse the class information.
674  The class stored can be checked and removed with `\\[idlwave-routine-info]'  The class stored can be checked and removed with `\\[idlwave-routine-info]'
# Line 807  Also see help for `idlwave-surround'." Line 762  Also see help for `idlwave-surround'."
762    :type 'boolean)    :type 'boolean)
763    
764  (defcustom idlwave-pad-keyword t  (defcustom idlwave-pad-keyword t
765    "*Non-nil means pad '=' for keywords like assignments.    "*Non-nil means pad '=' in keywords (routine calls or defs) like assignment.
766  Whenever `idlwave-surround' is non-nil then this affects how '=' is padded  Whenever `idlwave-surround' is non-nil then this affects how '=' is
767  for keywords.  If t, it is padded the same as for assignments.  padded for keywords and for variables.  If t, pad the same as for
768  If nil then spaces are removed.  With any other value, spaces are left  assignments.  If nil then spaces are removed.  With any other value,
769  unchanged."  spaces are left unchanged."
770    :group 'idlwave-abbrev-and-indent-action    :group 'idlwave-abbrev-and-indent-action
771    :type '(choice    :type '(choice
772            (const :tag "Pad like assignments" t)            (const :tag "Pad like assignments" t)
# Line 1093  IDL process is made." Line 1048  IDL process is made."
1048    :group 'idlwave-misc    :group 'idlwave-misc
1049    :type 'boolean)    :type 'boolean)
1050    
1051  (defcustom idlwave-default-font-lock-items  (defcustom idlwave-default-font-lock-items
1052    '(pros-and-functions batch-files idlwave-idl-keywords label goto    '(pros-and-functions batch-files idlwave-idl-keywords label goto
1053                         common-blocks class-arrows)                         common-blocks class-arrows)
1054    "Items which should be fontified on the default fontification level 2.    "Items which should be fontified on the default fontification level 2.
# Line 1151  As a user, you should not set this to t. Line 1106  As a user, you should not set this to t.
1106  ;;; Non customization variables  ;;; Non customization variables
1107    
1108  ;;; font-lock mode - Additions by Phil Williams, Ulrik Dickow and  ;;; font-lock mode - Additions by Phil Williams, Ulrik Dickow and
1109  ;;; Simon Marshall <simon@gnu.ai.mit.edu>  ;;; Simon Marshall <simon_at_gnu.ai.mit.edu>
1110  ;;; and Carsten Dominik...  ;;; and Carsten Dominik...
1111    
1112  ;; The following are the reserved words in IDL.  Maybe we should  ;; The following are the reserved words in IDL.  Maybe we should
1113  ;; highlight some more stuff as well?  ;; highlight some more stuff as well?      
1114  ;; Procedure declarations.  Fontify keyword plus procedure name.  ;; Procedure declarations.  Fontify keyword plus procedure name.
1115  (defvar idlwave-idl-keywords  (defvar idlwave-idl-keywords
1116    ;; To update this regexp, update the list of keywords and    ;; To update this regexp, update the list of keywords and
1117    ;; evaluate the form.    ;; evaluate the form.
1118    ;;    (insert    ;;    (insert
1119    ;;     (prin1-to-string    ;;     (prin1-to-string
1120    ;;      (concat    ;;      (concat
1121    ;;       "\\<\\("    ;;       "\\<\\("
1122    ;;       (regexp-opt    ;;       (regexp-opt
1123    ;;        '("and" "or" "xor" "not"    ;;        '("||" "&&" "and" "or" "xor" "not"
1124    ;;          "eq" "ge" "gt" "le" "lt" "ne"    ;;          "eq" "ge" "gt" "le" "lt" "ne"
1125    ;;          "for" "do" "endfor"    ;;          "for" "do" "endfor"
1126    ;;          "if" "then" "endif" "else" "endelse"    ;;          "if" "then" "endif" "else" "endelse"
1127    ;;          "case" "of" "endcase"    ;;          "case" "of" "endcase"
1128    ;;          "switch" "break" "continue" "endswitch"    ;;          "switch" "break" "continue" "endswitch"
1129    ;;          "begin" "end"    ;;          "begin" "end"
1130    ;;          "repeat" "until" "endrep"    ;;          "repeat" "until" "endrep"
1131    ;;          "while" "endwhile"    ;;          "while" "endwhile"
1132    ;;          "goto" "return"    ;;          "goto" "return"
1133    ;;          "inherits" "mod"    ;;          "inherits" "mod"
1134    ;;          "compile_opt" "forward_function"    ;;          "compile_opt" "forward_function"
1135    ;;          "on_error" "on_ioerror"))  ; on_error is not officially reserved    ;;          "on_error" "on_ioerror"))  ; on_error is not officially reserved
1136    ;;       "\\)\\>")))    ;;       "\\)\\>")))
1137    "\\<\\(and\\|b\\(egin\\|reak\\)\\|c\\(ase\\|o\\(mpile_opt\\|ntinue\\)\\)\\|do\\|e\\(lse\\|nd\\(case\\|else\\|for\\|if\\|rep\\|switch\\|while\\)?\\|q\\)\\|for\\(ward_function\\)?\\|g\\(oto\\|[et]\\)\\|i\\(f\\|nherits\\)\\|l[et]\\|mod\\|n\\(e\\|ot\\)\\|o\\(n_\\(error\\|ioerror\\)\\|[fr]\\)\\|re\\(peat\\|turn\\)\\|switch\\|then\\|until\\|while\\|xor\\)\\>")    "\\<\\(&&\\|and\\|b\\(egin\\|reak\\)\\|c\\(ase\\|o\\(mpile_opt\\|ntinue\\)\\)\\|do\\|e\\(lse\\|nd\\(case\\|else\\|for\\|if\\|rep\\|switch\\|while\\)?\\|q\\)\\|for\\(ward_function\\)?\\|g\\(oto\\|[et]\\)\\|i\\(f\\|nherits\\)\\|l[et]\\|mod\\|n\\(e\\|ot\\)\\|o\\(n_\\(error\\|ioerror\\)\\|[fr]\\)\\|re\\(peat\\|turn\\)\\|switch\\|then\\|until\\|while\\|xor\\|||\\)\\>")
1138    
1139    
1140  (let* (;; Procedure declarations.  Fontify keyword plus procedure name.  (let* (;; Procedure declarations.  Fontify keyword plus procedure name.
1141         ;; Function  declarations.  Fontify keyword plus function  name.         ;; Function  declarations.  Fontify keyword plus function  name.
# Line 1195  As a user, you should not set this to t. Line 1151  As a user, you should not set this to t.
1151            (2 font-lock-reference-face nil t)      ; block name            (2 font-lock-reference-face nil t)      ; block name
1152            (font-lock-match-c++-style-declaration-item-and-skip-to-next            (font-lock-match-c++-style-declaration-item-and-skip-to-next
1153             ;; Start with point after block name and comma             ;; Start with point after block name and comma
1154             (goto-char (match-end 0))  ; needed for XEmacs, could be nil             (goto-char (match-end 0))  ; needed for XEmacs, could be nil
1155             nil             nil
1156             (1 font-lock-variable-name-face)       ; variable names             (1 font-lock-variable-name-face)       ; variable names
1157             )))             )))
# Line 1218  As a user, you should not set this to t. Line 1174  As a user, you should not set this to t.
1174            (1 font-lock-keyword-face)            (1 font-lock-keyword-face)
1175            (2 font-lock-reference-face)))            (2 font-lock-reference-face)))
1176    
1177         ;; Tags in structure definitions.  Note that this definition actually         ;; Tags in structure definitions.  Note that this definition
1178         ;; collides with labels, so we have to use the same face.         ;; actually collides with labels, so we have to use the same
1179           ;; face.  It also matches named subscript ranges,
1180           ;; e.g. vec{bottom:top].  No good way around this.
1181         (structtag         (structtag
1182          '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face)))          '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face)))
1183    
# Line 1228  As a user, you should not set this to t. Line 1186  As a user, you should not set this to t.
1186          '("\\({\\|\\<inherits\\s-\\)\\s-*\\([a-zA-Z][a-zA-Z0-9_]*\\)[},\t \n]"          '("\\({\\|\\<inherits\\s-\\)\\s-*\\([a-zA-Z][a-zA-Z0-9_]*\\)[},\t \n]"
1187            (2 font-lock-function-name-face)))            (2 font-lock-function-name-face)))
1188    
1189         ;; Named parameters, like /xlog or ,xrange=[]         ;; Keyword parameters, like /xlog or ,xrange=[]
1190         ;; This is anchored to the comma preceeding the keyword.         ;; This is anchored to the comma preceeding the keyword.
1191         ;; Treats continuation lines, works only during whole buffer         ;; Treats continuation lines, works only during whole buffer
1192         ;; fontification.  Slow, use it only in fancy fontification.         ;; fontification.  Slow, use it only in fancy fontification.
# Line 1248  As a user, you should not set this to t. Line 1206  As a user, you should not set this to t.
1206         ;; All operators (not used because too noisy)         ;; All operators (not used because too noisy)
1207         (all-operators         (all-operators
1208          '("[-*^#+<>/]" (0 font-lock-keyword-face)))          '("[-*^#+<>/]" (0 font-lock-keyword-face)))
1209            
1210         ;; Arrows with text property `idlwave-class'         ;; Arrows with text property `idlwave-class'
1211         (class-arrows         (class-arrows
1212          '(idlwave-match-class-arrows (0 idlwave-class-arrow-face))))          '(idlwave-match-class-arrows (0 idlwave-class-arrow-face))))
# Line 1285  As a user, you should not set this to t. Line 1243  As a user, you should not set this to t.
1243    
1244  (defvar idlwave-font-lock-defaults  (defvar idlwave-font-lock-defaults
1245    '((idlwave-font-lock-keywords    '((idlwave-font-lock-keywords
1246       idlwave-font-lock-keywords-1       idlwave-font-lock-keywords-1
1247       idlwave-font-lock-keywords-2       idlwave-font-lock-keywords-2
1248       idlwave-font-lock-keywords-3)       idlwave-font-lock-keywords-3)
1249      nil t      nil t
1250      ((?$ . "w") (?_ . "w") (?. . "w"))      ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w"))
1251      beginning-of-line))      beginning-of-line))
1252    
1253  (put 'idlwave-mode 'font-lock-defaults  (put 'idlwave-mode 'font-lock-defaults
1254       idlwave-font-lock-defaults) ; XEmacs       idlwave-font-lock-defaults) ; XEmacs
1255    
1256  (defconst idlwave-comment-line-start-skip "^[ \t]*;"  (defconst idlwave-comment-line-start-skip "^[ \t]*;"
# Line 1300  As a user, you should not set this to t. Line 1258  As a user, you should not set this to t.
1258  That is the _beginning_ of a line containing a comment delimiter `;' preceded  That is the _beginning_ of a line containing a comment delimiter `;' preceded
1259  only by whitespace.")  only by whitespace.")
1260    
1261  (defconst idlwave-begin-block-reg  (defconst idlwave-begin-block-reg
1262    "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>"    "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>"
1263    "Regular expression to find the beginning of a block. The case does    "Regular expression to find the beginning of a block. The case does
1264  not matter. The search skips matches in comments.")  not matter. The search skips matches in comments.")
1265    
1266  (defconst idlwave-begin-unit-reg "\\<\\(pro\\|function\\)\\>\\|\\`"  (defconst idlwave-begin-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\`"
1267    "Regular expression to find the beginning of a unit. The case does    "Regular expression to find the beginning of a unit. The case does
1268  not matter.")  not matter.")
1269    
1270  (defconst idlwave-end-unit-reg "\\<\\(pro\\|function\\)\\>\\|\\'"  (defconst idlwave-end-unit-reg "^\\s-*\\(pro\\|function\\)\\>\\|\\'"
1271    "Regular expression to find the line that indicates the end of unit.    "Regular expression to find the line that indicates the end of unit.
1272  This line is the end of buffer or the start of another unit. The case does  This line is the end of buffer or the start of another unit. The case does
1273  not matter. The search skips matches in comments.")  not matter. The search skips matches in comments.")
# Line 1345  to expand generic end statements to thei Line 1303  to expand generic end statements to thei
1303  blocks starting with a BEGIN statement.  The matches must have associations  blocks starting with a BEGIN statement.  The matches must have associations
1304  `idlwave-block-matches'")  `idlwave-block-matches'")
1305    
1306  (defconst idlwave-identifier "[a-zA-Z][a-zA-Z0-9$_]*"  (defconst idlwave-identifier "[a-zA-Z_][a-zA-Z0-9$_]*"
1307    "Regular expression matching an IDL identifier.")    "Regular expression matching an IDL identifier.")
1308    
1309  (defconst idlwave-sysvar (concat "!" idlwave-identifier)  (defconst idlwave-sysvar (concat "!" idlwave-identifier)
# Line 1357  blocks starting with a BEGIN statement. Line 1315  blocks starting with a BEGIN statement.
1315  (defconst idlwave-label (concat idlwave-identifier ":")  (defconst idlwave-label (concat idlwave-identifier ":")
1316    "Regular expression matching IDL labels.")    "Regular expression matching IDL labels.")
1317    
1318    (defconst idlwave-method-call (concat idlwave-identifier  "\\s *->"
1319                                          "\\(\\s *" idlwave-identifier "::\\)?"
1320    ))
1321    
1322  (defconst idlwave-statement-match  (defconst idlwave-statement-match
1323    (list    (list
1324     ;; "endif else" is the only possible "end" that can be     ;; "endif else" is the only possible "end" that can be
# Line 1373  blocks starting with a BEGIN statement. Line 1335  blocks starting with a BEGIN statement.
1335     '(goto . ("goto\\>" nil))     '(goto . ("goto\\>" nil))
1336     '(case . ("case\\>" nil))     '(case . ("case\\>" nil))
1337     '(switch . ("switch\\>" nil))     '(switch . ("switch\\>" nil))
1338     (cons 'call (list (concat idlwave-identifier "\\(\\s *$\\|\\s *,\\)") nil))     (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *"
1339     '(assign . ("[^=>\n]*=" nil)))                               "\\(" idlwave-method-call "\\s *\\)?"
1340                                 idlwave-identifier
1341                                 "\\s *(") nil))
1342       (cons 'call (list (concat
1343                          "\\(" idlwave-method-call "\\s *\\)?"
1344                          idlwave-identifier
1345                          "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil))
1346       (cons 'assign (list (concat
1347                            "\\(" idlwave-variable "\\) *=") nil)))
1348      
1349    "Associated list of statement matching regular expressions.    "Associated list of statement matching regular expressions.
1350  Each regular expression matches the start of an IDL statement.  The  Each regular expression matches the start of an IDL statement.  The
1351  first element of each association is a symbol giving the statement  first element of each association is a symbol giving the statement
# Line 1398  the leftover unidentified statements con Line 1368  the leftover unidentified statements con
1368  ;; Note that this is documented in the v18 manuals as being a string  ;; Note that this is documented in the v18 manuals as being a string
1369  ;; of length one rather than a single character.  ;; of length one rather than a single character.
1370  ;; The code in this file accepts either format for compatibility.  ;; The code in this file accepts either format for compatibility.
1371  (defvar idlwave-comment-indent-char ?\s  (defvar idlwave-comment-indent-char ?\
1372    "Character to be inserted for IDL comment indentation.    "Character to be inserted for IDL comment indentation.
1373  Normally a space.")  Normally a space.")
1374    
# Line 1406  Normally a space.") Line 1376  Normally a space.")
1376    "Character which is inserted as a last character on previous line by    "Character which is inserted as a last character on previous line by
1377     \\[idlwave-split-line] to begin a continuation line.  Normally $.")     \\[idlwave-split-line] to begin a continuation line.  Normally $.")
1378    
1379  (defconst idlwave-mode-version " 4.15")  (defconst idlwave-mode-version "5.5")
1380    
1381  (defmacro idlwave-keyword-abbrev (&rest args)  (defmacro idlwave-keyword-abbrev (&rest args)
1382    "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args."    "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args."
# Line 1564  Capitalize system variables - action onl Line 1534  Capitalize system variables - action onl
1534  (define-key idlwave-mode-map "\C-c\C-m" 'idlwave-doc-modification)  (define-key idlwave-mode-map "\C-c\C-m" 'idlwave-doc-modification)
1535  (define-key idlwave-mode-map "\C-c\C-c" 'idlwave-case)  (define-key idlwave-mode-map "\C-c\C-c" 'idlwave-case)
1536  (define-key idlwave-mode-map "\C-c\C-d" 'idlwave-debug-map)  (define-key idlwave-mode-map "\C-c\C-d" 'idlwave-debug-map)
 (define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run)  
 (define-key idlwave-mode-map "\C-c\C-d\C-b" 'idlwave-shell-break-here)  
1537  (when (and (boundp 'idlwave-shell-debug-modifiers)  (when (and (boundp 'idlwave-shell-debug-modifiers)
1538           (listp idlwave-shell-debug-modifiers)           (listp idlwave-shell-debug-modifiers)
1539           (not (equal idlwave-shell-debug-modifiers '())))           (not (equal idlwave-shell-debug-modifiers '())))
1540    ;; Bind the debug commands also with the special modifiers.    ;; Bind the debug commands also with the special modifiers.
1541    (let ((shift (memq 'shift idlwave-shell-debug-modifiers))    (let ((shift (memq 'shift idlwave-shell-debug-modifiers))
1542          (mods-noshift (delq 'shift          (mods-noshift (delq 'shift
1543                              (copy-sequence idlwave-shell-debug-modifiers))))                              (copy-sequence idlwave-shell-debug-modifiers))))
1544      (define-key idlwave-mode-map      (define-key idlwave-mode-map
1545        (vector (append mods-noshift (list (if shift ?C ?c))))        (vector (append mods-noshift (list (if shift ?C ?c))))
1546        'idlwave-shell-save-and-run)        'idlwave-shell-save-and-run)
1547      (define-key idlwave-mode-map      (define-key idlwave-mode-map
1548        (vector (append mods-noshift (list (if shift ?B ?b))))        (vector (append mods-noshift (list (if shift ?B ?b))))
1549        'idlwave-shell-break-here)))        'idlwave-shell-break-here)
1550        (define-key idlwave-mode-map
1551          (vector (append mods-noshift (list (if shift ?E ?e))))
1552          'idlwave-shell-run-region)))
1553    (define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run)
1554    (define-key idlwave-mode-map "\C-c\C-d\C-b" 'idlwave-shell-break-here)
1555    (define-key idlwave-mode-map "\C-c\C-d\C-e" 'idlwave-shell-run-region)
1556  (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-for)  (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-for)
1557  ;;  (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-function)  ;;  (define-key idlwave-mode-map "\C-c\C-f" 'idlwave-function)
1558  ;;  (define-key idlwave-mode-map "\C-c\C-p" 'idlwave-procedure)  ;;  (define-key idlwave-mode-map "\C-c\C-p" 'idlwave-procedure)
# Line 1597  Capitalize system variables - action onl Line 1571  Capitalize system variables - action onl
1571    "Save and run buffer under the shell." t)    "Save and run buffer under the shell." t)
1572  (autoload 'idlwave-shell-break-here "idlw-shell"  (autoload 'idlwave-shell-break-here "idlw-shell"
1573    "Set breakpoint in current line." t)    "Set breakpoint in current line." t)
1574    (autoload 'idlwave-shell-run-region "idlw-shell"
1575      "Compile and run the region." t)
1576  (define-key idlwave-mode-map "\C-c\C-v"   'idlwave-find-module)  (define-key idlwave-mode-map "\C-c\C-v"   'idlwave-find-module)
1577  (define-key idlwave-mode-map "\C-c?"      'idlwave-routine-info)  (define-key idlwave-mode-map "\C-c?"      'idlwave-routine-info)
1578  (define-key idlwave-mode-map "\M-?"       'idlwave-context-help)  (define-key idlwave-mode-map "\M-?"       'idlwave-context-help)
1579  (define-key idlwave-mode-map [(control meta ?\?)] 'idlwave-online-help)  (define-key idlwave-mode-map [(control meta ?\?)] 'idlwave-online-help)
1580    ;; Pickup both forms of Esc/Meta binding
1581  (define-key idlwave-mode-map [(meta tab)] 'idlwave-complete)  (define-key idlwave-mode-map [(meta tab)] 'idlwave-complete)
1582  (define-key idlwave-mode-map "\C-c\C-i"   'idlwave-update-routine-info)  (define-key idlwave-mode-map [?\e?\t] 'idlwave-complete)
1583  (define-key idlwave-mode-map "\C-c="      'idlwave-resolve)  (define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete)
1584  (define-key idlwave-mode-map  (define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info)
1585    (define-key idlwave-mode-map "\C-c="    'idlwave-resolve)
1586    (define-key idlwave-mode-map
1587    (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])    (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])
1588    'idlwave-mouse-context-help)    'idlwave-mouse-context-help)
1589    
1590  ;; Set action and key bindings.  ;; Set action and key bindings.
1591  ;; See description of the function `idlwave-action-and-binding'.  ;; See description of the function `idlwave-action-and-binding'.
1592  ;; Automatically add spaces for the following characters  ;; Automatically add spaces for the following characters
1593  (idlwave-action-and-binding "&"  '(idlwave-surround -1 -1))  ;(idlwave-action-and-binding "&"  '(idlwave-surround -1 -1 '(?&) 1
1594    ;                                                   (lambda (char) 0)))
1595  (idlwave-action-and-binding "<"  '(idlwave-surround -1 -1))  (idlwave-action-and-binding "<"  '(idlwave-surround -1 -1))
1596  ;; Binding works for both > and ->, by changing the length of the token.  ;; Binding works for both > and ->, by changing the length of the token.
1597  (idlwave-action-and-binding ">"  '(idlwave-surround -1 -1 '(?-) 1  (idlwave-action-and-binding ">"  '(idlwave-surround -1 -1 '(?-) 1
1598                                                      'idlwave-gtr-pad-hook))                                                      'idlwave-gtr-pad-hook))
1599  (idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t)  (idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t)
1600  (idlwave-action-and-binding ","  '(idlwave-surround 0 -1))  (idlwave-action-and-binding ","  '(idlwave-surround 0 -1))
1601    
1602  ;; Automatically add spaces to equal sign if not keyword  ;; Automatically add spaces to equal sign if not keyword
1603  (idlwave-action-and-binding "="  '(idlwave-expand-equal -1 -1))  (idlwave-action-and-binding "="  '(idlwave-expand-equal -1 -1))
1604    
# Line 1647  idlwave-mode-abbrev-table unless TABLE i Line 1628  idlwave-mode-abbrev-table unless TABLE i
1628        (error (apply 'define-abbrev args)))))        (error (apply 'define-abbrev args)))))
1629    
1630  (condition-case nil  (condition-case nil
1631      (modify-syntax-entry (string-to-char idlwave-abbrev-start-char)      (modify-syntax-entry (string-to-char idlwave-abbrev-start-char)
1632                           "w" idlwave-mode-syntax-table)                           "w" idlwave-mode-syntax-table)
1633    (error nil))    (error nil))
1634    
# Line 1720  idlwave-mode-abbrev-table unless TABLE i Line 1701  idlwave-mode-abbrev-table unless TABLE i
1701  (idlwave-define-abbrev "s"  "size()"       (idlwave-keyword-abbrev 1))  (idlwave-define-abbrev "s"  "size()"       (idlwave-keyword-abbrev 1))
1702  (idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1))  (idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1))
1703  (idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0))  (idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0))
1704      
1705  ;; This section is reserved words only. (From IDL user manual)  ;; This section is reserved words only. (From IDL user manual)
1706  ;;  ;;
1707  (idlwave-define-abbrev "and"        "and"       (idlwave-keyword-abbrev 0 t) t)  (idlwave-define-abbrev "and"        "and"       (idlwave-keyword-abbrev 0 t) t)
# Line 1769  idlwave-mode-abbrev-table unless TABLE i Line 1750  idlwave-mode-abbrev-table unless TABLE i
1750  (defvar imenu-extract-index-name-function)  (defvar imenu-extract-index-name-function)
1751  (defvar imenu-prev-index-position-function)  (defvar imenu-prev-index-position-function)
1752  ;; defined later - so just make the compiler hush  ;; defined later - so just make the compiler hush
1753  (defvar idlwave-mode-menu)  (defvar idlwave-mode-menu)  
1754  (defvar idlwave-mode-debug-menu)  (defvar idlwave-mode-debug-menu)
1755    
1756  ;;;###autoload  ;;;###autoload
1757  (defun idlwave-mode ()  (defun idlwave-mode ()
1758    "Major mode for editing IDL and WAVE CL .pro files.    "Major mode for editing IDL source files (version 5.5).
1759    
1760  The main features of this mode are  The main features of this mode are
1761    
# Line 1801  The main features of this mode are Line 1782  The main features of this mode are
1782     relative to the first will be retained.  Use     relative to the first will be retained.  Use
1783     \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these     \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these
1784     comments.  When the variable `idlwave-fill-comment-line-only' is     comments.  When the variable `idlwave-fill-comment-line-only' is
1785     nil, code can also be auto-filled and auto-indented (not     nil, code can also be auto-filled and auto-indented.
    recommended).  
1786    
1787     To convert pre-existing IDL code to your formatting style, mark the     To convert pre-existing IDL code to your formatting style, mark the
1788     entire buffer with \\[mark-whole-buffer] and execute     entire buffer with \\[mark-whole-buffer] and execute
# Line 1817  The main features of this mode are Line 1797  The main features of this mode are
1797     source file of a module.  These commands know about system     source file of a module.  These commands know about system
1798     routines, all routines in idlwave-mode buffers and (when the     routines, all routines in idlwave-mode buffers and (when the
1799     idlwave-shell is active) about all modules currently compiled under     idlwave-shell is active) about all modules currently compiled under
1800     this shell.  Use \\[idlwave-update-routine-info] to update this     this shell.  It also makes use of pre-compiled or custom-scanned
1801       user and library catalogs many popular libraries ship with by
1802       default.  Use \\[idlwave-update-routine-info] to update this
1803     information, which is also used for completion (see item 4).     information, which is also used for completion (see item 4).
1804    
1805  3. Online IDL Help  3. Online IDL Help
1806     ---------------     ---------------
1807     \\[idlwave-context-help] displays the IDL documentation relevant     \\[idlwave-context-help] displays the IDL documentation relevant
1808     for the system variable, keyword, or routine at point.  A single key     for the system variable, keyword, or routine at point.  A single
1809     stroke gets you directly to the right place in the docs.  Two additional     key stroke gets you directly to the right place in the docs.  The
1810     files (an ASCII version of the IDL documentation and a topics file) must     HTML help files package must be installed for this to work -- check
1811     be installed for this - check the IDLWAVE webpage for these files.     the IDLWAVE webpage for the correct package for your version.  See
1812       the manual to configure where and how the HTML help is displayed.
1813    
1814  4. Completion  4. Completion
1815     ----------     ----------
1816     \\[idlwave-complete] completes the names of procedures, functions     \\[idlwave-complete] completes the names of procedures, functions
1817     class names and keyword parameters.  It is context sensitive and     class names, keyword parameters, system variables and tags, class
1818     figures out what is expected at point (procedure/function/keyword).     tags, structure tags, filenames and much more.  It is context
1819     Lower case strings are completed in lower case, other strings in     sensitive and figures out what is expected at point.  Lower case
1820     mixed or upper case.     strings are completed in lower case, other strings in mixed or
1821       upper case.
1822    
1823  5. Code Templates and Abbreviations  5. Code Templates and Abbreviations
1824     --------------------------------     --------------------------------
# Line 1851  The main features of this mode are Line 1835  The main features of this mode are
1835     \\i         IF statement template     \\i         IF statement template
1836     \\elif      IF-ELSE statement template     \\elif      IF-ELSE statement template
1837     \\b         BEGIN     \\b         BEGIN
1838      
1839     For a full list, use \\[idlwave-list-abbrevs].  Some templates also have     For a full list, use \\[idlwave-list-abbrevs].  Some templates also
1840     direct keybindings - see the list of keybindings below.     have direct keybindings - see the list of keybindings below.
1841    
1842     \\[idlwave-doc-header] inserts a documentation header at the beginning of the     \\[idlwave-doc-header] inserts a documentation header at the
1843     current program unit (pro, function or main).  Change log entries     beginning of the current program unit (pro, function or main).
1844     can be added to the current program unit with \\[idlwave-doc-modification].     Change log entries can be added to the current program unit with
1845       \\[idlwave-doc-modification].
1846    
1847  6. Automatic Case Conversion  6. Automatic Case Conversion
1848     -------------------------     -------------------------
# Line 1892  The main features of this mode are Line 1877  The main features of this mode are
1877    
1878    (interactive)    (interactive)
1879    (kill-all-local-variables)    (kill-all-local-variables)
1880      
1881    (if idlwave-startup-message    (if idlwave-startup-message
1882        (message "Emacs IDLWAVE mode version %s." idlwave-mode-version))        (message "Emacs IDLWAVE mode version %s." idlwave-mode-version))
1883    (setq idlwave-startup-message nil)    (setq idlwave-startup-message nil)
1884      
1885    (setq local-abbrev-table idlwave-mode-abbrev-table)    (setq local-abbrev-table idlwave-mode-abbrev-table)
1886    (set-syntax-table idlwave-mode-syntax-table)    (set-syntax-table idlwave-mode-syntax-table)
1887      
1888    (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action)    (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action)
1889      
1890    (make-local-variable idlwave-comment-indent-function)    (make-local-variable idlwave-comment-indent-function)
1891    (set idlwave-comment-indent-function 'idlwave-comment-hook)    (set idlwave-comment-indent-function 'idlwave-comment-hook)
1892      
1893    (set (make-local-variable 'comment-start-skip) ";+[ \t]*")    (set (make-local-variable 'comment-start-skip) ";+[ \t]*")
1894    (set (make-local-variable 'comment-start) ";")    (set (make-local-variable 'comment-start) ";")
1895    (set (make-local-variable 'require-final-newline) t)    (set (make-local-variable 'require-final-newline) t)
1896    (set (make-local-variable 'abbrev-all-caps) t)    (set (make-local-variable 'abbrev-all-caps) t)
1897    (set (make-local-variable 'indent-tabs-mode) nil)    (set (make-local-variable 'indent-tabs-mode) nil)
1898    (set (make-local-variable 'completion-ignore-case) t)    (set (make-local-variable 'completion-ignore-case) t)
1899      
1900    (use-local-map idlwave-mode-map)    (use-local-map idlwave-mode-map)
1901    
1902    (when (featurep 'easymenu)    (when (featurep 'easymenu)
# Line 1921  The main features of this mode are Line 1906  The main features of this mode are
1906    (setq mode-name "IDLWAVE")    (setq mode-name "IDLWAVE")
1907    (setq major-mode 'idlwave-mode)    (setq major-mode 'idlwave-mode)
1908    (setq abbrev-mode t)    (setq abbrev-mode t)
1909      
1910    (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill)    (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill)
1911    (setq comment-end "")    (setq comment-end "")
1912    (set (make-local-variable 'comment-multi-line) nil)    (set (make-local-variable 'comment-multi-line) nil)
1913    (set (make-local-variable 'paragraph-separate)    (set (make-local-variable 'paragraph-separate)
1914         "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$")         "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$")
1915    (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]")    (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]")
1916    (set (make-local-variable 'paragraph-ignore-fill-prefix) nil)    (set (make-local-variable 'paragraph-ignore-fill-prefix) nil)
# Line 1934  The main features of this mode are Line 1919  The main features of this mode are
1919    ;; Set tag table list to use IDLTAGS as file name.    ;; Set tag table list to use IDLTAGS as file name.
1920    (if (boundp 'tag-table-alist)    (if (boundp 'tag-table-alist)
1921        (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS")))        (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS")))
1922      
1923    ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow    ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow
1924    ;; Following line is for Emacs - XEmacs uses the corresponding porperty    ;; Following line is for Emacs - XEmacs uses the corresponding property
1925    ;; on the `idlwave-mode' symbol.    ;; on the `idlwave-mode' symbol.
1926    (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults)    (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults)
1927    
# Line 1961  The main features of this mode are Line 1946  The main features of this mode are
1946    (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local)    (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local)
1947    (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local)    (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local)
1948    
1949      ;; Setup directories and file, if necessary
1950      (idlwave-setup)
1951    
1952    ;; Update the routine info with info about current buffer?    ;; Update the routine info with info about current buffer?
1953    (idlwave-new-buffer-update)    (idlwave-new-buffer-update)
1954    
1955    ;; Run the mode hook    ;; Run the mode hook
1956    (run-hooks 'idlwave-mode-hook))    (run-hooks 'idlwave-mode-hook))
1957    
1958    (defvar idlwave-setup-done nil)
1959    (defun idlwave-setup ()
1960      (unless idlwave-setup-done
1961        (if (not (file-directory-p idlwave-config-directory))
1962            (make-directory idlwave-config-directory))
1963        (setq idlwave-user-catalog-file (expand-file-name
1964                                         idlwave-user-catalog-file
1965                                         idlwave-config-directory)
1966            idlwave-path-file (expand-file-name
1967                               idlwave-path-file
1968                               idlwave-config-directory))
1969        (idlwave-read-paths)  ; we may need these early
1970        (setq idlwave-setup-done t)))
1971    
1972  ;;  ;;
1973  ;;  Done with start up and initialization code.  ;; Code Formatting ----------------------------------------------------
1974  ;;  The remaining routines are the code formatting functions.  ;;
 ;;  
1975    
1976  (defun idlwave-push-mark (&rest rest)  (defun idlwave-push-mark (&rest rest)
1977    "Push mark for compatibility with Emacs 18/19."    "Push mark for compatibility with Emacs 18/19."
# Line 2062  Returns point if comment found and nil o Line 2063  Returns point if comment found and nil o
2063  (defvar zmacs-regions)  (defvar zmacs-regions)
2064  (defvar mark-active)  (defvar mark-active)
2065  (defun idlwave-region-active-p ()  (defun idlwave-region-active-p ()
2066    "Is transien-mark-mode on and the region active?    "Is transient-mark-mode on and the region active?
2067  Works on both Emacs and XEmacs."  Works on both Emacs and XEmacs."
2068    (if (featurep 'xemacs)    (if (featurep 'xemacs)
2069        (and zmacs-regions (region-active-p))        (and zmacs-regions (region-active-p))
# Line 2099  An END token must be preceded by whitesp Line 2100  An END token must be preceded by whitesp
2100  Also checks if the correct end statement has been used."  Also checks if the correct end statement has been used."
2101    ;; All end statements are reserved words    ;; All end statements are reserved words
2102    ;; Re-indent end line    ;; Re-indent end line
2103    (insert-char ?\  1) ;; So indent, etc. work well    ;;(insert-char ?\  1) ;; So indent, etc. work well
2104    (backward-char 1)    ;;(backward-char 1)
2105    (let* ((pos (point-marker))    (let* ((pos (point-marker))
2106           (last-abbrev-marker (copy-marker last-abbrev-location))           (last-abbrev-marker (copy-marker last-abbrev-location))
2107           (eol-pos (save-excursion (end-of-line) (point)))           (eol-pos (save-excursion (end-of-line) (point)))
2108           begin-pos end-pos end end1 )           begin-pos end-pos end end1 )
2109      (if idlwave-reindent-end  (idlwave-indent-line))      (if idlwave-reindent-end  (idlwave-indent-line))
2110        (setq last-abbrev-location (marker-position last-abbrev-marker))
2111      (when (and (idlwave-check-abbrev 0 t)      (when (and (idlwave-check-abbrev 0 t)
2112                 idlwave-show-block)                 idlwave-show-block)
2113        (save-excursion        (save-excursion
# Line 2119  Also checks if the correct end statement Line 2120  Also checks if the correct end statement
2120          (if (> end-pos eol-pos)          (if (> end-pos eol-pos)
2121              (setq end-pos pos))              (setq end-pos pos))
2122          (goto-char end-pos)          (goto-char end-pos)
2123          (setq end (buffer-substring          (setq end (buffer-substring
2124                     (progn                     (progn
2125                       (skip-chars-backward "a-zA-Z")                       (skip-chars-backward "a-zA-Z")
2126                       (point))                       (point))
# Line 2141  Also checks if the correct end statement Line 2142  Also checks if the correct end statement
2142              (sit-for 1))              (sit-for 1))
2143             (t             (t
2144              (beep)              (beep)
2145              (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?"              (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?"
2146                       end1 end)                       end1 end)
2147              (sit-for 1)))))))              (sit-for 1))))))))
2148    (delete-char 1))    ;;(delete-char 1))
2149    
2150  (defun idlwave-block-master ()  (defun idlwave-block-master ()
2151    (let ((case-fold-search t))    (let ((case-fold-search t))
# Line 2153  Also checks if the correct end statement Line 2154  Also checks if the correct end statement
2154         ((looking-at "pro\\|case\\|switch\\|function\\>")         ((looking-at "pro\\|case\\|switch\\|function\\>")
2155          (assoc (downcase (match-string 0)) idlwave-block-matches))          (assoc (downcase (match-string 0)) idlwave-block-matches))
2156         ((looking-at "begin\\>")         ((looking-at "begin\\>")
2157          (let ((limit (save-excursion          (let ((limit (save-excursion
2158                         (idlwave-beginning-of-statement)                         (idlwave-beginning-of-statement)
2159                         (point))))                         (point))))
2160            (cond            (cond
2161               ((re-search-backward ":[ \t]*\\=" limit t)
2162                ;; seems to be a case thing
2163                '("begin" . "end"))
2164             ((re-search-backward idlwave-block-match-regexp limit t)             ((re-search-backward idlwave-block-match-regexp limit t)
2165              (assoc (downcase (match-string 1))              (assoc (downcase (match-string 1))
2166                     idlwave-block-matches))                     idlwave-block-matches))
            ;;((re-search-backward ":[ \t]*\\=" limit t)  
            ;; ;; seems to be a case thing  
            ;; '("begin" . "end"))  
2167             (t             (t
2168              ;; Just a nromal block              ;; Just a normal block
2169              '("begin" . "end")))))              '("begin" . "end")))))
2170         (t nil)))))         (t nil)))))
2171    
# Line 2182  Also checks if the correct end statement Line 2183  Also checks if the correct end statement
2183      (insert "end")      (insert "end")
2184      (idlwave-show-begin)))      (idlwave-show-begin)))
2185    
2186  (defun idlwave-gtr-pad-hook (char)  (defun idlwave-gtr-pad-hook (char)
2187    "Let the > symbol expand around -> if present.  The new token length    "Let the > symbol expand around -> if present.  The new token length
2188  is returned."  is returned."  
2189    2)    2)
2190    
2191  (defun idlwave-surround (&optional before after escape-chars length ec-hook)  (defun idlwave-surround (&optional before after escape-chars length ec-hook)
# Line 2214  return value." Line 2215  return value."
2215      (let* ((length (or length 1)) ; establish a default for LENGTH      (let* ((length (or length 1)) ; establish a default for LENGTH
2216             (prev-char (char-after (- (point) (1+ length)))))             (prev-char (char-after (- (point) (1+ length)))))
2217        (when (or (not (memq prev-char escape-chars))        (when (or (not (memq prev-char escape-chars))
2218                  (and (fboundp ec-hook)                  (and (fboundp ec-hook)
2219                       (setq length                       (setq length
2220                             (save-excursion (funcall ec-hook prev-char)))))                             (save-excursion (funcall ec-hook prev-char)))))
2221          (backward-char length)          (backward-char length)
2222          (save-restriction          (save-restriction
# Line 2437  Returns non-nil if successfull." Line 2438  Returns non-nil if successfull."
2438          (let ((eos (save-excursion          (let ((eos (save-excursion
2439                       (idlwave-block-jump-out -1 'nomark)                       (idlwave-block-jump-out -1 'nomark)
2440                       (point))))                       (point))))
2441            (if (setq status (idlwave-find-key            (if (setq status (idlwave-find-key
2442                              idlwave-end-block-reg -1 'nomark eos))                              idlwave-end-block-reg -1 'nomark eos))
2443                (idlwave-beginning-of-statement)                (idlwave-beginning-of-statement)
2444              (message "No nested block before beginning of containing block.")))              (message "No nested block before beginning of containing block.")))
# Line 2445  Returns non-nil if successfull." Line 2446  Returns non-nil if successfull."
2446        (let ((eos (save-excursion        (let ((eos (save-excursion
2447                     (idlwave-block-jump-out 1 'nomark)                     (idlwave-block-jump-out 1 'nomark)
2448                     (point))))                     (point))))
2449          (if (setq status (idlwave-find-key          (if (setq status (idlwave-find-key
2450                            idlwave-begin-block-reg 1 'nomark eos))                            idlwave-begin-block-reg 1 'nomark eos))
2451              (idlwave-end-of-statement)              (idlwave-end-of-statement)
2452            (message "No nested block before end of containing block."))))            (message "No nested block before end of containing block."))))
# Line 2459  The marks are pushed." Line 2460  The marks are pushed."
2460          (here (point)))          (here (point)))
2461      (goto-char (point-max))      (goto-char (point-max))
2462      (if (re-search-backward idlwave-doclib-start nil t)      (if (re-search-backward idlwave-doclib-start nil t)
2463          (progn          (progn
2464            (setq beg (progn (beginning-of-line) (point)))            (setq beg (progn (beginning-of-line) (point)))
2465            (if (re-search-forward idlwave-doclib-end nil t)            (if (re-search-forward idlwave-doclib-end nil t)
2466                (progn                (progn
# Line 2493  actual statement." Line 2494  actual statement."
2494     ((eq major-mode 'idlwave-shell-mode)     ((eq major-mode 'idlwave-shell-mode)
2495      (if (re-search-backward idlwave-shell-prompt-pattern nil t)      (if (re-search-backward idlwave-shell-prompt-pattern nil t)
2496          (goto-char (match-end 0))))          (goto-char (match-end 0))))
2497     (t     (t  
2498      (if (save-excursion (forward-line -1) (idlwave-is-continuation-line))      (if (save-excursion (forward-line -1) (idlwave-is-continuation-line))
2499          (idlwave-previous-statement)          (idlwave-previous-statement)
2500        (beginning-of-line)))))        (beginning-of-line)))))
# Line 2570  If not in a statement just moves to end Line 2571  If not in a statement just moves to end
2571    (let ((save-point (point)))    (let ((save-point (point)))
2572      (when (re-search-forward ".*&" lim t)      (when (re-search-forward ".*&" lim t)
2573        (goto-char (match-end 0))        (goto-char (match-end 0))
2574        (if (idlwave-in-quote) (goto-char save-point)))        (if (idlwave-quoted) (goto-char save-point)))
2575      (point)))      (point)))
2576    
2577  (defun idlwave-skip-label-or-case ()  (defun idlwave-skip-label-or-case ()
# Line 2585  If there is no label point is not moved Line 2586  If there is no label point is not moved
2586    ;; - not in parenthesis (like a[0:3])    ;; - not in parenthesis (like a[0:3])
2587    ;; - not followed by another ":" in explicit class, ala a->b::c    ;; - not followed by another ":" in explicit class, ala a->b::c
2588    ;; As many in this mode, this function is heuristic and not an exact    ;; As many in this mode, this function is heuristic and not an exact
2589    ;; parser.    ;; parser.
2590    (let* ((start (point))    (let* ((start (point))
2591           (eos (save-excursion (idlwave-end-of-statement) (point)))           (eos (save-excursion (idlwave-end-of-statement) (point)))
2592           (end (idlwave-find-key ":" 1 'nomark eos)))           (end (idlwave-find-key ":" 1 'nomark eos)))
# Line 2612  substatement." Line 2613  substatement."
2613          st nst last)          st nst last)
2614      (idlwave-beginning-of-statement)      (idlwave-beginning-of-statement)
2615      (idlwave-skip-label-or-case)      (idlwave-skip-label-or-case)
2616      (idlwave-skip-multi-commands orig)      (if (< (point) orig)
2617            (idlwave-skip-multi-commands orig))
2618      (setq last (point))      (setq last (point))
2619      ;; Continue looking for substatements until we are past orig      ;; Continue looking for substatements until we are past orig
2620      (while (and (<= (point) orig) (not (eobp)))      (while (and (<= (point) orig) (not (eobp)))
# Line 2654  statement." Line 2656  statement."
2656            (append st (match-end 0))))))            (append st (match-end 0))))))
2657    
2658  (defun idlwave-expand-equal (&optional before after)  (defun idlwave-expand-equal (&optional before after)
2659    "Pad '=' with spaces.    "Pad '=' with spaces.  Two cases: Assignment statement, and keyword
2660  Two cases: Assignment statement, and keyword assignment.  assignment.  Which case is determined using
2661  The case is determined using `idlwave-start-of-substatement' and  `idlwave-start-of-substatement' and `idlwave-statement-type'.  The
2662  `idlwave-statement-type'.  equal sign will be surrounded by BEFORE and AFTER blanks.  If
2663  The equal sign will be surrounded by BEFORE and AFTER blanks.  `idlwave-pad-keyword' is t then keyword assignment is treated just
 If `idlwave-pad-keyword' is t then keyword assignment is treated just  
2664  like assignment statements.  When nil, spaces are removed for keyword  like assignment statements.  When nil, spaces are removed for keyword
2665  assignment.  Any other value keeps the current space around the `='.  assignment.  Any other value keeps the current space around the `='.
2666  Limits in for loops are treated as keyword assignment.  Limits in for loops are treated as keyword assignment.  
2667  See `idlwave-surround'. "  
2668    ;; Even though idlwave-surround checks `idlwave-surround-by-blank' this  Starting with IDL 6.0, a number of op= assignments are available.
2669    ;; check saves the time of finding the statement type.  Since ambiguities of the form:
2670    
2671    r and= b
2672    rand= b
2673    
2674    can occur, alphanumeric operator assignment will never be pre-padded,
2675    only post-padded.  You must use a space before these to disambiguate
2676    \(not just for padding, but for proper parsing by IDL too!).  Other
2677    operators, such as ##=, ^=, etc., will be pre-padded.
2678    
2679    See `idlwave-surround'."
2680    (if idlwave-surround-by-blank    (if idlwave-surround-by-blank
2681        (let ((st (save-excursion        (let
2682                    (idlwave-start-of-substatement t)            ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=")
2683                    (idlwave-statement-type))))             (an-ops
2684                "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=")
2685          (cond ((or (and (equal (car (car st)) 'assign)             (len 1))
2686                          (equal (cdr st) (point)))          
2687                     (eq t idlwave-pad-keyword))          (save-excursion
2688                 ;; An assignment statement or keywor and we need padding            (let ((case-fold-search t))
2689                 (idlwave-surround before after))              (backward-char)
2690                ((null idlwave-pad-keyword)              (if (or
2691                 ;; Spaces should be removed at a keyword                   (re-search-backward non-an-ops nil t)
2692                 (idlwave-surround 0 0))                   ;; Why doesn't ##? work for both?
2693                (t)))))                   (re-search-backward "\\(#\\)\\=" nil t))
2694                    (setq len (1+ (length (match-string 1))))
2695                  (when (re-search-backward an-ops nil t)
2696                    (setq begin nil) ; won't modify begin
2697                    (setq len (1+ (length (match-string 1))))))))
2698            
2699            (if (eq t idlwave-pad-keyword)  
2700                ;; Everything gets padded equally
2701                (idlwave-surround before after nil len)
2702              ;; Treating keywords/for variables specially...
2703              (let ((st (save-excursion   ; To catch "for" variables
2704                          (idlwave-start-of-substatement t)
2705                          (idlwave-statement-type)))
2706                    (what (save-excursion ; To catch keywords
2707                            (skip-chars-backward "= \t")
2708                            (nth 2 (idlwave-where)))))
2709                (cond ((or (memq what '(function-keyword procedure-keyword))
2710                           (memq (caar st) '(for pdef)))
2711                       (cond
2712                        ((null idlwave-pad-keyword)
2713                         (idlwave-surround 0 0)
2714                         ) ; remove space
2715                        (t))) ; leave any spaces alone
2716                      (t (idlwave-surround before after nil len))))))))
2717                  
2718    
2719  (defun idlwave-indent-and-action (&optional arg)  (defun idlwave-indent-and-action (&optional arg)
2720    "Call `idlwave-indent-line' and do expand actions.    "Call `idlwave-indent-line' and do expand actions.
2721  With prefix ARG non-nil, indent the entire sub-statement."  With prefix ARG non-nil, indent the entire sub-statement."
2722    (interactive "p")    (interactive "p")
2723    (save-excursion    (save-excursion
2724      (if (and idlwave-expand-generic-end      (if (and idlwave-expand-generic-end
2725               (re-search-backward "\\<\\(end\\)\\s-*\\="               (re-search-backward "\\<\\(end\\)\\s-*\\="
2726                                   (max 0 (- (point) 10)) t)                                   (max 0 (- (point) 10)) t)
2727               (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)"))               (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)"))
2728          (progn (goto-char (match-end 1))          (progn (goto-char (match-end 1))
2729                 ;;Expand the END abbreviation, just as RET or Space would have.                 ;;Expand the END abbreviation, just as RET or Space would have.
2730                 (if abbrev-mode (expand-abbrev)                 (if abbrev-mode (expand-abbrev)
2731                   (idlwave-show-begin)))))                   (idlwave-show-begin)))))
2732    (if arg    (when (and (not arg) current-prefix-arg)
2733        (setq arg current-prefix-arg)
2734        (setq current-prefix-arg nil))
2735      (if arg
2736        (idlwave-indent-statement)        (idlwave-indent-statement)
2737      (idlwave-indent-line t)))      (idlwave-indent-line t)))
2738    
# Line 2821  Inserts spaces before markers at point." Line 2859  Inserts spaces before markers at point."
2859               (idlwave-is-continuation-line)))               (idlwave-is-continuation-line)))
2860        (idlwave-calculate-cont-indent))        (idlwave-calculate-cont-indent))
2861       ;; calculate indent based on previous and current statements       ;; calculate indent based on previous and current statements
2862       (t (let ((the-indent       (t (let* (beg-prev-pos
2863                 ;; calculate indent based on previous statement                 (the-indent
2864                 (save-excursion                  ;; calculate indent based on previous statement
2865                   (cond                  (save-excursion
2866                    ((idlwave-previous-statement)                    (cond
2867                     0)                     ;; Beginning of file
2868                    ;; Main block                     ((prog1
2869                    ((idlwave-look-at idlwave-begin-unit-reg t)                          (idlwave-previous-statement)
2870                     (+ (idlwave-current-statement-indent)                        (setq beg-prev-pos (point)))
2871                        idlwave-main-block-indent))                      0)
2872                    ;; Begin block                     ;; Main block
2873                    ((idlwave-look-at idlwave-begin-block-reg t)                     ((idlwave-look-at idlwave-begin-unit-reg t)
2874                     (+ (idlwave-current-statement-indent)                      (+ (idlwave-current-statement-indent)
2875                        idlwave-block-indent))                         idlwave-main-block-indent))
2876                    ((idlwave-look-at idlwave-end-block-reg t)                     ;; Begin block
2877                     (- (idlwave-current-statement-indent)                     ((idlwave-look-at idlwave-begin-block-reg t)
2878                        idlwave-end-offset                      (+ (idlwave-min-current-statement-indent)
2879                        idlwave-block-indent))                         idlwave-block-indent))
2880                    ((idlwave-current-statement-indent))))))                     ;; End Block
2881                       ((idlwave-look-at idlwave-end-block-reg t)
2882                        (progn
2883                          ;; Match to the *beginning* of the block opener
2884                          (goto-char beg-prev-pos)
2885                          (idlwave-block-jump-out -1 'nomark) ; go to begin block
2886                          (idlwave-min-current-statement-indent)))
2887                          ;;                      idlwave-end-offset
2888                          ;;                      idlwave-block-indent))
2889                      
2890                       ;; Default to current indent
2891                       ((idlwave-current-statement-indent))))))
2892            ;; adjust the indentation based on the current statement            ;; adjust the indentation based on the current statement
2893            (cond            (cond
2894             ;; End block             ;; End block
# Line 2848  Inserts spaces before markers at point." Line 2897  Inserts spaces before markers at point."
2897             (the-indent)))))))             (the-indent)))))))
2898    
2899  ;;  ;;
2900  ;; Parentheses balacing/indent  ;; Parentheses indent
2901  ;;  ;;
2902    
2903  (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp)  (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp)
2904    "Calculate the continuation indent inside a paren group.    "Calculate the continuation indent inside a paren group.
2905  Returns a cons-cell with (open . indent), where open is the  Returns a cons-cell with (open . indent), where open is the
2906  location of the open paren"  location of the open paren"
2907    (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg))))    (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg))))
2908      ;; Found an innermost open paren.      ;; Found an innermost open paren.
# Line 2862  location of the open paren" Line 2911  location of the open paren"
2911        ;; Line up with next word unless this is a closing paren.        ;; Line up with next word unless this is a closing paren.
2912        (cons open        (cons open
2913              (cond              (cond
2914                 ;; Plain Kernighan-style nested indent
2915                 (idlwave-indent-parens-nested
2916                  (+ idlwave-continuation-indent (idlwave-current-indent)))
2917    
2918               ;; This is a closed paren - line up under open paren.               ;; This is a closed paren - line up under open paren.
2919               (close-exp               (close-exp
2920                (current-column))                (current-column))
2921               ;; Empty (or just comment) - just line up next to paren  
2922                 ;; Empty (or just comment) follows -- revert to basic indent
2923               ((progn               ((progn
2924                  ;; Skip paren                  ;; Skip paren
2925                  (forward-char 1)                  (forward-char 1)
2926                  (looking-at "[ \t$]*\\(;.*\\)?$"))                  (looking-at "[ \t$]*\\(;.*\\)?$"))
2927                (current-column))                nil)
2928               ;; Line up with first word after blank space  
2929                 ;; Line up with first word after any blank space
2930               ((progn               ((progn
2931                  (skip-chars-forward " \t")                  (skip-chars-forward " \t")
2932                  (current-column))))))))                  (current-column))))))))
2933    
2934  (defun idlwave-calculate-cont-indent ()  (defun idlwave-calculate-cont-indent ()
2935    "Calculates the IDL continuation indent column from the previous statement.    "Calculates the IDL continuation indent column from the previous
2936  Note that here previous statement means the beginning of the current  statement.  Note that here previous statement usually means the
2937  statement if this statement is a continuation of the previous line."  beginning of the current statement if this statement is a continuation
2938    of the previous line.  Various special types of continuations,
2939    including assignments, routine definitions, and parenthetical
2940    groupings, are treated separately."
2941    (save-excursion    (save-excursion
2942      (let* (open      (let* ((case-fold-search t)
            (case-fold-search t)  
2943             (end-reg (progn (beginning-of-line) (point)))             (end-reg (progn (beginning-of-line) (point)))
2944             (close-exp (progn (skip-chars-forward " \t") (looking-at "\\s)")))             (beg-last-statement (save-excursion (idlwave-previous-statement)
2945  ;           (beg-reg (progn (idlwave-previous-statement) (point)))                                                 (point)))
2946             (beg-reg (progn ;; Use substatement indent unless it's this line             (beg-reg (progn (idlwave-start-of-substatement 'pre)
2947                        (idlwave-start-of-substatement 'pre)                             (if (eq (line-beginning-position) end-reg)
2948                        (if (eq (line-beginning-position) end-reg)                                 (goto-char beg-last-statement)
2949                            (idlwave-previous-statement))                               (point))))
2950                        (point)))             (basic-indent (+ (idlwave-min-current-statement-indent end-reg)
2951             (cur-indent (idlwave-current-indent))                              idlwave-continuation-indent))
2952             (else-cont (and (goto-char end-reg) (looking-at "[ \t]*else")))             fancy-nonparen-indent fancy-paren-indent)
2953             (basic-indent           ;; The basic, non-fancy indent        (cond
2954              (+ cur-indent idlwave-continuation-indent))         ;; Align then with its matching if, etc.
2955             (fancy-nonparen-indent  ;; A smarter indent for routine/assignments         ((let ((matchers '(("\\<if\\>" . "[ \t]*then")
2956              ;; Try without parens first:                            ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else")
2957              (progn                            ("\\<\\(for\\|while\\)\\>" . "[ \t]*do")
2958                (goto-char beg-reg)                            ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" .
2959                (while (idlwave-look-at "&"))  ; skip over continued statements                             "[ \t]*until")
2960                (cond                            ("\\<case\\>" . "[ \t]*of")))
2961                 ;; A continued Procedure call or definition                match cont-re)
2962                 ((progn            (goto-char end-reg)
2963                    (idlwave-look-at "^[ \t]*\\(pro\\|function\\)") ;skip over            (and
2964                    (looking-at "[ \t]*\\([a-zA-Z0-9$_]+[ \t]*->[ \t]*\\)?[a-zA-Z][:a-zA-Z0-9$_]*[ \t]*\\(,\\)[ \t]*"))             (setq cont-re
2965                  (goto-char (match-end 0))                   (catch 'exit
2966                  ;; Comment only, or blank line with "$"?  Align with ,                     (while (setq match (car matchers))
2967                  (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$"))                       (if (looking-at (cdr match))
2968                      (goto-char (match-end 2)))                           (throw 'exit (car match)))
2969                  (current-column))                       (setq matchers (cdr matchers)))))
2970               (idlwave-find-key cont-re -1 'nomark beg-last-statement)))
2971                 ;; Continued assignment (with =),          (if (looking-at "end") ;; that one's special
2972                 ((looking-at "[ \t]*[][().a-zA-Z0-9$_]+[ \t]*\\(=\\)[ \t]*")              (- (idlwave-current-indent)
2973                  (goto-char (match-end 0))                 (+ idlwave-block-indent idlwave-end-offset))
2974                  ;; Comment only?  Align with =            (idlwave-current-indent)))
2975                  (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$"))  
2976                      (progn         ;; Indent in from the previous line for continuing statements
2977                        (goto-char (match-end 1))         ((let ((matchers '("\\<then\\>"
2978                        (if idlwave-surround-by-blank                            "\\<do\\>"
2979                            (1+ (current-column))                            "\\<repeat\\>"
2980                          (current-column)))                            "\\<else\\>"))
2981                    (current-column))))))                match)
2982             (fancy-nonparen-indent-allowed            (catch 'exit
2983              (and fancy-nonparen-indent              (goto-char end-reg)
2984                   (< (- fancy-nonparen-indent basic-indent)              (if (/= (forward-line -1) 0)
2985                      idlwave-max-extra-continuation-indent)))                  (throw 'exit nil))
2986             (fancy-paren-indent-cons     ;; A smarter indent for paren groups              (while (setq match (car matchers))
2987              ;; Look for any enclosing parens                (if (looking-at (concat ".*" match "[ \t]*\\$[ \t]*"
2988              (idlwave-calculate-paren-indent beg-reg end-reg close-exp))                                        "\\(;.*\\)?$"))
2989             (fancy-paren-open (car fancy-paren-indent-cons))                    (throw 'exit t))
2990             (fancy-paren-indent (cdr fancy-paren-indent-cons))                (setq matchers (cdr matchers)))))
2991             (fancy-paren-indent-allowed          (+ idlwave-continuation-indent (idlwave-current-indent)))
2992              (and fancy-paren-indent  
2993                   (or idlwave-indent-to-open-paren ;; override         ;; Parenthetical indent, either traditional or Kernighan style
2994                       (< (- fancy-paren-indent basic-indent)         ((setq fancy-paren-indent
2995                          idlwave-max-extra-continuation-indent))))                (let* ((end-reg end-reg)
2996              fancy-enclosing-paren-indent)                      (close-exp (progn
2997        (cond                                   (goto-char end-reg)
2998         ;; else continuations are always standard                                   (skip-chars-forward " \t")
2999         (else-cont                                   (looking-at "\\s)")))
3000          cur-indent)                      indent-cons)
3001                    (catch 'loop
3002         ;; an allowed parenthesis-indent                    (while (setq indent-cons (idlwave-calculate-paren-indent
3003         (fancy-paren-indent-allowed                                              beg-reg end-reg close-exp))
3004                        ;; First permitted containing paren
3005                        (if (or
3006                             idlwave-indent-to-open-paren
3007                             idlwave-indent-parens-nested
3008                             (null (cdr indent-cons))
3009                             (< (- (cdr indent-cons) basic-indent)
3010                                idlwave-max-extra-continuation-indent))
3011                            (throw 'loop (cdr indent-cons)))
3012                        (setq end-reg (car indent-cons))))))
3013          fancy-paren-indent)          fancy-paren-indent)
3014    
3015         ;; a disallowed paren indent nested inside one or more other         ;; A continued assignment, or procedure call/definition
3016         ;; parens: indent relative to the first allowed enclosing paren         ((and
3017         ;; set, if any... if it's actually a greater indent, just use           (> idlwave-max-extra-continuation-indent 0)
3018         ;; the fancy-paren-indent anyway.           (setq fancy-nonparen-indent
3019         ((and fancy-paren-indent                 (progn
3020               (not fancy-paren-indent-allowed)                   (goto-char beg-reg)
3021               (setq fancy-enclosing-paren-indent                   (while (idlwave-look-at "&"))  ; skip continued statements
3022                     (let ((enclose-open fancy-paren-open)                   (cond
3023                           enclose-indent-cons                    ;; A continued Procedure call or definition
3024                           enclose-indent)                    ((progn
3025                       (catch 'loop                       (idlwave-look-at "^[ \t]*\\(pro\\|function\\)") ;skip over
3026                         (while (setq enclose-indent-cons                       (looking-at "[ \t]*\\([a-zA-Z0-9.$_]+[ \t]*->[ \t]*\\)?[a-zA-Z][:a-zA-Z0-9$_]*[ \t]*\\(,\\)[ \t]*"))
3027                                      (idlwave-calculate-paren-indent                     (goto-char (match-end 0))
3028                                       beg-reg (max (1- enclose-open) beg-reg)                     ;; Comment only, or blank line with "$"?  Basic indent.
3029                                       nil)                     (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$"))
3030                                      enclose-open   (car enclose-indent-cons)                         nil
3031                                      enclose-indent (cdr enclose-indent-cons))                       (current-column)))
3032                           (if (< (- enclose-indent basic-indent)                    
3033                                  idlwave-max-extra-continuation-indent)                    ;; Continued assignment (with =):
3034                               (throw 'loop enclose-indent)))))))                    ((catch 'assign ;
3035          (min fancy-paren-indent                       (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*")
3036               (+ fancy-enclosing-paren-indent idlwave-continuation-indent)))                         (goto-char (match-end 0))
3037                           (if (null (idlwave-what-function beg-reg))
3038         ;; a disallowed paren indent inside another type: indent relative                             (throw 'assign t))))
3039         ((and fancy-paren-indent                     (unless (or
3040               (not fancy-paren-indent-allowed)                              (idlwave-in-quote)
3041               fancy-nonparen-indent-allowed )                              (looking-at "[ \t$]*\\(;.*\\)?$") ; use basic
3042          (+ fancy-nonparen-indent idlwave-continuation-indent))                              (save-excursion
3043                                  (goto-char beg-last-statement)
3044         ;; an allowed nonparen-only indent                                (eq (caar (idlwave-statement-type)) 'for)))
3045         (fancy-nonparen-indent-allowed                       (current-column))))))
3046          fancy-nonparen-indent)           (< (- fancy-nonparen-indent basic-indent)
3047                idlwave-max-extra-continuation-indent))
3048         ;; everything else          (if fancy-paren-indent ;calculated but disallowed paren indent
3049         (t              (+ fancy-nonparen-indent idlwave-continuation-indent)
3050          basic-indent)))))            fancy-nonparen-indent))
3051    
3052           ;; Basic indent, by default
3053           (t basic-indent)))))
3054    
3055    
3056    
3057  (defun idlwave-find-key (key-re &optional dir nomark limit)  (defun idlwave-find-key (key-re &optional dir nomark limit)
3058    "Move to next match of the regular expression KEY-RE.    "Move to next match of the regular expression KEY-RE.
# Line 3001  Return value is the beginning of the mat Line 3072  Return value is the beginning of the mat
3072         (catch 'exit         (catch 'exit
3073           (while (funcall search-func key-re limit t)           (while (funcall search-func key-re limit t)
3074             (if (not (idlwave-quoted))             (if (not (idlwave-quoted))
3075                 (throw 'exit (setq found (match-beginning 0))))))))                 (throw 'exit (setq found (match-beginning 0)))
3076                 (if (or (and (> dir 0) (eobp))
3077                         (and (< dir 0) (bobp)))
3078                     (throw 'exit nil)))))))
3079      (if found      (if found
3080          (progn          (progn
3081            (if (not nomark) (push-mark))            (if (not nomark) (push-mark))
# Line 3022  possibility of unbalanced blocks." Line 3096  possibility of unbalanced blocks."
3096    (let* ((here (point))    (let* ((here (point))
3097           (case-fold-search t)           (case-fold-search t)
3098           (limit (if (>= dir 0) (point-max) (point-min)))           (limit (if (>= dir 0) (point-max) (point-min)))
3099           (block-limit (if (>= dir 0)           (block-limit (if (>= dir 0)
3100                            idlwave-begin-block-reg                            idlwave-begin-block-reg
3101                          idlwave-end-block-reg))                          idlwave-end-block-reg))
3102           found           found
# Line 3033  possibility of unbalanced blocks." Line 3107  possibility of unbalanced blocks."
3107                                 (idlwave-find-key                                 (idlwave-find-key
3108                                  idlwave-begin-unit-reg dir t limit)                                  idlwave-begin-unit-reg dir t limit)
3109                               (end-of-line)                               (end-of-line)
3110                               (idlwave-find-key                               (idlwave-find-key
3111                                idlwave-end-unit-reg dir t limit)))                                idlwave-end-unit-reg dir t limit)))
3112                           limit)))                           limit)))
3113      (if (>= dir 0) (end-of-line)) ;Make sure we are in current block      (if (>= dir 0) (end-of-line)) ;Make sure we are in current block
# Line 3046  possibility of unbalanced blocks." Line 3120  possibility of unbalanced blocks."
3120      (if (not found) (goto-char unit-limit)      (if (not found) (goto-char unit-limit)
3121        (if (>= dir 0) (forward-word 1)))))        (if (>= dir 0) (forward-word 1)))))
3122    
3123  (defun idlwave-current-statement-indent ()  (defun idlwave-min-current-statement-indent (&optional end-reg)
3124      "The minimum indent in the current statement."
3125      (idlwave-beginning-of-statement)
3126      (if (not (idlwave-is-continuation-line))
3127          (idlwave-current-indent)
3128        (let ((min (idlwave-current-indent)) comm-or-empty)
3129          (while (and (= (forward-line 1) 0)
3130                      (or (setq comm-or-empty (idlwave-is-comment-or-empty-line))
3131                          (idlwave-is-continuation-line))
3132                      (or (null end-reg) (< (point) end-reg)))
3133            (unless comm-or-empty (setq min (min min (idlwave-current-indent)))))
3134          (if (or comm-or-empty (and end-reg (>= (point) end-reg)))
3135              min
3136            (min min (idlwave-current-indent))))))
3137    
3138    (defun idlwave-current-statement-indent (&optional last-line)
3139    "Return indentation of the current statement.    "Return indentation of the current statement.
3140  If in a statement, moves to beginning of statement before finding indent."  If in a statement, moves to beginning of statement before finding indent."
3141    (idlwave-beginning-of-statement)    (if last-line
3142          (idlwave-end-of-statement)
3143        (idlwave-beginning-of-statement))
3144    (idlwave-current-indent))    (idlwave-current-indent))
3145    
3146  (defun idlwave-current-indent ()  (defun idlwave-current-indent ()
# Line 3067  Skips any whitespace. Returns 0 if the e Line 3158  Skips any whitespace. Returns 0 if the e
3158  Blank or comment-only lines following regular continuation lines (with  Blank or comment-only lines following regular continuation lines (with
3159  `$') count as continuations too."  `$') count as continuations too."
3160    (save-excursion    (save-excursion
3161      (or      (or
3162       (idlwave-look-at "\\<\\$")       (idlwave-look-at "\\<\\$")
3163       (catch 'loop       (catch 'loop
3164         (while (and (looking-at "^[ \t]*\\(;.*\\)?$")         (while (and (looking-at "^[ \t]*\\(;.*\\)?$")
3165                     (eq (forward-line -1) 0))                     (eq (forward-line -1) 0))
3166           (if (idlwave-look-at "\\<\\$") (throw 'loop t)))))))           (if (idlwave-look-at "\\<\\$") (throw 'loop t)))))))
3167    
# Line 3168  ignored." Line 3259  ignored."
3259                                            (beginning-of-line) (point))                                            (beginning-of-line) (point))
3260                                          (point))))                                          (point))))
3261                 "[^;]"))                 "[^;]"))
3262            
3263          ;; Mark the beginning and end of the paragraph          ;; Mark the beginning and end of the paragraph
3264          (goto-char bcl)          (goto-char bcl)
3265          (while (and (looking-at fill-prefix-reg)          (while (and (looking-at fill-prefix-reg)
# Line 3232  ignored." Line 3323  ignored."
3323                        (insert (make-string diff ?\ ))))                        (insert (make-string diff ?\ ))))
3324                  (forward-line -1))                  (forward-line -1))
3325                )                )
3326              
3327            ;; No hang. Instead find minimum indentation of paragraph            ;; No hang. Instead find minimum indentation of paragraph
3328            ;; after first line.            ;; after first line.
3329            ;; For the following while statement, since START is at the            ;; For the following while statement, since START is at the
# Line 3264  ignored." Line 3355  ignored."
3355                    t)                    t)
3356                   (current-column))                   (current-column))
3357                 indent))                 indent))
3358            
3359          ;; try to keep point at its original place          ;; try to keep point at its original place
3360          (goto-char here)          (goto-char here)
3361    
# Line 3313  If not found returns nil." Line 3404  If not found returns nil."
3404            (current-column)))))            (current-column)))))
3405    
3406  (defun idlwave-auto-fill ()  (defun idlwave-auto-fill ()
3407    "Called to break lines in auto fill mode.    "Called to break lines in auto fill mode.  
3408  Only fills comment lines if `idlwave-fill-comment-line-only' is non-nil.  Only fills non-comment lines if `idlwave-fill-comment-line-only' is
3409  Places a continuation character at the end of the line  non-nil.  Places a continuation character at the end of the line if
3410  if not in a comment.  Splits strings with IDL concatenation operator  not in a comment.  Splits strings with IDL concatenation operator `+'
3411  `+' if `idlwave-auto-fill-split-string is non-nil."  if `idlwave-auto-fill-split-string' is non-nil."
3412    (if (<= (current-column) fill-column)    (if (<= (current-column) fill-column)
3413        nil                             ; do not to fill        nil                             ; do not to fill
3414      (if (or (not idlwave-fill-comment-line-only)      (if (or (not idlwave-fill-comment-line-only)
# Line 3330  if not in a comment.  Splits strings wit Line 3421  if not in a comment.  Splits strings wit
3421            ;; Prevent actions do-auto-fill which calls indent-line-function.            ;; Prevent actions do-auto-fill which calls indent-line-function.
3422            (let (idlwave-do-actions            (let (idlwave-do-actions
3423                  (paragraph-start ".")                  (paragraph-start ".")
3424                  (paragraph-separate "."))                  (paragraph-separate ".")
3425                    (fill-nobreak-predicate
3426                     (if (and (idlwave-in-quote)
3427                              idlwave-auto-fill-split-string)
3428                         (lambda () ;; We'll need 5 spaces for " ' + $"
3429                           (<= (- fill-column (current-column)) 5)
3430                           ))))
3431              (do-auto-fill))              (do-auto-fill))
3432            (save-excursion            (save-excursion
3433              (end-of-line 0)              (end-of-line 0)
# Line 3365  if not in a comment.  Splits strings wit Line 3462  if not in a comment.  Splits strings wit
3462              (if (save-excursion              (if (save-excursion
3463                    (end-of-line 0)                    (end-of-line 0)
3464                    (idlwave-in-comment))                    (idlwave-in-comment))
3465                  ;; Splitting a non-line comment.                  ;; Splitting a non-full-line comment.
3466                  ;; Insert the comment delimiter from split line                  ;; Insert the comment delimiter from split line
3467                  (progn                  (progn
3468                    (save-excursion                    (save-excursion
# Line 3422  automatically breaks the line at a previ Line 3519  automatically breaks the line at a previ
3519      ;; update mode-line      ;; update mode-line
3520      (set-buffer-modified-p (buffer-modified-p))))      (set-buffer-modified-p (buffer-modified-p))))
3521    
3522    ;(defun idlwave-fill-routine-call ()
3523    ;  "Fill a routine definition or statement, indenting appropriately."
3524    ;  (let ((where (idlwave-where)))))
3525    
3526    
3527  (defun idlwave-doc-header (&optional nomark )  (defun idlwave-doc-header (&optional nomark )
3528    "Insert a documentation header at the beginning of the unit.    "Insert a documentation header at the beginning of the unit.
3529  Inserts the value of the variable idlwave-file-header. Sets mark before  Inserts the value of the variable idlwave-file-header. Sets mark before
# Line 3453  is non-nil." Line 3555  is non-nil."
3555    (insert (current-time-string))    (insert (current-time-string))
3556    (insert ", " (user-full-name))    (insert ", " (user-full-name))
3557    (if (boundp 'user-mail-address)    (if (boundp 'user-mail-address)
3558        (insert " <" user-mail-address ">")        (insert " <" user-mail-address ">")
3559      (insert " <" (user-login-name) "@" (system-name) ">"))      (insert " <" (user-login-name) "@" (system-name) ">"))
3560    ;; Remove extra spaces from line    ;; Remove extra spaces from line
3561    (idlwave-fill-paragraph)    (idlwave-fill-paragraph)
# Line 3479  location on mark ring so that the user c Line 3581  location on mark ring so that the user c
3581               (setq end (match-end 0)))               (setq end (match-end 0)))
3582          (progn          (progn
3583            (goto-char beg)            (goto-char beg)
3584            (if (re-search-forward            (if (re-search-forward
3585                 (concat idlwave-doc-modifications-keyword ":")                 (concat idlwave-doc-modifications-keyword ":")
3586                 end t)                 end t)
3587                (end-of-line)                (end-of-line)
# Line 3539  constants - a double quote followed by a Line 3641  constants - a double quote followed by a
3641        (while  (< endq start)        (while  (< endq start)
3642          ;; Find string start          ;; Find string start
3643          ;; Don't find an octal constant beginning with a double quote          ;; Don't find an octal constant beginning with a double quote
3644          (if (re-search-forward "\"[^0-7]\\|'\\|\"$" eol 'lim)          (if (re-search-forward "[\"']" eol 'lim)
3645              ;; Find the string end.              ;; Find the string end.
3646              ;; In IDL, two consecutive delimiters after the start of a              ;; In IDL, two consecutive delimiters after the start of a
3647              ;; string act as an              ;; string act as an
# Line 3577  constants - a double quote followed by a Line 3679  constants - a double quote followed by a
3679       (not (idlwave-in-quote))       (not (idlwave-in-quote))
3680       (save-excursion       (save-excursion
3681         (forward-char)         (forward-char)
3682         (re-search-backward (concat "\\(" idlwave-idl-keywords         (re-search-backward (concat "\\(" idlwave-idl-keywords
3683                                     "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t)))))                                     "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t)))))
3684    
3685    
# Line 3623  unless the optional second argument NOIN Line 3725  unless the optional second argument NOIN
3725            (indent-region beg end nil))            (indent-region beg end nil))
3726        (if (stringp prompt)        (if (stringp prompt)
3727            (message prompt)))))            (message prompt)))))
3728      
3729  (defun idlwave-rw-case (string)  (defun idlwave-rw-case (string)
3730    "Make STRING have the case required by `idlwave-reserved-word-upcase'."    "Make STRING have the case required by `idlwave-reserved-word-upcase'."
3731    (if idlwave-reserved-word-upcase    (if idlwave-reserved-word-upcase
# Line 3641  unless the optional second argument NOIN Line 3743  unless the optional second argument NOIN
3743  (defun idlwave-case ()  (defun idlwave-case ()
3744    "Build skeleton IDL case statement."    "Build skeleton IDL case statement."
3745    (interactive)    (interactive)
3746    (idlwave-template    (idlwave-template
3747     (idlwave-rw-case "case")     (idlwave-rw-case "case")
3748     (idlwave-rw-case " of\n\nendcase")     (idlwave-rw-case " of\n\nendcase")
3749     "Selector expression"))     "Selector expression"))
# Line 3649  unless the optional second argument NOIN Line 3751  unless the optional second argument NOIN
3751  (defun idlwave-switch ()  (defun idlwave-switch ()
3752    "Build skeleton IDL switch statement."    "Build skeleton IDL switch statement."
3753    (interactive)    (interactive)
3754    (idlwave-template    (idlwave-template
3755     (idlwave-rw-case "switch")     (idlwave-rw-case "switch")
3756     (idlwave-rw-case " of\n\nendswitch")     (idlwave-rw-case " of\n\nendswitch")
3757     "Selector expression"))     "Selector expression"))
# Line 3657  unless the optional second argument NOIN Line 3759  unless the optional second argument NOIN
3759  (defun idlwave-for ()  (defun idlwave-for ()
3760    "Build skeleton for loop statment."    "Build skeleton for loop statment."
3761    (interactive)    (interactive)
3762    (idlwave-template    (idlwave-template
3763     (idlwave-rw-case "for")     (idlwave-rw-case "for")
3764     (idlwave-rw-case " do begin\n\nendfor")     (idlwave-rw-case " do begin\n\nendfor")
3765     "Loop expression"))     "Loop expression"))
# Line 3672  unless the optional second argument NOIN Line 3774  unless the optional second argument NOIN
3774    
3775  (defun idlwave-procedure ()  (defun idlwave-procedure ()
3776    (interactive)    (interactive)
3777    (idlwave-template    (idlwave-template
3778     (idlwave-rw-case "pro")     (idlwave-rw-case "pro")
3779     (idlwave-rw-case "\n\nreturn\nend")     (idlwave-rw-case "\n\nreturn\nend")
3780     "Procedure name"))     "Procedure name"))
3781    
3782  (defun idlwave-function ()  (defun idlwave-function ()
3783    (interactive)    (interactive)
3784    (idlwave-template    (idlwave-template
3785     (idlwave-rw-case "function")     (idlwave-rw-case "function")
3786     (idlwave-rw-case "\n\nreturn\nend")     (idlwave-rw-case "\n\nreturn\nend")
3787     "Function name"))     "Function name"))
# Line 3693  unless the optional second argument NOIN Line 3795  unless the optional second argument NOIN
3795    
3796  (defun idlwave-while ()  (defun idlwave-while ()
3797    (interactive)    (interactive)
3798    (idlwave-template    (idlwave-template
3799     (idlwave-rw-case "while")     (idlwave-rw-case "while")
3800     (idlwave-rw-case " do begin\n\nendwhile")     (idlwave-rw-case " do begin\n\nendwhile")
3801     "Entry condition"))     "Entry condition"))
# Line 3742  Buffers in this list may be killed by `i Line 3844  Buffers in this list may be killed by `i
3844          buf)))          buf)))
3845    
3846  (defun idlwave-kill-autoloaded-buffers ()  (defun idlwave-kill-autoloaded-buffers ()
3847    "Cleanup by killing buffers created automatically by IDLWAVE.    "Kill buffers created automatically by IDLWAVE.
3848  Function prompts for a letter to identify the buffers to kill.  Function prompts for a letter to identify the buffers to kill.
3849  Possible letters are:  Possible letters are:
3850    
# Line 3772  Buffer containing unsaved changes requir Line 3874  Buffer containing unsaved changes requir
3874  (defun idlwave-count-outlawed-buffers (tag)  (defun idlwave-count-outlawed-buffers (tag)
3875    "How many outlawed buffers have tag TAG?"    "How many outlawed buffers have tag TAG?"
3876    (length (delq nil    (length (delq nil
3877                  (mapcar                  (mapcar
3878                   (lambda (x) (eq (cdr x) tag))                   (lambda (x) (eq (cdr x) tag))
3879                   idlwave-outlawed-buffers))))                   idlwave-outlawed-buffers))))
3880    
3881  (defun idlwave-do-kill-autoloaded-buffers (&rest reasons)  (defun idlwave-do-kill-autoloaded-buffers (&rest reasons)
# Line 3787  Buffer containing unsaved changes requir Line 3889  Buffer containing unsaved changes requir
3889                     (memq (cdr entry) reasons))                     (memq (cdr entry) reasons))
3890                 (kill-buffer (car entry))                 (kill-buffer (car entry))
3891                 (incf cnt)                 (incf cnt)
3892                 (setq idlwave-outlawed-buffers                 (setq idlwave-outlawed-buffers
3893                       (delq entry idlwave-outlawed-buffers)))                       (delq entry idlwave-outlawed-buffers)))
3894          (setq idlwave-outlawed-buffers          (setq idlwave-outlawed-buffers
3895                (delq entry idlwave-outlawed-buffers))))                (delq entry idlwave-outlawed-buffers))))
3896      (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s"))))      (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s"))))
3897    
# Line 3801  Intended for `after-save-hook'." Line 3903  Intended for `after-save-hook'."
3903           (entry (assq buf idlwave-outlawed-buffers)))           (entry (assq buf idlwave-outlawed-buffers)))
3904      ;; Revoke license      ;; Revoke license
3905      (if entry      (if entry
3906          (setq idlwave-outlawed-buffers          (setq idlwave-outlawed-buffers
3907                (delq entry idlwave-outlawed-buffers)))                (delq entry idlwave-outlawed-buffers)))
3908      ;; Remove this function from the hook.      ;; Remove this function from the hook.
3909      (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local)))      (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local)))
# Line 3816  Intended for `after-save-hook'." Line 3918  Intended for `after-save-hook'."
3918          (if (file-regular-p          (if (file-regular-p
3919               (setq efile (expand-file-name file dir)))               (setq efile (expand-file-name file dir)))
3920              (throw 'exit efile))))))              (throw 'exit efile))))))
3921    
3922  (defun idlwave-expand-lib-file-name (file)  (defun idlwave-expand-lib-file-name (file)
3923    ;; Find FILE on the scanned lib path and return a buffer visiting it    ;; Find FILE on the scanned lib path and return a buffer visiting it
3924    (cond    ;; This is for, e.g., finding source with no user catalog
3925      (cond
3926     ((null file) nil)     ((null file) nil)
    ((string-match "\\`\\({\\([0-9]+\\)}/\\)\\(.*\\)" file)  
     (expand-file-name (match-string 3 file)  
                       (car (nth (1- (string-to-int (match-string 2 file)))  
                                 idlwave-path-alist))))  
3927     ((file-name-absolute-p file) file)     ((file-name-absolute-p file) file)
3928     (t (idlwave-locate-lib-file file))))     (t (idlwave-locate-lib-file file))))
3929    
# Line 3837  you specify /." Line 3937  you specify /."
3937    (interactive)    (interactive)
3938    (let (directory directories cmd append status numdirs dir getsubdirs    (let (directory directories cmd append status numdirs dir getsubdirs
3939                    buffer save_buffer files numfiles item errbuf)                    buffer save_buffer files numfiles item errbuf)
3940        
3941      ;;      ;;
3942      ;; Read list of directories      ;; Read list of directories
3943      (setq directory (read-string "Tag Directories: " "."))      (setq directory (read-string "Tag Directories: " "."))
# Line 3888  you specify /." Line 3988  you specify /."
3988                    (progn                    (progn
3989                      (message (concat "Tagging " item "..."))                      (message (concat "Tagging " item "..."))
3990                      (setq errbuf (get-buffer-create "*idltags-error*"))                      (setq errbuf (get-buffer-create "*idltags-error*"))
3991                      (setq status                      (setq status (+ status
3992                            (+ status                                      (if (eq 0 (call-process
3993                               (if (eq 0 (call-process "sh" nil errbuf nil "-c"                                                 "sh" nil errbuf nil "-c"
3994                                                       (concat cmd append item)))                                                 (concat cmd append item)))
3995                                   0                                          0
3996                                 1)))                                          1)))
3997                      ;;                      ;;
3998                      ;; Append additional tags                      ;; Append additional tags
3999                      (setq append " --append ")                      (setq append " --append ")
# Line 3903  you specify /." Line 4003  you specify /."
4003                    (setq numfiles (1+ numfiles))                    (setq numfiles (1+ numfiles))
4004                    (setq item (nth numfiles files))                    (setq item (nth numfiles files))
4005                    )))                    )))
4006                
4007              (setq numdirs (1+ numdirs))              (setq numdirs (1+ numdirs))
4008              (setq dir (nth numdirs directories)))              (setq dir (nth numdirs directories)))
4009          (progn          (progn
4010            (setq numdirs (1+ numdirs))            (setq numdirs (1+ numdirs))
4011            (setq dir (nth numdirs directories)))))            (setq dir (nth numdirs directories)))))
4012        
4013      (setq errbuf (get-buffer-create "*idltags-error*"))      (setq errbuf (get-buffer-create "*idltags-error*"))
4014      (if (= status 0)      (if (= status 0)
4015          (kill-buffer errbuf))          (kill-buffer errbuf))
# Line 3932  blank lines." Line 4032  blank lines."
4032        ;; skip blank lines        ;; skip blank lines
4033        (skip-chars-forward " \t\n")        (skip-chars-forward " \t\n")
4034        (if (looking-at (concat "[ \t]*\\(" comment-start "+\\)"))        (if (looking-at (concat "[ \t]*\\(" comment-start "+\\)"))
4035            (comment-region beg end            (if (fboundp 'uncomment-region)
4036                            (- (length (buffer-substring                (uncomment-region beg end)
4037                                        (match-beginning 1)              (comment-region beg end
4038                                        (match-end 1)))))                              (- (length (buffer-substring
4039          (comment-region beg end)))))                                          (match-beginning 1)
4040                                            (match-end 1))))))
4041            (comment-region beg end)))))
4042    
4043    
4044  ;; ----------------------------------------------------------------------------  ;; ----------------------------------------------------------------------------
# Line 3952  blank lines." Line 4054  blank lines."
4054  ;; For the completion and routine info function, we want to normalize  ;; For the completion and routine info function, we want to normalize
4055  ;; the case of procedure names etc.  We do this by "interning" these  ;; the case of procedure names etc.  We do this by "interning" these
4056  ;; string is a hand-crafted way.  Hashes are used to map the downcase  ;; string is a hand-crafted way.  Hashes are used to map the downcase
4057  ;; version of the strings to the cased versions.  Since these cased  ;; version of the strings to the cased versions.  Most *-sint-*
4058  ;; versions are really lisp objects, we can use `eq' to search, which  ;; variables consist of *two* hashes, a buffer+shell, followed by a
4059  ;; is a large performance boost.  ;; system hash.  The former is re-scanned, and the latter takes case
4060  ;; All new strings need to be "sinterned".  We do this as early as  ;; precedence.
4061  ;; possible after getting these strings from completion or buffer  ;;
4062  ;; substrings.  So most of the code can simply assume to deal with  ;; Since these cased versions are really lisp objects, we can use `eq'
4063  ;; "sinterned" strings.  The only exception is that the functions  ;; to search, which is a large performance boost.  All new strings
4064  ;; which scan whole buffers for routine information do not intern the  ;; need to be "sinterned".  We do this as early as possible after
4065  ;; grabbed strings.  This is only done afterwards.  Therefore in these  ;; getting these strings from completion or buffer substrings.  So
4066  ;; functions it is *not* safe to assume the strings can be compared  ;; most of the code can simply assume to deal with "sinterned"
4067  ;; with `eq' and be fed into the routine assq functions.  ;; strings.  The only exception is that the functions which scan whole
4068    ;; buffers for routine information do not intern the grabbed strings.
4069    ;; This is only done afterwards.  Therefore in these functions it is
4070    ;; *not* safe to assume the strings can be compared with `eq' and be
4071    ;; fed into the routine assq functions.
4072    
4073  ;; Here we define the hashing functions.  ;; Here we define the hashing functions.
4074    
# Line 3971  blank lines." Line 4077  blank lines."
4077  (defvar idlwave-sint-keywords '(nil))  (defvar idlwave-sint-keywords '(nil))
4078  (defvar idlwave-sint-methods  '(nil))  (defvar idlwave-sint-methods  '(nil))
4079  (defvar idlwave-sint-classes  '(nil))  (defvar idlwave-sint-classes  '(nil))
4080  (defvar idlwave-sint-files    '(nil))  (defvar idlwave-sint-dirs    '(nil))
4081    (defvar idlwave-sint-libnames '(nil))
4082    
4083  (defun idlwave-reset-sintern (&optional what)  (defun idlwave-reset-sintern (&optional what)
4084    "Reset all sintern hashes."    "Reset all sintern hashes."
4085    ;; Make sure the hash functions are accessible.    ;; Make sure the hash functions are accessible.
4086    (if (or (not (fboundp 'gethash))    (if (or (not (fboundp 'gethash))
4087            (not (fboundp 'puthash)))            (not (fboundp 'puthash)))
4088        (progn        (progn
4089          (require 'cl)          (require 'cl)
4090          (or (fboundp 'puthash)          (or (fboundp 'puthash)
4091              (defalias 'puthash 'cl-puthash))))              (defalias 'puthash 'cl-puthash))))
# Line 3997  blank lines." Line 4104  blank lines."
4104        ;; Reset the system & library hash        ;; Reset the system & library hash
4105        (loop for entry in entries        (loop for entry in entries
4106          for var = (car entry) for size = (nth 1 entry)          for var = (car entry) for size = (nth 1 entry)
4107          do (setcdr (symbol-value var)          do (setcdr (symbol-value var)
4108                     (make-hash-table ':size size ':test 'equal)))                     (make-hash-table ':size size ':test 'equal)))
4109        (setq idlwave-sint-files nil))        (setq idlwave-sint-dirs nil
4110                idlwave-sint-libnames nil))
4111    
4112      (when (or (eq what t) (eq what 'bufsh)      (when (or (eq what t) (eq what 'bufsh)
4113                (null (car idlwave-sint-routines)))                (null (car idlwave-sint-routines)))
4114        ;; Reset the buffer & shell hash        ;; Reset the buffer & shell hash
4115        (loop for entry in entries        (loop for entry in entries
4116          for var = (car entry) for size = (nth 1 entry)          for var = (car entry) for size = (nth 1 entry)
4117          do (setcar (symbol-value var)          do (setcar (symbol-value var)
4118                     (make-hash-table ':size size ':test 'equal))))))                     (make-hash-table ':size size ':test 'equal))))))
4119    
4120  (defun idlwave-sintern-routine-or-method (name &optional class set)  (defun idlwave-sintern-routine-or-method (name &optional class set)
# Line 4049  blank lines." Line 4157  blank lines."
4157          (set (idlwave-sintern-set name 'class idlwave-sint-classes set))          (set (idlwave-sintern-set name 'class idlwave-sint-classes set))
4158          (name)))          (name)))
4159    
4160  (defun idlwave-sintern-file (name &optional set)  (defun idlwave-sintern-dir (dir &optional set)
4161    (car (or (member name idlwave-sint-files)    (car (or (member dir idlwave-sint-dirs)
4162             (setq idlwave-sint-files (cons name idlwave-sint-files)))))             (setq idlwave-sint-dirs (cons dir idlwave-sint-dirs)))))
4163    (defun idlwave-sintern-libname (name &optional set)
4164      (car (or (member name idlwave-sint-libnames)
4165               (setq idlwave-sint-libnames (cons name idlwave-sint-libnames)))))
4166    
4167  (defun idlwave-sintern-set (name type tables set)  (defun idlwave-sintern-set (name type tables set)
4168    (let* ((func (or (cdr (assq type idlwave-completion-case))    (let* ((func (or (cdr (assq type idlwave-completion-case))
# Line 4061  blank lines." Line 4172  blank lines."
4172      (puthash (downcase name) iname table)      (puthash (downcase name) iname table)
4173      iname))      iname))
4174    
4175  (defun idlwave-sintern-rinfo-list (list &optional set)  (defun idlwave-sintern-keyword-list (kwd-list &optional set)
4176    "Sintern all strings in the rinfo LIST.  With optional parameter SET:    "Sintern a set of keywords (file (key . link) (key2 . link2) ...)"
4177  also set new patterns.  Probably this will always have to be t."    (mapcar (lambda(x)
4178    (let (entry name type class kwds res source call olh new)              (setcar x (idlwave-sintern-keyword (car x) set)))
4179              (cdr kwd-list))
4180      kwd-list)
4181    
4182    (defun idlwave-sintern-rinfo-list (list &optional set default-dir)
4183      "Sintern all strings in the rinfo LIST.  With optional parameter
4184    SET: also set new patterns.  Probably this will always have to be t.
4185    If DEFAULT-DIR is passed, it is used as the base of the directory"
4186      (let (entry name type class kwds res source call new)
4187      (while list      (while list
4188        (setq entry (car list)        (setq entry (car list)
4189              list (cdr list)              list (cdr list)
# Line 4073  also set new patterns.  Probably this wi Line 4192  also set new patterns.  Probably this wi
4192              class (nth 2 entry)              class (nth 2 entry)
4193              source (nth 3 entry)              source (nth 3 entry)
4194              call (nth 4 entry)              call (nth 4 entry)
4195              kwds (nth 5 entry)              kwds (nthcdr 5 entry))
4196              olh (nth 6 entry))  
4197        (setq kwds (mapcar (lambda (x)        ;; The class and name
                            (list (idlwave-sintern-keyword (car x) set)))  
                          kwds))  
4198        (if class        (if class
4199            (progn            (progn
4200              (if (symbolp class) (setq class (symbol-name class)))              (if (symbolp class) (setq class (symbol-name class)))
4201              (setq class (idlwave-sintern-class class set))              (setq class (idlwave-sintern-class class set))
4202              (setq name (idlwave-sintern-method name set)))              (setq name (idlwave-sintern-method name set)))
4203          (setq name (idlwave-sintern-routine name set)))          (setq name (idlwave-sintern-routine name set)))
4204        (if (stringp (cdr source))        
4205            (setcdr source (idlwave-sintern-file (cdr source) t)))        ;; The source
4206        (setq new (if olh        (let ((source-type (car source))
4207                      (list name type class source call kwds olh)              (source-file  (nth 1 source))
4208                    (list name type class source call kwds)))              (source-dir  (if default-dir  
4209        (setq res (cons new res)))                               (file-name-as-directory default-dir)
4210                               (nth 2 source)))
4211                (source-lib (nth 3 source)))
4212            (if (stringp source-dir)
4213                (setq source-dir (idlwave-sintern-dir source-dir set)))
4214            (if (stringp source-lib)
4215                (setq source-lib (idlwave-sintern-libname source-lib set)))
4216            (setq source (list source-type source-file source-dir source-lib)))
4217          
4218          ;; The keywords
4219          (setq kwds (mapcar (lambda (x)
4220                               (idlwave-sintern-keyword-list x set))
4221                             kwds))
4222    
4223          ;; Build a canonicalized list
4224          (setq new (nconc (list name type class source call) kwds)
4225                res (cons new res)))
4226      (nreverse res)))      (nreverse res)))
4227    
4228  ;; Creating new sintern tables  ;; Creating new sintern tables
# Line 4128  This defines the function `idlwave-sinte Line 4261  This defines the function `idlwave-sinte
4261    "Holds the routine-info obtained by asking the shell.")    "Holds the routine-info obtained by asking the shell.")
4262  (defvar idlwave-unresolved-routines nil  (defvar idlwave-unresolved-routines nil
4263    "Holds the unresolved routine-info obtained by asking the shell.")    "Holds the unresolved routine-info obtained by asking the shell.")
4264  (defvar idlwave-library-routines nil  (defvar idlwave-user-catalog-routines nil
4265    "Holds the procedure routine-info from the library scan.")    "Holds the procedure routine-info from the user scan.")
4266    (defvar idlwave-library-catalog-routines nil
4267      "Holds the procedure routine-info from the library catalog files.")
4268  (defvar idlwave-path-alist nil  (defvar idlwave-path-alist nil
4269    "Alist with !PATH directories and a flag if the dir has been scanned.")    "Alist with !PATH directories and zero or more flags if the dir has
4270    been scanned in a user catalog ('user) or discovered in a library
4271    catalog \('lib).")
4272  (defvar idlwave-true-path-alist nil  (defvar idlwave-true-path-alist nil
4273    "Like `idlwave-path-alist', but with true filenames.")    "Like `idlwave-path-alist', but with true filenames.")
4274  (defvar idlwave-routines nil  (defvar idlwave-routines nil
4275    "Holds the combinded procedure routine-info.")    "Holds the combinded procedure/function/method routine-info.")
4276  (defvar idlwave-class-alist nil  (defvar idlwave-class-alist nil
4277    "Holds the class names known to IDLWAVE.")    "Holds the class names known to IDLWAVE.")
4278  (defvar idlwave-class-history nil  (defvar idlwave-class-history nil
# Line 4206  will re-read the catalog." Line 4343  will re-read the catalog."
4343          (condition-case nil          (condition-case nil
4344              (kill-process idlwave-catalog-process)              (kill-process idlwave-catalog-process)
4345            (error nil))))            (error nil))))
4346    (if (or (not idlwave-libinfo-file)    (if (or (not idlwave-user-catalog-file)
4347            (not (stringp idlwave-libinfo-file))            (not (stringp idlwave-user-catalog-file))
4348            (not (file-regular-p idlwave-libinfo-file)))            (not (file-regular-p idlwave-user-catalog-file)))
4349        (error "No catalog has been produced yet"))        (error "No catalog has been produced yet"))
4350    (let* ((emacs (expand-file-name (invocation-name) (invocation-directory)))    (let* ((emacs (expand-file-name (invocation-name) (invocation-directory)))
4351           (args (list "-batch"           (args (list "-batch"
4352                       "-l" (expand-file-name "~/.emacs")                       "-l" (expand-file-name "~/.emacs")
4353                       "-l" "idlwave"                       "-l" "idlwave"
4354                       "-f" "idlwave-rescan-catalog-directories"))                       "-f" "idlwave-rescan-catalog-directories"))
4355           (process (apply 'start-process "idlcat"           (process (apply 'start-process "idlcat"
4356                           nil emacs args)))                           nil emacs args)))
4357      (setq idlwave-catalog-process process)      (setq idlwave-catalog-process process)
4358      (set-process-sentinel      (set-process-sentinel
4359       process       process
4360       (lambda (pro why)       (lambda (pro why)
4361         (when (string-match "finished" why)         (when (string-match "finished" why)
# Line 4230  will re-read the catalog." Line 4367  will re-read the catalog."
4367      (message "Background job started to update catalog file")))      (message "Background job started to update catalog file")))
4368    
4369    
4370    ;; Format for all routine info user catalog, library catalogs, etc.:
4371    ;;
4372    ;; ("ROUTINE" type class
4373    ;;  (system) | (lib pro_file dir "LIBNAME") | (user pro_file dir "USERLIB") |
4374    ;;  (buffer pro_file dir) | (compiled pro_file dir)
4375    ;;   "calling_string" ("HELPFILE" (("KWD1" . link1) ...)))
4376    ;;
4377    ;; DIR will be supplied dynamically while loading library catalogs,
4378    ;; and is sinterned to save space, as is LIBNAME.  PRO_FILE can be a
4379    ;; complete filepath, in which case DIR is unnecessary.  HELPFILE can
4380    ;; be nil, as can LINK1, etc., if no HTML help is available.
4381    
4382    
4383  (defvar idlwave-load-rinfo-idle-timer)  (defvar idlwave-load-rinfo-idle-timer)
4384  (defun idlwave-update-routine-info (&optional arg dont-concentrate)  (defun idlwave-update-routine-info (&optional arg no-concatenate)
4385    "Update the internal routine-info lists.    "Update the internal routine-info lists.
4386  These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info])  These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info])
4387  and by `idlwave-complete' (\\[idlwave-complete]) to provide information  and by `idlwave-complete' (\\[idlwave-complete]) to provide information
# Line 4248  Scans all IDLWAVE-mode buffers of the cu Line 4398  Scans all IDLWAVE-mode buffers of the cu
4398  When an IDL shell is running, this command also queries the IDL program  When an IDL shell is running, this command also queries the IDL program
4399  for currently compiled routines.  for currently compiled routines.
4400    
 ???Document what DONT-CONCENTRATE means???  
   
4401  With prefix ARG, also reload the system and library lists.  With prefix ARG, also reload the system and library lists.
4402  With two prefix ARG's, also rescans the library tree.  With two prefix ARG's, also rescans the chosen user catalog tree.
4403  With three prefix args, dispatch asynchronous process to do the update."  With three prefix args, dispatch asynchronous process to do the update.
4404    
4405    If NO-CONCATENATE is non-nil, don't pre-concatenate the routine info
4406    lists, but instead wait for the shell query to complete and
4407    asynchronously finish updating routine info.  This is set
4408    automatically when called interactively.  When you need routine
4409    information updated immediately, leave NO-CONCATENATE nil."
4410    (interactive "P\np")    (interactive "P\np")
4411    ;; Stop any idle processing    ;; Stop any idle processing
4412    (if (or (and (fboundp 'itimerp)    (if (or (and (fboundp 'itimerp)
# Line 4265  With three prefix args, dispatch asynchr Line 4419  With three prefix args, dispatch asynchr
4419      ;; Start a background process which updates the catalog.      ;; Start a background process which updates the catalog.
4420      (idlwave-rescan-asynchronously))      (idlwave-rescan-asynchronously))
4421     ((equal arg '(16))     ((equal arg '(16))
4422      ;; Update the catalog now, and wait for it.      ;; Update the user catalog now, and wait for them.
4423      (idlwave-create-libinfo-file t))      (idlwave-create-user-catalog-file t))
4424     (t     (t
4425      (let* ((load (or arg      (let* ((load (or arg
4426                       idlwave-buffer-case-takes-precedence                       idlwave-buffer-case-takes-precedence
# Line 4274  With three prefix args, dispatch asynchr Line 4428  With three prefix args, dispatch asynchr
4428             ;; The override-idle means, even if the idle timer has done some             ;; The override-idle means, even if the idle timer has done some
4429             ;; preparing work, load and renormalize everything anyway.             ;; preparing work, load and renormalize everything anyway.
4430             (override-idle (or arg idlwave-buffer-case-takes-precedence)))             (override-idle (or arg idlwave-buffer-case-takes-precedence)))
4431          
4432        (setq idlwave-buffer-routines nil        (setq idlwave-buffer-routines nil
4433              idlwave-compiled-routines nil              idlwave-compiled-routines nil
4434              idlwave-unresolved-routines nil)              idlwave-unresolved-routines nil)
# Line 4285  With three prefix args, dispatch asynchr Line 4439  With three prefix args, dispatch asynchr
4439          (idlwave-reset-sintern (cond (load t)          (idlwave-reset-sintern (cond (load t)
4440                                       ((null idlwave-system-routines) t)                                       ((null idlwave-system-routines) t)
4441                                       (t 'bufsh))))                                       (t 'bufsh))))
4442          
4443        (if idlwave-buffer-case-takes-precedence        (if idlwave-buffer-case-takes-precedence
4444            ;; We can safely scan the buffer stuff first            ;; We can safely scan the buffer stuff first
4445            (progn            (progn
# Line 4300  With three prefix args, dispatch asynchr Line 4454  With three prefix args, dispatch asynchr
4454                                      (idlwave-shell-is-running)))                                      (idlwave-shell-is-running)))
4455               (ask-shell (and shell-is-running               (ask-shell (and shell-is-running
4456                               idlwave-query-shell-for-routine-info)))                               idlwave-query-shell-for-routine-info)))
4457          
4458            ;; Load the library catalogs again, first re-scanning the path
4459            (when arg
4460              (if shell-is-running
4461                  (idlwave-shell-send-command idlwave-shell-path-query
4462                                              '(progn
4463                                                 (idlwave-shell-get-path-info)
4464                                                 (idlwave-scan-library-catalogs))
4465                                              'hide)
4466                (idlwave-scan-library-catalogs)))
4467    
4468          (if (or (not ask-shell)          (if (or (not ask-shell)
4469                  (not dont-concentrate))                  (not no-concatenate))
4470              ;; 1. If we are not going to ask the shell, we need to do the              ;; 1. If we are not going to ask the shell, we need to do the
4471              ;;    concatenation now.              ;;    concatenation now.
4472              ;; 2. When this function is called non-interactively, it means              ;; 2. When this function is called non-interactively, it
4473              ;;    that someone needs routine info *now*.  The shell update              ;;    means that someone needs routine info *now*.  The
4474              ;;    causes the concatenation *delayed*, so not in time for              ;;    shell update causes the concatenation to be
4475              ;;    the current command.  Therefore, we do a concatenation              ;;    *delayed*, so not in time for the current command.
4476              ;;    now, even though the shell might do it again.              ;;    Therefore, we do a concatenation now, even though
4477              (idlwave-concatenate-rinfo-lists nil t))              ;;    the shell might do it again.
4478                (idlwave-concatenate-rinfo-lists nil 'run-hooks))
4479          
4480          (when ask-shell          (when ask-shell
4481            ;; Ask the shell about the routines it knows.            ;; Ask the shell about the routines it knows of.
4482            (message "Querying the shell")            (message "Querying the shell")
4483            (idlwave-shell-update-routine-info nil t)))))))            (idlwave-shell-update-routine-info nil t)))))))
4484    
4485  (defvar idlwave-load-rinfo-steps-done (make-vector 5 nil))  
4486    (defvar idlwave-load-rinfo-steps-done (make-vector 6 nil))
4487  (defvar idlwave-load-rinfo-idle-timer nil)  (defvar idlwave-load-rinfo-idle-timer nil)
4488  (defun idlwave-start-load-rinfo-timer ()  (defun idlwave-start-load-rinfo-timer ()
4489    (if (or (and (fboundp 'itimerp)    (if (or (and (fboundp 'itimerp)
# Line 4325  With three prefix args, dispatch asynchr Line 4491  With three prefix args, dispatch asynchr
4491            (and (fboundp 'timerp)            (and (fboundp 'timerp)
4492                 (timerp idlwave-load-rinfo-idle-timer)))                 (timerp idlwave-load-rinfo-idle-timer)))
4493        (cancel-timer idlwave-load-rinfo-idle-timer))        (cancel-timer idlwave-load-rinfo-idle-timer))
4494    (setq idlwave-load-rinfo-steps-done (make-vector 5 nil))    (setq idlwave-load-rinfo-steps-done (make-vector 6 nil))
4495    (setq idlwave-load-rinfo-idle-timer nil)    (setq idlwave-load-rinfo-idle-timer nil)
4496    (if (and idlwave-init-rinfo-when-idle-after    (if (and idlwave-init-rinfo-when-idle-after
4497             (numberp idlwave-init-rinfo-when-idle-after)             (numberp idlwave-init-rinfo-when-idle-after)
# Line 4339  With three prefix args, dispatch asynchr Line 4505  With three prefix args, dispatch asynchr
4505                     nil 'idlwave-load-rinfo-next-step)))                     nil 'idlwave-load-rinfo-next-step)))
4506          (error nil))))          (error nil))))
4507    
   
   
4508  (defun idlwave-load-rinfo-next-step ()  (defun idlwave-load-rinfo-next-step ()
4509    (let ((inhibit-quit t)    (let ((inhibit-quit t)
4510          (arr idlwave-load-rinfo-steps-done))          (arr idlwave-load-rinfo-steps-done))
4511      (if (catch 'exit      (when (catch 'exit
4512            (when (not (aref arr 0))            (when (not (aref arr 0))
4513              (message "Loading idlw-rinfo.el in idle time...")              (message "Loading idlw-rinfo.el in idle time...")
4514              (load "idlw-rinfo" 'noerror 'nomessage)              (load "idlw-rinfo" 'noerror 'nomessage)
# Line 4361  With three prefix args, dispatch asynchr Line 4525  With three prefix args, dispatch asynchr
4525              (aset arr 1 t)              (aset arr 1 t)
4526              (throw 'exit t))              (throw 'exit t))
4527            (when (not (aref arr 2))            (when (not (aref arr 2))
4528              (when (and (stringp idlwave-libinfo-file)              (when (and (stringp idlwave-user-catalog-file)
4529                         (file-regular-p idlwave-libinfo-file))                         (file-regular-p idlwave-user-catalog-file))
4530                  (message "Loading user catalog in idle time...")
4531                (condition-case nil                (condition-case nil
4532                      (load-file idlwave-user-catalog-file)
4533                    (error (throw 'exit nil)))
4534                  ;; Check for the old style catalog and warn
4535                  (if (and
4536                       (boundp 'idlwave-library-routines)
4537                       idlwave-library-routines)
4538                    (progn                    (progn
4539                      (message "Loading library catalog in idle time...")                      (setq idlwave-library-routines nil)
4540                      (load-file idlwave-libinfo-file)                      (ding)
4541                      (message "Loading library catalog in idle time...done")                      (message "Outdated user catalog: %s... recreate"
4542                      (aset arr 2 t)                               idlwave-user-catalog-file))
4543                      (throw 'exit t))                  (message "Loading user catalog in idle time...done"))
4544                  (error (throw 'exit nil)))))                (aset arr 2 t)
4545                  (throw 'exit t)))
4546            (when (not (aref arr 3))            (when (not (aref arr 3))
4547              (when idlwave-library-routines              (when idlwave-user-catalog-routines
4548                (message "Normalizing idlwave-library-routines in idle time...")                (message "Normalizing user catalog routines in idle time...")
4549                (setq idlwave-library-routines (idlwave-sintern-rinfo-list                (setq idlwave-user-catalog-routines
4550                                                idlwave-library-routines 'sys))                      (idlwave-sintern-rinfo-list
4551                (message "Normalizing idlwave-library-routines in idle time...done"))                       idlwave-user-catalog-routines 'sys))
4552                  (message
4553                   "Normalizing user catalog routines in idle time...done"))
4554              (aset arr 3 t)              (aset arr 3 t)
4555              (throw 'exit t))              (throw 'exit t))
4556            (when (not (aref arr 4))            (when (not (aref arr 4))
4557                (idlwave-scan-library-catalogs
4558                 "Loading and normalizing library catalogs in idle time...")
4559                (aset arr 4 t)
4560                (throw 'exit t))
4561              (when (not (aref arr 5))
4562              (message "Finishing initialization in idle time...")              (message "Finishing initialization in idle time...")
4563              (idlwave-routines)              (idlwave-routines)
4564              (message "Finishing initialization in idle time...done")              (message "Finishing initialization in idle time...done")
4565              (throw 'exit nil)))              (throw 'exit nil)))
4566          (progn          ;; restart the timer
4567            ;; restart the timer          (if (sit-for 1)
4568            (if (sit-for 1)              (idlwave-load-rinfo-next-step)
4569                (idlwave-load-rinfo-next-step)            (setq idlwave-load-rinfo-idle-timer
4570              (setq idlwave-load-rinfo-idle-timer                  (run-with-idle-timer
4571                    (run-with-idle-timer                   idlwave-init-rinfo-when-idle-after
4572                     idlwave-init-rinfo-when-idle-after                   nil 'idlwave-load-rinfo-next-step))))))
                    nil 'idlwave-load-rinfo-next-step)))  
           ))))  
4573    
4574  (defun idlwave-load-system-rinfo (&optional force)  (defun idlwave-load-system-rinfo (&optional force)
4575    ;; Load and case-treat the system and lib info files.    ;; Load and case-treat the system and catalog files.
4576    (when (or force (not (aref idlwave-load-rinfo-steps-done 0)))    (when (or force (not (aref idlwave-load-rinfo-steps-done 0)))
4577      (load "idlw-rinfo" 'noerror 'nomessage))      (load "idlw-rinfo" 'noerror 'nomessage))
4578    (when (or force (not (aref idlwave-load-rinfo-steps-done 1)))    (when (or force (not (aref idlwave-load-rinfo-steps-done 1)))
# Line 4406  With three prefix args, dispatch asynchr Line 4583  With three prefix args, dispatch asynchr
4583    (setq idlwave-routines (copy-sequence idlwave-system-routines))    (setq idlwave-routines (copy-sequence idlwave-system-routines))
4584    (setq idlwave-last-system-routine-info-cons-cell    (setq idlwave-last-system-routine-info-cons-cell
4585          (nthcdr (1- (length idlwave-routines)) idlwave-routines))          (nthcdr (1- (length idlwave-routines)) idlwave-routines))
4586    (when (and (stringp idlwave-libinfo-file)    (when (and (stringp idlwave-user-catalog-file)
4587               (file-regular-p idlwave-libinfo-file))               (file-regular-p idlwave-user-catalog-file))
4588      (condition-case nil      (condition-case nil
4589          (progn          (when (or force (not (aref idlwave-load-rinfo-steps-done 2)))
4590            (when (or force (not (aref idlwave-load-rinfo-steps-done 2)))            (load-file idlwave-user-catalog-file))
4591              (load-file idlwave-libinfo-file))        (error nil))
4592            (setq idlwave-true-path-alist nil)      (when (boundp 'idlwave-library-routines)
4593            (when (or force (not (aref idlwave-load-rinfo-steps-done 3)))        (setq idlwave-library-routines nil)
4594              (message "Normalizing idlwave-library-routines...")        (error "Outdated user catalog: %s... recreate" idlwave-user-catalog-file))
4595              (setq idlwave-library-routines (idlwave-sintern-rinfo-list      (setq idlwave-true-path-alist nil)
4596                                              idlwave-library-routines 'sys))      (when (or force (not (aref idlwave-load-rinfo-steps-done 3)))
4597              (message "Normalizing idlwave-library-routines...done")))        (message "Normalizing user catalog routines...")
4598        (error nil)))        (setq idlwave-user-catalog-routines
4599                (idlwave-sintern-rinfo-list
4600                 idlwave-user-catalog-routines 'sys))
4601          (message "Normalizing user catalog routines...done")))
4602      (when (or force (not (aref idlwave-load-rinfo-steps-done 4)))
4603        (idlwave-scan-library-catalogs
4604         "Loading and normalizing library catalogs..."))
4605    (run-hooks 'idlwave-after-load-rinfo-hook))    (run-hooks 'idlwave-after-load-rinfo-hook))
4606    
4607    
4608  (defun idlwave-update-buffer-routine-info ()  (defun idlwave-update-buffer-routine-info ()
4609    (let (res)    (let (res)
4610      (cond      (cond
4611       ((eq idlwave-scan-all-buffers-for-routine-info t)       ((eq idlwave-scan-all-buffers-for-routine-info t)
4612        ;; Scan all buffers, current buffer last        ;; Scan all buffers, current buffer last
4613        (message "Scanning all buffers...")        (message "Scanning all buffers...")
4614        (setq res (idlwave-get-routine-info-from-buffers        (setq res (idlwave-get-routine-info-from-buffers
4615                   (reverse (buffer-list)))))                   (reverse (buffer-list)))))
4616       ((null idlwave-scan-all-buffers-for-routine-info)       ((null idlwave-scan-all-buffers-for-routine-info)
4617        ;; Don't scan any buffers        ;; Don't scan any buffers
# Line 4442  With three prefix args, dispatch asynchr Line 4624  With three prefix args, dispatch asynchr
4624              (setq res (idlwave-get-routine-info-from-buffers              (setq res (idlwave-get-routine-info-from-buffers
4625                         (list (current-buffer))))))))                         (list (current-buffer))))))))
4626      ;; Put the result into the correct variable      ;; Put the result into the correct variable
4627      (setq idlwave-buffer-routines      (setq idlwave-buffer-routines
4628            (idlwave-sintern-rinfo-list res t))))            (idlwave-sintern-rinfo-list res 'set))))
4629    
4630  (defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook)  (defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook)
4631    "Put the different sources for routine information together."    "Put the different sources for routine information together."
4632    ;; The sequence here is important because earlier definitions shadow    ;; The sequence here is important because earlier definitions shadow
4633    ;; later ones.  We assume that if things in the buffers are newer    ;; later ones.  We assume that if things in the buffers are newer
4634    ;; then in the shell of the system, it is meant to be different.    ;; then in the shell of the system, they are meant to be different.
   
4635    (setcdr idlwave-last-system-routine-info-cons-cell    (setcdr idlwave-last-system-routine-info-cons-cell
4636            (append idlwave-buffer-routines            (append idlwave-buffer-routines
4637                    idlwave-compiled-routines                    idlwave-compiled-routines
4638                    idlwave-library-routines))                    idlwave-library-catalog-routines
4639                      idlwave-user-catalog-routines))
4640    (setq idlwave-class-alist nil)    (setq idlwave-class-alist nil)
4641    
4642    ;; Give a message with information about the number of routines we have.    ;; Give a message with information about the number of routines we have.
4643    (unless quiet    (unless quiet
4644      (message      (message
4645       "Routine info updated:  buffer(%d)  compiled(%d)  catalog(%d)  system(%d)"       "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)"
4646       (length idlwave-buffer-routines)       (length idlwave-buffer-routines)
4647       (length idlwave-compiled-routines)       (length idlwave-compiled-routines)
4648       (length idlwave-library-routines)       (length idlwave-library-catalog-routines)
4649         (length idlwave-user-catalog-routines)
4650       (length idlwave-system-routines)))       (length idlwave-system-routines)))
4651    (if run-hook    (if run-hook
4652        (run-hooks 'idlwave-update-rinfo-hook)))        (run-hooks 'idlwave-update-rinfo-hook)))
# Line 4476  With three prefix args, dispatch asynchr Line 4659  With three prefix args, dispatch asynchr
4659            (when (and (setq class (nth 2 x))            (when (and (setq class (nth 2 x))
4660                       (not (assq class idlwave-class-alist)))                       (not (assq class idlwave-class-alist)))
4661              (push (list class) idlwave-class-alist)))              (push (list class) idlwave-class-alist)))
4662          idlwave-class-alist)))          idlwave-class-alist)))      
4663    
4664  ;; Three functions for the hooks  ;; Three functions for the hooks
4665  (defun idlwave-save-buffer-update ()  (defun idlwave-save-buffer-update ()
# Line 4487  With three prefix args, dispatch asynchr Line 4670  With three prefix args, dispatch asynchr
4670    (idlwave-update-current-buffer-info 'find-file))    (idlwave-update-current-buffer-info 'find-file))
4671    
4672  (defun idlwave-update-current-buffer-info (why)  (defun idlwave-update-current-buffer-info (why)
4673    "Undate idlwave-routines for current buffer.  Can run from after-save-hook."    "Update idlwave-routines for current buffer.  Can run from after-save-hook."
4674    (when (and (eq major-mode 'idlwave-mode)    (when (and (eq major-mode 'idlwave-mode)
4675               (or (eq t idlwave-auto-routine-info-updates)               (or (eq t idlwave-auto-routine-info-updates)
4676                   (memq why idlwave-auto-routine-info-updates))                   (memq why idlwave-auto-routine-info-updates))
# Line 4509  With three prefix args, dispatch asynchr Line 4692  With three prefix args, dispatch asynchr
4692    
4693  (defun idlwave-replace-buffer-routine-info (file new)  (defun idlwave-replace-buffer-routine-info (file new)
4694    "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW."    "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW."
4695    (let ((list idlwave-buffer-routines)    (let ((list idlwave-buffer-routines)
4696          found)          found)
4697      (while list      (while list
4698        ;; The following test uses eq to make sure it works correctly        ;; The following test uses eq to make sure it works correctly
4699        ;; when two buffers visit the same file.  Then the file names        ;; when two buffers visit the same file.  Then the file names
4700        ;; will be equal, but not eq.        ;; will be equal, but not eq.
4701        (if (eq (cdr (nth 3 (car list))) file)        (if (eq (idlwave-routine-source-file (nth 3 (car list))) file)
4702            (progn            (progn
4703              (setcar list nil)              (setcar list nil)
4704              (setq found t))              (setq found t))
4705          (if found          (if found
4706              ;; End of that section reached. Jump.              ;; End of that section reached. Jump.
4707              (setq list nil)))              (setq list nil)))
4708        (setq list (cdr list)))        (setq list (cdr list)))
4709      (setq idlwave-buffer-routines      (setq idlwave-buffer-routines
# Line 4552  With three prefix args, dispatch asynchr Line 4735  With three prefix args, dispatch asynchr
4735        (save-restriction        (save-restriction
4736          (widen)          (widen)
4737          (goto-char (point-min))          (goto-char (point-min))
4738          (while (re-search-forward          (while (re-search-forward
4739                  "^[ \t]*\\(pro\\|function\\)[ \t]" nil t)                  "^[ \t]*\\(pro\\|function\\)[ \t]" nil t)
4740            (setq string (buffer-substring-no-properties            (setq string (buffer-substring-no-properties
4741                          (match-beginning 0)                          (match-beginning 0)
4742                          (progn                          (progn
4743                            (idlwave-end-of-statement)                            (idlwave-end-of-statement)
4744                            (point))))                            (point))))
4745            (setq entry (idlwave-parse-definition string))            (setq entry (idlwave-parse-definition string))
# Line 4594  With three prefix args, dispatch asynchr Line 4777  With three prefix args, dispatch asynchr
4777          (push (match-string 1 string) args)))          (push (match-string 1 string) args)))
4778      ;; Normalize and sort.      ;; Normalize and sort.
4779      (setq args (nreverse args))      (setq args (nreverse args))
4780      (setq keywords (sort keywords (lambda (a b)      (setq keywords (sort keywords (lambda (a b)
4781                                      (string< (downcase a) (downcase b)))))                                      (string< (downcase a) (downcase b)))))
4782      ;; Make and return the entry      ;; Make and return the entry
4783      ;; We don't know which argument are optional, so this information      ;; We don't know which argument are optional, so this information
# Line 4603  With three prefix args, dispatch asynchr Line 4786  With three prefix args, dispatch asynchr
4786            (if (equal type "pro") 'pro 'fun)            (if (equal type "pro") 'pro 'fun)
4787            class            class
4788            (cond ((not (boundp 'idlwave-scanning-lib))            (cond ((not (boundp 'idlwave-scanning-lib))
4789                   (cons 'buffer (buffer-file-name)))                   (list  'buffer (buffer-file-name)))
4790  ;               ((string= (downcase  ;               ((string= (downcase
4791  ;                          (file-name-sans-extension  ;                          (file-name-sans-extension
4792  ;                           (file-name-nondirectory (buffer-file-name))))  ;                           (file-name-nondirectory (buffer-file-name))))
4793  ;                         (downcase name))  ;                         (downcase name))
4794  ;                (list 'lib))  ;                (list 'lib))
4795  ;               (t (cons 'lib (file-name-nondirectory (buffer-file-name))))  ;               (t (cons 'lib (file-name-nondirectory (buffer-file-name))))
4796                  (t (cons 'lib (concat idlwave-scanning-lib-dir                  (t (list 'user (file-name-nondirectory (buffer-file-name))
4797                                        (file-name-nondirectory (buffer-file-name))))))                           idlwave-scanning-lib-dir "UserLib")))
4798            (concat            (concat
4799             (if (string= type "function") "Result = " "")             (if (string= type "function") "Result = " "")
4800             (if class "Obj ->[%s::]" "")             (if class "Obj ->[%s::]" "")
4801             "%s"             "%s"
# Line 4622  With three prefix args, dispatch asynchr Line 4805  With three prefix args, dispatch asynchr
4805                  (mapconcat 'identity args ", ")                  (mapconcat 'identity args ", ")
4806                  (if (string= type "function") ")" ""))))                  (if (string= type "function") ")" ""))))
4807            (if keywords            (if keywords
4808                (mapcar 'list keywords)                (cons nil (mapcar 'list keywords)) ;No help file
4809              nil))))              nil))))
4810    
 ;;----- Scanning the library -------------------  
4811    
4812  (defvar idlwave-sys-dir nil  ;;----- Scanning the user catalog -------------------
   "Internal variable.")  
4813    
4814  (defun idlwave-sys-dir ()  (defun idlwave-sys-dir ()
4815    "Return the syslib directory, or a dummy that never matches."    "Return the syslib directory, or a dummy that never matches."
4816    (or idlwave-sys-dir    (if (string= idlwave-system-directory "")
4817        "@@@@@@@@"))        "@@@@@@@@"
4818        idlwave-system-directory))
4819    
4820    
4821  (defvar idlwave-shell-path-query)  (defvar idlwave-shell-path-query)
4822  (defun idlwave-create-libinfo-file (&optional arg)  (defun idlwave-create-user-catalog-file (&optional arg)
4823    "Scan all files on selected dirs of IDL search path for routine information.    "Scan all files on selected dirs of IDL search path for routine information.
4824  A widget checklist will allow you to choose the directories.  
4825  Write the result as a file `idlwave-libinfo-file'.  When this file exists,  A widget checklist will allow you to choose the directories.  Write
4826  will be automatically loaded to give routine information about library  the result as a file `idlwave-user-catalog-file'.  When this file
4827  routines.  exists, will be automatically loaded to give routine information about
4828  With ARG, just rescan the same directories as last time - so no widget  library routines.  With ARG, just rescan the same directories as last
4829  will pop up."  time - so no widget will pop up."
4830    (interactive "P")    (interactive "P")
4831    ;; Make sure the file is loaded if it exists.    ;; Make sure the file is loaded if it exists.
4832    (if (and (stringp idlwave-libinfo-file)    (if (and (stringp idlwave-user-catalog-file)
4833             (file-regular-p idlwave-libinfo-file))             (file-regular-p idlwave-user-catalog-file))
4834        (condition-case nil        (condition-case nil
4835            (load-file idlwave-libinfo-file)            (load-file idlwave-user-catalog-file)
4836          (error nil)))          (error nil)))
4837    ;; Make sure the file name makes sense    ;; Make sure the file name makes sense
4838    (unless (and (stringp idlwave-libinfo-file)    (unless (and (stringp idlwave-user-catalog-file)
4839                 (> (length idlwave-libinfo-file) 0)                 (> (length idlwave-user-catalog-file) 0)
4840                 (file-accessible-directory-p                 (file-accessible-directory-p
4841                  (file-name-directory idlwave-libinfo-file))                  (file-name-directory idlwave-user-catalog-file))
4842                 (not (string= "" (file-name-nondirectory                 (not (string= "" (file-name-nondirectory
4843                                   idlwave-libinfo-file))))                                   idlwave-user-catalog-file))))
4844      (error "`idlwave-libinfo-file' does not point to file in accessible directory"))      (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory"))
4845      
4846    (cond    (cond
    ((and arg idlwave-path-alist  
          (consp (car idlwave-path-alist))  
          idlwave-sys-dir)  
4847      ;; Rescan the known directories      ;; Rescan the known directories
4848      (idlwave-scan-lib-files     ((and arg idlwave-path-alist
4849       idlwave-sys-dir           (consp (car idlwave-path-alist)))
4850        idlwave-path-alist))      (idlwave-scan-user-lib-files idlwave-path-alist))
4851    
4852       ;; Expand the directories from library-path and run the widget
4853     (idlwave-library-path     (idlwave-library-path
4854      ;; Get the directories from that variable      (idlwave-display-user-catalog-widget
4855      (idlwave-display-libinfo-widget       (if idlwave-true-path-alist
4856       idlwave-system-directory           ;; Propagate any flags on the existing path-alist
4857       (idlwave-expand-path idlwave-library-path)           (mapcar (lambda (x)
4858       (delq nil (mapcar (lambda (x) (if (consp x) (if (cdr x) (car x) nil) x))                     (let ((path-entry (assoc (file-truename x)
4859                         idlwave-path-alist))))                                              idlwave-true-path-alist)))
4860                         (if path-entry
4861                             (cons x (cdr path-entry))
4862                           (list x))))
4863                     (idlwave-expand-path idlwave-library-path))
4864           (mapcar 'list (idlwave-expand-path idlwave-library-path)))))
4865    
4866       ;; Ask the shell for the path and then run the widget
4867     (t     (t
     ;; Ask the shell for the path and run the widget  
4868      (message "Asking the shell for IDL path...")      (message "Asking the shell for IDL path...")
4869      (require 'idlw-shell)      (require 'idlw-shell)
4870      (idlwave-shell-send-command idlwave-shell-path-query      (idlwave-shell-send-command idlwave-shell-path-query
4871                                  '(idlwave-libinfo-command-hook nil)                                  '(idlwave-user-catalog-command-hook nil)
4872                                  'hide))))                                  'hide))))
4873    
4874  (defun idlwave-libinfo-command-hook (&optional arg)  
4875    ;; Command hook used by `idlwave-create-libinfo-file'.  ;; Parse shell path information and select among it.
4876    (defun idlwave-user-catalog-command-hook (&optional arg)
4877      ;; Command hook used by `idlwave-create-user-catalog-file'.
4878    (if arg    (if arg
4879        ;; Scan immediately        ;; Scan immediately
4880        (idlwave-scan-lib-files        (idlwave-scan-user-lib-files idlwave-path-alist)
4881         idlwave-sys-dir      ;; Set the path and display the widget
4882         idlwave-path-alist)      (idlwave-shell-get-path-info 'no-write) ; set to something path-alist
4883      ;; Display the widget      (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load)
4884      (let* ((rpl (idlwave-shell-path-filter))      (idlwave-display-user-catalog-widget idlwave-path-alist)))
4885             (sysdir (car rpl))  
4886             (dirs (cdr rpl)))  (defconst idlwave-user-catalog-widget-help-string
4887        (idlwave-display-libinfo-widget    "This is the front-end to the creation of the IDLWAVE user catalog.
4888         sysdir dirs  Please select the directories on IDL's search path from which you
4889         (delq nil (mapcar (lambda (x) (if (cdr x) (car x) nil))  would like to extract routine information, to be stored in the file:
                          idlwave-path-alist))))))  
   
 (defconst idlwave-libinfo-widget-help-string  
   "This is the front-end to the creation of IDLWAVE library catalog.  
 Please select below the directories on IDL's search path from which you  
 would like to extract routine information, which will be stored in the file  
4890    
4891               %s               %s
4892    
4893  If this is not the correct file, first set variable `idlwave-libinfo-file'.  If this is not the correct file, first set variable
4894  Then call this command again.  `idlwave-user-catalog-file', and call this command again.
4895    
4896  For writing code, you need to include the directories which contain the  N.B. Many libraries include pre-scanned catalog files
4897  routines you use.  If IDLWAVE should be able to analyse routine shadowing  \(\".idlwave_catalog\").  These are marked with \"[LIB]\", and need
4898  it is best to scan all directories.  not be scanned.  You can scan your own libraries off-line using the
4899    perl script `idlwave_catalog'.
4900    
4901  After selecting the directories, choose [Scan & Save] to scan the library  After selecting the directories, choose [Scan & Save] to scan the library
4902  directories and save the routine info.  directories and save the routine info.
# Line 4719  directories and save the routine info. Line 4904  directories and save the routine info.
4904    
4905  (defvar idlwave-widget)  (defvar idlwave-widget)
4906  (defvar widget-keymap)  (defvar widget-keymap)
4907  (defun idlwave-display-libinfo-widget (sysdir dirs selected-dirs)  (defun idlwave-display-user-catalog-widget (dirs-list)
4908    "Create the widget to select IDL search path directories for scanning."    "Create the widget to select IDL search path directories for scanning."
4909    (interactive)    (interactive)
4910    (require 'widget)    (require 'widget)
4911    (require 'wid-edit)    (require 'wid-edit)
4912    (unless dirs    (unless dirs-list
4913        (error "Don't know IDL's search path"))        (error "Don't know IDL's search path"))
4914    
   ;; Allow only those directories to be selected which are in the path.  
   (setq selected-dirs (delq nil (mapcar (lambda (x)  
                                           (if (member x dirs) x nil))  
                                         selected-dirs)))  
4915    (kill-buffer (get-buffer-create "*IDLWAVE Widget*"))    (kill-buffer (get-buffer-create "*IDLWAVE Widget*"))
4916    (switch-to-buffer (get-buffer-create "*IDLWAVE Widget*"))    (switch-to-buffer (get-buffer-create "*IDLWAVE Widget*"))
4917    (kill-all-local-variables)    (kill-all-local-variables)
4918    (make-local-variable 'idlwave-widget)    (make-local-variable 'idlwave-widget)
4919    (widget-insert (format idlwave-libinfo-widget-help-string    (widget-insert (format idlwave-user-catalog-widget-help-string
4920                           idlwave-libinfo-file))                           idlwave-user-catalog-file))
4921      
4922    (widget-create 'push-button    (widget-create 'push-button
4923                   :notify 'idlwave-widget-scan-lib-files                   :notify 'idlwave-widget-scan-user-lib-files
4924                   "Scan & Save")                   "Scan & Save")
4925    (widget-insert "  ")    (widget-insert "  ")
4926    (widget-create 'push-button    (widget-create 'push-button
4927                   :notify (lambda (&rest ignore)                   :notify 'idlwave-delete-user-catalog-file
                            (kill-buffer (current-buffer)))  
                  "Quit")  
   (widget-insert "  ")  
   (widget-create 'push-button  
                  :notify 'idlwave-delete-libinfo-file  
4928                   "Delete File")                   "Delete File")
4929    (widget-insert "  ")    (widget-insert "  ")
4930    (widget-create 'push-button    (widget-create 'push-button
4931                   :notify '(lambda (&rest ignore)                   :notify
4932                              (idlwave-display-libinfo-widget                   '(lambda (&rest ignore)
4933                               (widget-get idlwave-widget :sysdir)                      (let ((path-list (widget-get idlwave-widget :path-dirs)))
4934                               (widget-get idlwave-widget :path-dirs)                        (mapcar (lambda (x)
4935                               (widget-get idlwave-widget :path-dirs)))                                  (unless (memq 'lib (cdr x))
4936                   "Select All")                                    (idlwave-path-alist-add-flag x 'user)))
4937                                  path-list)
4938                          (idlwave-display-user-catalog-widget path-list)))
4939                     "Select All Non-Lib")
4940    (widget-insert "  ")    (widget-insert "  ")
4941    (widget-create 'push-button    (widget-create 'push-button
4942                   :notify '(lambda (&rest ignore)                   :notify
4943                              (idlwave-display-libinfo-widget                   '(lambda (&rest ignore)
4944                               (widget-get idlwave-widget :sysdir)                      (let ((path-list (widget-get idlwave-widget :path-dirs)))
4945                               (widget-get idlwave-widget :path-dirs)                        (mapcar (lambda (x)
4946                               nil))                                  (idlwave-path-alist-remove-flag x 'user))
4947                                  path-list)
4948                          (idlwave-display-user-catalog-widget path-list)))
4949                   "Deselect All")                   "Deselect All")
4950      (widget-insert "  ")
4951      (widget-create 'push-button
4952                     :notify (lambda (&rest ignore)
4953                               (kill-buffer (current-buffer)))
4954                     "Quit")
4955    (widget-insert "\n\n")    (widget-insert "\n\n")
4956    
4957    (widget-insert "Select Directories\n")    (widget-insert "Select Directories: \n")
4958      
4959    (setq idlwave-widget    (setq idlwave-widget
4960          (apply 'widget-create          (apply 'widget-create
4961                 'checklist                 'checklist
4962                 :value selected-dirs                 :value  (delq nil (mapcar (lambda (x)
4963                                               (if (memq 'user (cdr x))
4964                                                   (car x)))
4965                                             dirs-list))
4966                 :greedy t                 :greedy t
4967                 :tag "List of directories"                 :tag "List of directories"
4968                 (mapcar (lambda (x) (list 'item x)) dirs)))                 (mapcar (lambda (x)
4969    (widget-put idlwave-widget :path-dirs dirs)                           (list 'item
4970    (widget-put idlwave-widget :sysdir sysdir)                                 (if (memq 'lib (cdr x))
4971                                       (concat "[LIB] " (car x) )
4972                                     (car x)))) dirs-list)))
4973      (widget-put idlwave-widget :path-dirs dirs-list)
4974    (widget-insert "\n")    (widget-insert "\n")
4975    (use-local-map widget-keymap)    (use-local-map widget-keymap)
4976    (widget-setup)    (widget-setup)
4977    (goto-char (point-min))    (goto-char (point-min))
4978    (delete-other-windows))    (delete-other-windows))
4979      
4980  (defun idlwave-delete-libinfo-file (&rest ignore)  (defun idlwave-delete-user-catalog-file (&rest ignore)
4981    (if (yes-or-no-p    (if (yes-or-no-p
4982         (format "Delete file %s " idlwave-libinfo-file))         (format "Delete file %s " idlwave-user-catalog-file))
4983        (progn        (progn
4984          (delete-file idlwave-libinfo-file)          (delete-file idlwave-user-catalog-file)
4985          (message "%s has been deleted" idlwave-libinfo-file))))          (message "%s has been deleted" idlwave-user-catalog-file))))
4986    
4987  (defun idlwave-widget-scan-lib-files (&rest ignore)  (defun idlwave-widget-scan-user-lib-files (&rest ignore)
4988    ;; Call `idlwave-scan-lib-files' with data taken from the widget.    ;; Call `idlwave-scan-user-lib-files' with data taken from the widget.
4989    (let* ((widget idlwave-widget)    (let* ((widget idlwave-widget)
4990           (selected-dirs (widget-value widget))           (selected-dirs (widget-value widget))
4991           (sysdir (widget-get widget :sysdir))           (path-alist (widget-get widget :path-dirs))
4992           (path-dirs (widget-get widget :path-dirs))           (this-path-alist path-alist)
4993           (path-dir-alist           dir-entry)
4994            (mapcar (lambda (x) (cons x (if (member x selected-dirs) t nil)))      (while (setq dir-entry (pop this-path-alist))
4995                    path-dirs)))        (if (member
4996      (idlwave-scan-lib-files sysdir path-dir-alist)))             (if (memq 'lib (cdr dir-entry))
4997                   (concat "[LIB] " (car dir-entry))
4998                 (car dir-entry))
4999               selected-dirs)
5000              (idlwave-path-alist-add-flag dir-entry 'user)
5001            (idlwave-path-alist-remove-flag dir-entry 'user)))
5002        (idlwave-scan-user-lib-files path-alist)))
5003    
5004  (defvar font-lock-mode)  (defvar font-lock-mode)
5005  (defun idlwave-scan-lib-files (sysdir path-alist)  (defun idlwave-scan-user-lib-files (path-alist)
5006    ;; Scan the files in PATH-ALIST and store the info in a file    ;; Scan the PRO files in PATH-ALIST and store the info in the user catalog
5007    (let* ((idlwave-scanning-lib t)    (let* ((idlwave-scanning-lib t)
5008           (idlwave-scanning-lib-dir "")           (idlwave-scanning-lib-dir "")
          (dircnt (1+ (length path-alist)))  
5009           (idlwave-completion-case nil)           (idlwave-completion-case nil)
5010           dirs-alist dir files file)           dirs-alist dir files file)
5011      (setq idlwave-library-routines nil)      (setq idlwave-user-catalog-routines nil
5012      (setq idlwave-path-alist path-alist)            idlwave-path-alist path-alist ; for library-path instead
5013      (setq idlwave-true-path-alist nil)            idlwave-true-path-alist nil)
5014      (setq idlwave-sys-dir sysdir)      (if idlwave-auto-write-paths (idlwave-write-paths))
5015      (save-excursion      (save-excursion
5016        (set-buffer (get-buffer-create "*idlwave-scan.pro*"))        (set-buffer (get-buffer-create "*idlwave-scan.pro*"))
5017        (idlwave-mode)        (idlwave-mode)
5018        (setq dirs-alist (reverse path-alist))        (setq dirs-alist (reverse path-alist))
5019        (while (setq dir (pop dirs-alist))        (while (setq dir (pop dirs-alist))
5020          (decf dircnt)          (when (memq 'user (cdr dir))    ; Has it marked for scan?
         (when (cdr dir)  
           ;; Has the flag of scanned directories  
5021            (setq dir (car dir))            (setq dir (car dir))
5022            (setq idlwave-scanning-lib-dir (format "{%d}/" dircnt))            (setq idlwave-scanning-lib-dir dir)
5023            (when (file-directory-p dir)            (when (file-directory-p dir)
5024              (setq files (directory-files dir 'full "\\.[pP][rR][oO]\\'"))              (setq files (directory-files dir 'full "\\.[pP][rR][oO]\\'"))
5025              (while (setq file (pop files))              (while (setq file (pop files))
# Line 4834  directories and save the routine info. Line 5029  directories and save the routine info.
5029                    (message "Scanning %s..." file)                    (message "Scanning %s..." file)
5030                    (erase-buffer)                    (erase-buffer)
5031                    (insert-file-contents file 'visit)                    (insert-file-contents file 'visit)
5032                    (setq idlwave-library-routines                    (setq idlwave-user-catalog-routines
5033                          (append (idlwave-get-routine-info-from-buffers                          (append (idlwave-get-routine-info-from-buffers
5034                                   (list (current-buffer)))                                   (list (current-buffer)))
5035                                  idlwave-library-routines)))                                  idlwave-user-catalog-routines)))))))))
5036                  ))))))      (message "Creating user catalog file...")
     ;; Sorting is not necessary since we sort each time before a routine  
     ;; is used.  So we don't do it here - the catalog file looks nicer  
     ;; when it is unsorted.  
     ;;(message "Sorting...")  
     ;;(setq idlwave-library-routines  
     ;;(sort idlwave-library-routines 'idlwave-routine-entry-compare))  
     ;;(message "Sorting...done")  
     (message "Creating libinfo file...")  
5037      (kill-buffer "*idlwave-scan.pro*")      (kill-buffer "*idlwave-scan.pro*")
5038      (kill-buffer (get-buffer-create "*IDLWAVE Widget*"))      (kill-buffer (get-buffer-create "*IDLWAVE Widget*"))
5039      (let ((font-lock-maximum-size 0)      (let ((font-lock-maximum-size 0)
5040            (auto-mode-alist nil))            (auto-mode-alist nil))
5041        (find-file idlwave-libinfo-file))        (find-file idlwave-user-catalog-file))
5042      (if (and (boundp 'font-lock-mode)      (if (and (boundp 'font-lock-mode)
5043               font-lock-mode)               font-lock-mode)
5044          (font-lock-mode 0))          (font-lock-mode 0))
5045      (erase-buffer)      (erase-buffer)
5046      (insert ";; IDLWAVE libinfo file\n")      (insert ";; IDLWAVE user catalog file\n")
5047      (insert (format ";; Created %s\n\n" (current-time-string)))      (insert (format ";; Created %s\n\n" (current-time-string)))
5048    
     ;; Define the variable which knows the value of "!DIR"  
     (insert (format "\n(setq idlwave-sys-dir \"%s\")\n"  
                     idlwave-sys-dir))  
   
     ;; Define the variable which contains a list of all scanned directories  
     (insert "\n(setq idlwave-path-alist\n    '(")  
     (mapcar (lambda (x)  
               (insert (format "\n      (\"%s\" . %s)" (car x) (cdr x))))  
             path-alist)  
     (insert "))\n")  
   
5049      ;; Define the routine info list      ;; Define the routine info list
5050      (insert "\n(setq idlwave-library-routines\n    '(")      (insert "\n(setq idlwave-user-catalog-routines\n    '(")
5051      (let ((standard-output (current-buffer)))      (let ((standard-output (current-buffer)))
5052        (mapcar (lambda (x)        (mapcar (lambda (x)
5053                  (insert "\n    ")                  (insert "\n    ")
5054                  (prin1 x)                  (prin1 x)
5055                  (goto-char (point-max)))                  (goto-char (point-max)))
5056  ;               (insert (with-output-to-string (prin1 x))))                idlwave-user-catalog-routines))
               idlwave-library-routines))  
5057      (insert (format "))\n\n;;; %s ends here\n"      (insert (format "))\n\n;;; %s ends here\n"
5058                      (file-name-nondirectory idlwave-libinfo-file)))                      (file-name-nondirectory idlwave-user-catalog-file)))
5059      (goto-char (point-min))      (goto-char (point-min))
5060      ;; Save the buffer      ;; Save the buffer
5061      (save-buffer 0)      (save-buffer 0)
5062      (kill-buffer (current-buffer)))      (kill-buffer (current-buffer)))
5063    (message "Creating libinfo file...done")    (message "Creating user catalog file...done")
5064    (message "Info for %d routines saved in %s"    (message "Info for %d routines saved in %s"
5065             (length idlwave-library-routines)             (length idlwave-user-catalog-routines)
5066             idlwave-libinfo-file)             idlwave-user-catalog-file)
5067    (sit-for 2)    (sit-for 2)
5068    (idlwave-update-routine-info t))    (idlwave-update-routine-info t))
5069    
5070    (defun idlwave-read-paths ()
5071      (if (and (stringp idlwave-path-file)
5072               (file-regular-p idlwave-path-file))
5073          (condition-case nil
5074              (load idlwave-path-file t t t)
5075            (error nil))))
5076    
5077    (defun idlwave-write-paths ()
5078      (interactive)
5079      (when (and idlwave-path-alist idlwave-system-directory)
5080        (let ((font-lock-maximum-size 0)
5081              (auto-mode-alist nil))
5082          (find-file idlwave-path-file))
5083        (if (and (boundp 'font-lock-mode)
5084                 font-lock-mode)
5085            (font-lock-mode 0))
5086        (erase-buffer)
5087        (insert ";; IDLWAVE paths\n")
5088        (insert (format ";; Created %s\n\n" (current-time-string)))
5089        ;; Define the variable which knows the value of "!DIR"
5090        (insert (format "\n(setq idlwave-system-directory \"%s\")\n"
5091                        idlwave-system-directory))
5092      
5093        ;; Define the variable which contains a list of all scanned directories
5094        (insert "\n(setq idlwave-path-alist\n    '(")
5095        (let ((standard-output (current-buffer)))
5096          (mapcar (lambda (x)
5097                    (insert "\n      ")
5098                    (prin1 x)
5099                    (goto-char (point-max)))
5100                  idlwave-path-alist))
5101        (insert "))\n")
5102        (save-buffer 0)
5103        (kill-buffer (current-buffer))))
5104    
5105    
5106  (defun idlwave-expand-path (path &optional default-dir)  (defun idlwave-expand-path (path &optional default-dir)
5107    ;; Expand parts of path starting with '+' recursively into directory list.    ;; Expand parts of path starting with '+' recursively into directory list.
5108    ;; Relative recursive path elements are expanded relative to DEFAULT-DIR.    ;; Relative recursive path elements are expanded relative to DEFAULT-DIR.
# Line 4918  directories and save the routine info. Line 5129  directories and save the routine info.
5129        (when (file-directory-p dir)        (when (file-directory-p dir)
5130          (setq files (nreverse (directory-files dir t "[^.]")))          (setq files (nreverse (directory-files dir t "[^.]")))
5131          (while (setq file (pop files))          (while (setq file (pop files))
5132            (if (file-directory-p file)            (if (file-directory-p file)
5133                (push (file-name-as-directory file) path)))                (push (file-name-as-directory file) path)))
5134          (push dir path1)))          (push dir path1)))
5135      path1))      path1))
5136    
5137  ;;----- Asking the shell -------------------  
5138    ;;----- Scanning the library catalogs ------------------
5139    
5140    (defun idlwave-scan-library-catalogs (&optional message-base no-load)
5141      "Scan for library catalog files (.idlwave_catalog) and ingest.  
5142    
5143    All directories on `idlwave-path-alist' (or `idlwave-library-path'
5144    instead, if present) are searched.  Print MESSAGE-BASE along with the
5145    libraries being loaded, if passed, and skip loading/normalizing if
5146    NO-LOAD is non-nil.  The variable `idlwave-use-library-catalogs' can
5147    be set to nil to disable library catalog scanning."
5148      (when idlwave-use-library-catalogs
5149        (let ((dirs
5150               (if idlwave-library-path
5151                   (idlwave-expand-path idlwave-library-path)
5152                 (mapcar 'car idlwave-path-alist)))
5153              (old-libname "")
5154              dir-entry dir flags catalog all-routines)
5155          (if message-base (message message-base))
5156          (while (setq dir (pop dirs))
5157            (catch 'continue
5158              (when (file-readable-p
5159                     (setq catalog (expand-file-name ".idlwave_catalog" dir)))
5160                (unless no-load
5161                  (setq idlwave-library-catalog-routines nil)
5162                  ;; Load the catalog file
5163                  (condition-case nil
5164                      (load catalog t t t)
5165                    (error (throw 'continue t)))
5166                  (when (and
5167                         message-base
5168                         (not (string= idlwave-library-catalog-libname
5169                                       old-libname)))
5170                    (message (concat message-base
5171                                     idlwave-library-catalog-libname))
5172                    (setq old-libname idlwave-library-catalog-libname))
5173                  (when idlwave-library-catalog-routines
5174                    (setq all-routines
5175                          (append
5176                           (idlwave-sintern-rinfo-list
5177                            idlwave-library-catalog-routines 'sys dir)
5178                           all-routines))))
5179                
5180                ;;  Add a 'lib flag if on path-alist
5181                (when (and idlwave-path-alist
5182                           (setq dir-entry (assoc dir idlwave-path-alist)))
5183                  (idlwave-path-alist-add-flag dir-entry 'lib)))))
5184          (unless no-load (setq idlwave-library-catalog-routines all-routines))
5185          (if message-base (message (concat message-base "done"))))))
5186    
5187    ;;----- Communicating with the Shell -------------------
5188    
5189  ;; First, here is the idl program which can be used to query IDL for  ;; First, here is the idl program which can be used to query IDL for
5190  ;; defined routines.  ;; defined routines.
5191  (defconst idlwave-routine-info.pro  (defconst idlwave-routine-info.pro
5192    "    "
5193  ;; START OF IDLWAVE SUPPORT ROUTINES  ;; START OF IDLWAVE SUPPORT ROUTINES
5194  pro idlwave_print_info_entry,name,func=func,separator=sep  pro idlwave_print_info_entry,name,func=func,separator=sep
5195    ;; See if it's an object method    ;; See if it's an object method
5196    if name eq '' then return    if name eq '' then return
5197    func    = keyword_set(func)    func    = keyword_set(func)
5198    methsep = strpos(name,'::')    methsep = strpos(name,'::')
5199    meth    = methsep ne -1    meth    = methsep ne -1
5200      
5201    ;; Get routine info    ;; Get routine info
5202    pars   = routine_info(name,/parameters,functions=func)    pars   = routine_info(name,/parameters,functions=func)
5203    source = routine_info(name,/source,functions=func)    source = routine_info(name,/source,functions=func)
# Line 4944  pro idlwave_print_info_entry,name,func=f Line 5205  pro idlwave_print_info_entry,name,func=f
5205    nkw    = pars.num_kw_args    nkw    = pars.num_kw_args
5206    if nargs gt 0 then args = pars.args    if nargs gt 0 then args = pars.args
5207    if nkw   gt 0 then kwargs = pars.kw_args    if nkw   gt 0 then kwargs = pars.kw_args
5208      
5209    ;; Trim the class, and make the name    ;; Trim the class, and make the name
5210    if meth then begin    if meth then begin
5211        class = strmid(name,0,methsep)        class = strmid(name,0,methsep)
5212        name  = strmid(name,methsep+2,strlen(name)-1)        name  = strmid(name,methsep+2,strlen(name)-1)
5213        if nargs gt 0 then begin        if nargs gt 0 then begin
5214            ;; remove the self argument            ;; remove the self argument
5215            wh = where(args ne 'SELF',nargs)            wh = where(args ne 'SELF',nargs)
5216            if nargs gt 0 then args = args(wh)            if nargs gt 0 then args = args[wh]
5217        endif        endif
5218    endif else begin    endif else begin
5219        ;; No class, just a normal routine.        ;; No class, just a normal routine.
5220        class = \"\"        class = \"\"
5221    endelse    endelse
5222      
5223    ;; Calling sequence    ;; Calling sequence
5224    cs = \"\"    cs = \"\"
5225    if func then cs = 'Result = '    if func then cs = 'Result = '
# Line 4967  pro idlwave_print_info_entry,name,func=f Line 5228  pro idlwave_print_info_entry,name,func=f
5228    if func then cs = cs + '(' else if nargs gt 0 then cs = cs + ', '    if func then cs = cs + '(' else if nargs gt 0 then cs = cs + ', '
5229    if nargs gt 0 then begin    if nargs gt 0 then begin
5230        for j=0,nargs-1 do begin        for j=0,nargs-1 do begin
5231            cs = cs + args(j)            cs = cs + args[j]
5232            if j lt nargs-1 then cs = cs + ', '            if j lt nargs-1 then cs = cs + ', '
5233        endfor        endfor
5234    end    end
# Line 4976  pro idlwave_print_info_entry,name,func=f Line 5237  pro idlwave_print_info_entry,name,func=f
5237    kwstring = ''    kwstring = ''
5238    if nkw gt 0 then begin    if nkw gt 0 then begin
5239        for j=0,nkw-1 do begin        for j=0,nkw-1 do begin
5240            kwstring = kwstring + ' ' + kwargs(j)            kwstring = kwstring + ' ' + kwargs[j]
5241        endfor        endfor
5242    endif    endif
5243      
5244    ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])(func)    ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func]
5245      
5246    print,ret + ': ' + name + sep + class + sep + source(0).path  $    print,ret + ': ' + name + sep + class + sep + source[0].path  $
5247      + sep + cs + sep + kwstring      + sep + cs + sep + kwstring
5248  end  end
5249    
5250  pro idlwave_routine_info  pro idlwave_routine_info
5251      on_error,1
5252    sep = '<@>'    sep = '<@>'
5253    print,'>>>BEGIN OF IDLWAVE ROUTINE INFO (\"' + sep + '\" IS THE SEPARATOR)'    print,'>>>BEGIN OF IDLWAVE ROUTINE INFO (\"' + sep + '\" IS THE SEPARATOR)'
5254    all = routine_info()    all = routine_info()
5255    for i=0,n_elements(all)-1 do $    for i=0,n_elements(all)-1 do $
5256      idlwave_print_info_entry,all(i),separator=sep      idlwave_print_info_entry,all[i],separator=sep
5257    all = routine_info(/functions)    all = routine_info(/functions)
5258    for i=0,n_elements(all)-1 do $    for i=0,n_elements(all)-1 do $
5259      idlwave_print_info_entry,all(i),/func,separator=sep      idlwave_print_info_entry,all[i],/func,separator=sep
5260    print,'>>>END OF IDLWAVE ROUTINE INFO'    print,'>>>END OF IDLWAVE ROUTINE INFO'
5261  end  end
5262    
5263  pro idlwave_get_sysvars  pro idlwave_get_sysvars
5264    forward_function strjoin,strtrim,strsplit    on_error,1
5265    catch,error_status    catch,error_status
5266    if error_status ne 0 then begin    if error_status ne 0 then begin
5267        print, 'Cannot get info about system variables'        print, 'Cannot get info about system variables'
# Line 5020  pro idlwave_get_class_tags, class Line 5282  pro idlwave_get_class_tags, class
5282    if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single)    if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single)
5283  end  end
5284  ;; END OF IDLWAVE SUPPORT ROUTINES  ;; END OF IDLWAVE SUPPORT ROUTINES
5285  "  "
5286    "The idl programs to get info from the shell.")    "The idl programs to get info from the shell.")
5287    
5288  (defvar idlwave-idlwave_routine_info-compiled nil  (defvar idlwave-idlwave_routine_info-compiled nil
# Line 5028  end Line 5290  end
5290    
5291  (defvar idlwave-shell-temp-pro-file)  (defvar idlwave-shell-temp-pro-file)
5292  (defvar idlwave-shell-temp-rinfo-save-file)  (defvar idlwave-shell-temp-rinfo-save-file)
5293  (defun idlwave-shell-update-routine-info (&optional quiet run-hooks preempt)  (defun idlwave-shell-update-routine-info (&optional quiet run-hooks wait)
5294    "Query the shell for routine_info of compiled modules and update the lists."    "Query the shell for routine_info of compiled modules and update the lists."
5295    ;; Save and compile the procedure.  The compiled procedure is then    ;; Save and compile the procedure.  The compiled procedure is then
5296    ;; saved into an IDL SAVE file, to allow for fast RESTORE.    ;; saved into an IDL SAVE file, to allow for fast RESTORE.
# Line 5043  end Line 5305  end
5305        (erase-buffer)        (erase-buffer)
5306        (insert idlwave-routine-info.pro)        (insert idlwave-routine-info.pro)
5307        (save-buffer 0))        (save-buffer 0))
5308      (idlwave-shell-send-command      (idlwave-shell-send-command
5309       (concat ".run " idlwave-shell-temp-pro-file)       (concat ".run " idlwave-shell-temp-pro-file)
5310       nil 'hide)       nil 'hide wait)
5311  ;    (message "SENDING SAVE") ; ????????????????????????  ;    (message "SENDING SAVE") ; ????????????????????????
5312      (idlwave-shell-send-command      (idlwave-shell-send-command
5313       (format "save,'idlwave_routine_info','idlwave_print_info_entry',FILE='%s',/ROUTINES"       (format "save,'idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES"
5314               (idlwave-shell-temp-file 'rinfo))               (idlwave-shell-temp-file 'rinfo))
5315       nil 'hide))       nil 'hide wait))
5316    
5317    ;; Restore and execute the procedure, analyze the output    ;; Restore and execute the procedure, analyze the output
5318  ;  (message "SENDING RESTORE & EXECUTE") ; ????????????????????????  ;  (message "SENDING RESTORE & EXECUTE") ; ????????????????????????
# Line 5060  end Line 5322  end
5322     `(progn     `(progn
5323        (idlwave-shell-routine-info-filter)        (idlwave-shell-routine-info-filter)
5324        (idlwave-concatenate-rinfo-lists ,quiet ,run-hooks))        (idlwave-concatenate-rinfo-lists ,quiet ,run-hooks))
5325     'hide preempt))     'hide wait))
5326    
5327  ;; ---------------------------------------------------------------------------  ;; ---------------------------------------------------------------------------
5328  ;;  ;;
5329  ;; Completion and displaying routine calling sequences  ;; Completion and displaying routine calling sequences
5330    
5331  (defvar idlwave-completion-help-info nil)  (defvar idlwave-completion-help-info nil)
5332    (defvar idlwave-completion-help-links nil)
5333  (defvar idlwave-current-obj_new-class nil)  (defvar idlwave-current-obj_new-class nil)
5334  (defvar idlwave-complete-special nil)  (defvar idlwave-complete-special nil)
5335    
# Line 5111  Possible values are: Line 5374  Possible values are:
5374  As a special case, the universal argument C-u forces completion of  As a special case, the universal argument C-u forces completion of
5375  function names in places where the default would be a keyword.  function names in places where the default would be a keyword.
5376    
5377    Two prefix argument, C-u C-u, prompts for a regexp by which to limit
5378    completion.
5379    
5380  For Lisp programmers only:  For Lisp programmers only:
5381  When we force a keyword, optional argument MODULE can contain the module name.  When we force a keyword, optional argument MODULE can contain the module name.
5382  When we force a method or a method keyword, CLASS can specify the class."  When we force a method or a method keyword, CLASS can specify the class."
# Line 5118  When we force a method or a method keywo Line 5384  When we force a method or a method keywo
5384    (idlwave-routines)    (idlwave-routines)
5385    (let* ((where-list    (let* ((where-list
5386            (if (and arg            (if (and arg
5387                     (or (integerp arg)                     (or (and (integerp arg) (not (equal arg '(16))))
5388                         (symbolp arg)))                         (symbolp arg)))
5389                (idlwave-make-force-complete-where-list arg module class)                (idlwave-make-force-complete-where-list arg module class)
5390              (idlwave-where)))              (idlwave-where)))
5391           (what (nth 2 where-list))           (what (nth 2 where-list))
5392           (idlwave-force-class-query (equal arg '(4))))           (idlwave-force-class-query (equal arg '(4)))
5393             (completion-regexp-list
5394              (if (equal arg '(16))
5395                  (list (read-string (concat "Completion Regexp: "))))))
5396        
5397      (if (and module (string-match "::" module))      (if (and module (string-match "::" module))
5398          (setq class (substring module 0 (match-beginning 0))          (setq class (substring module 0 (match-beginning 0))
5399                module (substring module (match-end 0))))                module (substring module (match-end 0))))
# Line 5137  When we force a method or a method keywo Line 5406  When we force a method or a method keywo
5406        (setq this-command last-command)        (setq this-command last-command)
5407        (idlwave-scroll-completions))        (idlwave-scroll-completions))
5408    
5409       ;; Check for any special completion functions       ;; Complete a filename in quotes
      ((and idlwave-complete-special  
            (idlwave-call-special idlwave-complete-special)))  
   
5410       ((and (idlwave-in-quote)       ((and (idlwave-in-quote)
5411             (not (eq what 'class)))             (not (eq what 'class)))
5412        (idlwave-complete-filename))        (idlwave-complete-filename))
5413    
5414         ;; Check for any special completion functions
5415         ((and idlwave-complete-special
5416               (idlwave-call-special idlwave-complete-special)))
5417        
5418       ((null what)       ((null what)
5419        (error "Nothing to complete here"))        (error "Nothing to complete here"))
5420    
5421         ;; Complete a class
5422       ((eq what 'class)       ((eq what 'class)
5423        (setq idlwave-completion-help-info '(class))        (setq idlwave-completion-help-info '(class))
5424        (idlwave-complete-class))        (idlwave-complete-class))
# Line 5160  When we force a method or a method keywo Line 5431  When we force a method or a method keywo
5431                                (idlwave-all-class-inherits class-selector)))                                (idlwave-all-class-inherits class-selector)))
5432               (isa (concat "procedure" (if class-selector "-method" "")))               (isa (concat "procedure" (if class-selector "-method" "")))
5433               (type-selector 'pro))               (type-selector 'pro))
5434          (setq idlwave-completion-help-info          (setq idlwave-completion-help-info
5435                (list 'routine nil type-selector class-selector nil super-classes))                (list 'routine nil type-selector class-selector nil super-classes))
5436          (idlwave-complete-in-buffer          (idlwave-complete-in-buffer
5437           'procedure (if class-selector 'method 'routine)           'procedure (if class-selector 'method 'routine)
# Line 5168  When we force a method or a method keywo Line 5439  When we force a method or a method keywo
5439           (format "Select a %s name%s"           (format "Select a %s name%s"
5440                   isa                   isa
5441                   (if class-selector                   (if class-selector
5442                       (format " (class is %s)"                       (format " (class is %s)"
5443                               (if (eq class-selector t)                               (if (eq class-selector t)
5444                                   "unknown" class-selector))                                   "unknown" class-selector))
5445                     ""))                     ""))
5446           isa           isa
5447           'idlwave-attach-method-classes)))           'idlwave-attach-method-classes 'idlwave-add-file-link-selector)))
5448    
5449       ((eq what 'function)       ((eq what 'function)
5450        ;; Complete a function name        ;; Complete a function name
# Line 5183  When we force a method or a method keywo Line 5454  When we force a method or a method keywo
5454                                (idlwave-all-class-inherits class-selector)))                                (idlwave-all-class-inherits class-selector)))
5455               (isa (concat "function" (if class-selector "-method" "")))               (isa (concat "function" (if class-selector "-method" "")))
5456               (type-selector 'fun))               (type-selector 'fun))
5457          (setq idlwave-completion-help-info          (setq idlwave-completion-help-info
5458                (list 'routine nil type-selector class-selector nil super-classes))                (list 'routine nil type-selector class-selector nil super-classes))
5459          (idlwave-complete-in-buffer          (idlwave-complete-in-buffer
5460           'function (if class-selector 'method 'routine)           'function (if class-selector 'method 'routine)
# Line 5191  When we force a method or a method keywo Line 5462  When we force a method or a method keywo
5462           (format "Select a %s name%s"           (format "Select a %s name%s"
5463                   isa                   isa
5464                   (if class-selector                   (if class-selector
5465                       (format " (class is %s)"                       (format " (class is %s)"
5466                               (if (eq class-selector t)                               (if (eq class-selector t)
5467                                   "unknown" class-selector))                                   "unknown" class-selector))
5468                     ""))                     ""))
5469           isa           isa
5470           'idlwave-attach-method-classes)))           'idlwave-attach-method-classes 'idlwave-add-file-link-selector)))
5471    
5472       ((and (memq what '(procedure-keyword function-keyword))       ((and (memq what '(procedure-keyword function-keyword)) ; Special Case
5473             (equal arg '(4)))             (equal arg '(4)))
5474        (idlwave-complete 3))        (idlwave-complete 3))
5475    
# Line 5214  When we force a method or a method keywo Line 5485  When we force a method or a method keywo
5485               (isa (format "procedure%s-keyword" (if class "-method" "")))               (isa (format "procedure%s-keyword" (if class "-method" "")))
5486               (entry (idlwave-best-rinfo-assq               (entry (idlwave-best-rinfo-assq
5487                       name 'pro class (idlwave-routines)))                       name 'pro class (idlwave-routines)))
5488               (list (nth 5 entry)))               (list (idlwave-entry-keywords entry 'do-link)))
5489          (unless (or entry (eq class t))          (unless (or entry (eq class t))
5490            (error "Nothing known about procedure %s"            (error "Nothing known about procedure %s"
5491                   (idlwave-make-full-name class name)))                   (idlwave-make-full-name class name)))
5492          (setq list (idlwave-fix-keywords name 'pro class list))          (setq list (idlwave-fix-keywords name 'pro class list super-classes))
5493          (unless list (error (format "No keywords available for procedure %s"          (unless list (error (format "No keywords available for procedure %s"
5494                                      (idlwave-make-full-name class name))))                                      (idlwave-make-full-name class name))))
5495          (setq idlwave-completion-help-info          (setq idlwave-completion-help-info
5496                (list 'keyword name type-selector class-selector nil super-classes))                (list 'keyword name type-selector class-selector entry super-classes))
5497          (idlwave-complete-in-buffer          (idlwave-complete-in-buffer
5498           'keyword 'keyword list nil           'keyword 'keyword list nil
5499           (format "Select keyword for procedure %s%s"           (format "Select keyword for procedure %s%s"
5500                   (idlwave-make-full-name class name)                   (idlwave-make-full-name class name)
5501                   (if (or (member '("_EXTRA") list)                   (if (or (member '("_EXTRA") list)
5502                           (member '("_REF_EXTRA") list))                           (member '("_REF_EXTRA") list))                  
5503                       " (note _EXTRA)" ""))                       " (note _EXTRA)" ""))
5504           isa           isa
5505           'idlwave-attach-keyword-classes)))           'idlwave-attach-keyword-classes)))
# Line 5245  When we force a method or a method keywo Line 5516  When we force a method or a method keywo
5516               (isa (format "function%s-keyword" (if class "-method" "")))               (isa (format "function%s-keyword" (if class "-method" "")))
5517               (entry (idlwave-best-rinfo-assq               (entry (idlwave-best-rinfo-assq
5518                       name 'fun class (idlwave-routines)))                       name 'fun class (idlwave-routines)))
5519               (list (nth 5 entry))               (list (idlwave-entry-keywords entry 'do-link))
5520               msg-name)               msg-name)
5521          (unless (or entry (eq class t))          (unless (or entry (eq class t))
5522            (error "Nothing known about function %s"            (error "Nothing known about function %s"
5523                   (idlwave-make-full-name class name)))                   (idlwave-make-full-name class name)))
5524          (setq list (idlwave-fix-keywords name 'fun class list))          (setq list (idlwave-fix-keywords name 'fun class list super-classes))
5525          ;; OBJ_NEW: Messages mention the proper Init method          ;; OBJ_NEW: Messages mention the proper Init method
5526          (setq msg-name (if (and (null class)          (setq msg-name (if (and (null class)
5527                                  (string= (upcase name) "OBJ_NEW"))                                  (string= (upcase name) "OBJ_NEW"))
# Line 5259  When we force a method or a method keywo Line 5530  When we force a method or a method keywo
5530                           (idlwave-make-full-name class name)))                           (idlwave-make-full-name class name)))
5531          (unless list (error (format "No keywords available for function %s"          (unless list (error (format "No keywords available for function %s"
5532                                      msg-name)))                                      msg-name)))
5533          (setq idlwave-completion-help-info          (setq idlwave-completion-help-info
5534                (list 'keyword name type-selector class-selector nil super-classes))                (list 'keyword name type-selector class-selector nil super-classes))
5535          (idlwave-complete-in-buffer          (idlwave-complete-in-buffer
5536           'keyword 'keyword list nil           'keyword 'keyword list nil
5537           (format "Select keyword for function %s%s" msg-name           (format "Select keyword for function %s%s" msg-name
5538                   (if (or (member '("_EXTRA") list)                   (if (or (member '("_EXTRA") list)
5539                           (member '("_REF_EXTRA") list))                           (member '("_REF_EXTRA") list))                  
5540                       " (note _EXTRA)" ""))                       " (note _EXTRA)" ""))
5541           isa           isa
5542           'idlwave-attach-keyword-classes)))           'idlwave-attach-keyword-classes)))
# Line 5274  When we force a method or a method keywo Line 5545  When we force a method or a method keywo
5545    
5546  (defvar idlwave-complete-special nil  (defvar idlwave-complete-special nil
5547    "List of special completion functions.    "List of special completion functions.
5548  These functions are called for each completion.  Each function must check  These functions are called for each completion.  Each function must
5549  if its own special completion context is present.  If yes, it should  check if its own special completion context is present.  If yes, it
5550  use `idlwave-complete-in-buffer' to do some completion and return t.  should use `idlwave-complete-in-buffer' to do some completion and
5551  If such a function returns t, *no further* attempts to complete  return t.  If such a function returns t, *no further* attempts to
5552  other contexts will be done.  If the function returns nil, other completions  complete other contexts will be done.  If the function returns nil,
5553  will be tried.")  other completions will be tried.")
5554    
5555  (defun idlwave-call-special (functions &rest args)  (defun idlwave-call-special (functions &rest args)
5556    (let ((funcs functions)    (let ((funcs functions)
# Line 5303  will be tried.") Line 5574  will be tried.")
5574                        ("class")))                        ("class")))
5575           (module (idlwave-sintern-routine-or-method module class))           (module (idlwave-sintern-routine-or-method module class))
5576           (class (idlwave-sintern-class class))           (class (idlwave-sintern-class class))
5577           (what (cond           (what (cond
5578                  ((equal what 0)                  ((equal what 0)
5579                   (setq what                   (setq what
5580                         (intern (completing-read                         (intern (completing-read
5581                                  "Complete what? " what-list nil t))))                                  "Complete what? " what-list nil t))))
5582                  ((integerp what)                  ((integerp what)
5583                   (setq what (intern (car (nth (1- what) what-list)))))                   (setq what (intern (car (nth (1- what) what-list)))))
# Line 5328  will be tried.") Line 5599  will be tried.")
5599               (super-classes nil)               (super-classes nil)
5600               (type-selector 'pro)               (type-selector 'pro)
5601               (pro (or module               (pro (or module
5602                        (idlwave-completing-read                        (idlwave-completing-read
5603                         "Procedure: " (idlwave-routines) 'idlwave-selector))))                         "Procedure: " (idlwave-routines) 'idlwave-selector))))
5604          (setq pro (idlwave-sintern-routine pro))          (setq pro (idlwave-sintern-routine pro))
5605          (list nil-list nil-list 'procedure-keyword          (list nil-list nil-list 'procedure-keyword
# Line 5342  will be tried.") Line 5613  will be tried.")
5613               (super-classes nil)               (super-classes nil)
5614               (type-selector 'fun)               (type-selector 'fun)
5615               (func (or module               (func (or module
5616                         (idlwave-completing-read                         (idlwave-completing-read
5617                          "Function: " (idlwave-routines) 'idlwave-selector))))                          "Function: " (idlwave-routines) 'idlwave-selector))))
5618          (setq func (idlwave-sintern-routine func))          (setq func (idlwave-sintern-routine func))
5619          (list nil-list nil-list 'function-keyword          (list nil-list nil-list 'function-keyword
# Line 5382  will be tried.") Line 5653  will be tried.")
5653    
5654       ((eq what 'class)       ((eq what 'class)
5655        (list nil-list nil-list 'class nil-list nil))        (list nil-list nil-list 'class nil-list nil))
5656        
5657       (t (error "Illegal value for WHAT")))))       (t (error "Illegal value for WHAT")))))
5658    
5659  (defun idlwave-completing-read (&rest args)  (defun idlwave-completing-read (&rest args)
# Line 5405  will be tried.") Line 5676  will be tried.")
5676                      (stringp idlwave-shell-default-directory)                      (stringp idlwave-shell-default-directory)
5677                      (file-directory-p idlwave-shell-default-directory))                      (file-directory-p idlwave-shell-default-directory))
5678                 idlwave-shell-default-directory                 idlwave-shell-default-directory
5679               default-directory)))               default-directory)))          
5680      (comint-dynamic-complete-filename)))      (comint-dynamic-complete-filename)))
5681    
5682  (defun idlwave-make-full-name (class name)  (defun idlwave-make-full-name (class name)
# Line 5414  will be tried.") Line 5685  will be tried.")
5685    
5686  (defun idlwave-rinfo-assoc (name type class list)  (defun idlwave-rinfo-assoc (name type class list)
5687    "Like `idlwave-rinfo-assq', but sintern strings first."    "Like `idlwave-rinfo-assq', but sintern strings first."
5688    (idlwave-rinfo-assq    (idlwave-rinfo-assq
5689     (idlwave-sintern-routine-or-method name class)     (idlwave-sintern-routine-or-method name class)
5690     type (idlwave-sintern-class class) list))     type (idlwave-sintern-class class) list))
5691    
# Line 5430  will be tried.") Line 5701  will be tried.")
5701          (setq list (cdr (memq match list)))))))          (setq list (cdr (memq match list)))))))
5702    
5703  (defun idlwave-rinfo-assq-any-class (name type class list)  (defun idlwave-rinfo-assq-any-class (name type class list)
5704      ;; Return the first matching method on the inheritance list
5705    (let* ((classes (cons class (idlwave-all-class-inherits class)))    (let* ((classes (cons class (idlwave-all-class-inherits class)))
5706           class rtn)           class rtn)
5707      (while classes      (while classes
# Line 5437  will be tried.") Line 5709  will be tried.")
5709            (setq classes nil)))            (setq classes nil)))
5710      rtn))      rtn))
5711    
5712  (defun idlwave-best-rinfo-assq (name type class list)  (defun idlwave-best-rinfo-assq (name type class list &optional with-file
5713    "Like `idlwave-rinfo-assq', but get all twins and sort, then return first."                                       keep-system)
5714      "Like `idlwave-rinfo-assq', but get all twins and sort, then return first.
5715    If WITH-FILE is passed, find the best rinfo entry with a file
5716    included.  If KEEP-SYSTEM is set, don't prune system for compiled
5717    syslib files."
5718    (let ((twins (idlwave-routine-twins    (let ((twins (idlwave-routine-twins
5719                  (idlwave-rinfo-assq-any-class name type class list)                  (idlwave-rinfo-assq-any-class name type class list)
5720                  list))                  list))
5721          syslibp)          syslibp)
5722      (when (> (length twins) 1)      (when (> (length twins) 1)
5723        (setq twins (sort twins 'idlwave-routine-entry-compare-twins))        (setq twins (sort twins 'idlwave-routine-entry-compare-twins))
5724        (if (and (eq 'system (car (nth 3 (car twins))))        (if (and (null keep-system)
5725                   (eq 'system (car (nth 3 (car twins))))
5726                 (setq syslibp (idlwave-any-syslib (cdr twins)))                 (setq syslibp (idlwave-any-syslib (cdr twins)))
5727                 (not (equal 1 syslibp)))                 (not (equal 1 syslibp)))
5728            ;; Its a syslib, so we need to remove the system entry            ;; Its a compiled syslib, so we need to remove the system entry
5729            (setq twins (cdr twins))))            (setq twins (cdr twins)))
5730          (if with-file
5731              (setq twins (delq nil
5732                                (mapcar (lambda (x)
5733                                          (if (nth 1 (nth 3 x)) x))
5734                                        twins)))))
5735      (car twins)))      (car twins)))
5736    
5737  (defun idlwave-best-rinfo-assoc (name type class list)  (defun idlwave-best-rinfo-assoc (name type class list &optional with-file
5738                                         keep-system)
5739    "Like `idlwave-best-rinfo-assq', but sintern strings first."    "Like `idlwave-best-rinfo-assq', but sintern strings first."
5740    (idlwave-best-rinfo-assq    (idlwave-best-rinfo-assq
5741     (idlwave-sintern-routine-or-method name class)     (idlwave-sintern-routine-or-method name class)
5742     type (idlwave-sintern-class class) list))     type (idlwave-sintern-class class) list with-file keep-system))
5743    
5744  (defun idlwave-any-syslib (entries)  (defun idlwave-any-syslib (entries)
5745    "Does the entry list ENTRIES contain a syslib entry?    "Does the entry list ENTRIES contain a syslib entry?
# Line 5465  If yes, return the index (>=1)." Line 5748  If yes, return the index (>=1)."
5748      (catch 'exit      (catch 'exit
5749        (while entries        (while entries
5750          (incf cnt)          (incf cnt)
5751          (setq file (cdr (nth 3 (car entries))))          (setq file (idlwave-routine-source-file (nth 3 (car entries))))
5752          (if (and file          (if (and file (idlwave-syslib-p file))
                  (idlwave-syslib-p  
                   (idlwave-expand-lib-file-name file)))  
5753              (throw 'exit cnt)              (throw 'exit cnt)
5754            (setq entries (cdr entries))))            (setq entries (cdr entries))))
5755        nil)))        nil)))
# Line 5504  When TYPE is not specified, both procedu Line 5785  When TYPE is not specified, both procedu
5785        nil        nil
5786      (let (rtn)      (let (rtn)
5787        (mapcar (lambda (x)        (mapcar (lambda (x)
5788                  (and (nth 2 x)                  (and (nth 2 x)           ; non-nil class
5789                       (or (not type)                       (or (not type)      ; correct or unspecified type
5790                           (eq type (nth 1 x)))                           (eq type (nth 1 x)))
5791                       (assoc keyword (nth 5 x))                       (assoc keyword (idlwave-entry-keywords x))
5792                       (push (nth 2 x) rtn)))                       (push (nth 2 x) rtn)))
5793                (idlwave-all-assq method (idlwave-routines)))                (idlwave-all-assq method (idlwave-routines)))
5794        (idlwave-uniquify rtn))))        (idlwave-uniquify rtn))))
# Line 5544  INFO is as returned by idlwave-what-func Line 5825  INFO is as returned by idlwave-what-func
5825  Must accept two arguments: `apos' and `info'")  Must accept two arguments: `apos' and `info'")
5826    
5827  (defun idlwave-determine-class (info type)  (defun idlwave-determine-class (info type)
5828    ;; Determine the class of a routine call.    ;; Determine the class of a routine call.  
5829    ;; INFO is the `cw-list' structure as returned by idlwave-where.    ;; INFO is the `cw-list' structure as returned by idlwave-where.
5830    ;; The second element in this structure is the class.  When nil, we    ;; The second element in this structure is the class.  When nil, we
5831    ;; return nil.  When t, try to get the class from text properties at    ;; return nil.  When t, try to get the class from text properties at
# Line 5564  Must accept two arguments: `apos' and `i Line 5845  Must accept two arguments: `apos' and `i
5845                        (dassoc (cdr dassoc))                        (dassoc (cdr dassoc))
5846                        (t t)))                        (t t)))
5847           (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->")))           (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->")))
5848           (is-self           (is-self
5849            (and arrow            (and arrow
5850                 (save-excursion (goto-char apos)                 (save-excursion (goto-char apos)
5851                                 (forward-word -1)                                 (forward-word -1)
# Line 5585  Must accept two arguments: `apos' and `i Line 5866  Must accept two arguments: `apos' and `i
5866            (setq class (or (nth 2 (idlwave-current-routine)) class)))            (setq class (or (nth 2 (idlwave-current-routine)) class)))
5867    
5868        ;; Before prompting, try any special class determination routines        ;; Before prompting, try any special class determination routines
5869        (when (and (eq t class)        (when (and (eq t class)
5870                   idlwave-determine-class-special                   idlwave-determine-class-special
5871                   (not force-query))                   (not force-query))
5872          (setq special-class          (setq special-class
5873                (idlwave-call-special idlwave-determine-class-special apos))                (idlwave-call-special idlwave-determine-class-special apos))
5874          (if special-class          (if special-class
5875              (setq class (idlwave-sintern-class special-class)              (setq class (idlwave-sintern-class special-class)
5876                    store idlwave-store-inquired-class)))                    store idlwave-store-inquired-class)))
5877          
5878        ;; Prompt for a class, if we need to        ;; Prompt for a class, if we need to
5879        (when (and (eq class t)        (when (and (eq class t)
5880                   (or force-query query))                   (or force-query query))
5881          (setq class-alist          (setq class-alist
5882                (mapcar 'list (idlwave-all-method-classes (car info) type)))                (mapcar 'list (idlwave-all-method-classes (car info) type)))
5883          (setq class          (setq class
5884                (idlwave-sintern-class                (idlwave-sintern-class
# Line 5606  Must accept two arguments: `apos' and `i Line 5887  Must accept two arguments: `apos' and `i
5887                   (error "No classes available with method %s" (car info)))                   (error "No classes available with method %s" (car info)))
5888                  ((and (= (length class-alist) 1) (not force-query))                  ((and (= (length class-alist) 1) (not force-query))
5889                   (car (car class-alist)))                   (car (car class-alist)))
5890                  (t                  (t
5891                   (setq store idlwave-store-inquired-class)                   (setq store idlwave-store-inquired-class)
5892                   (idlwave-completing-read                   (idlwave-completing-read
5893                    (format "Class%s: " (if (stringp (car info))                    (format "Class%s: " (if (stringp (car info))
5894                                            (format " for %s method %s"                                            (format " for %s method %s"
5895                                                    type (car info))                                                    type (car info))
# Line 5620  Must accept two arguments: `apos' and `i Line 5901  Must accept two arguments: `apos' and `i
5901          ;; We have a real class here          ;; We have a real class here
5902          (when (and store arrow)          (when (and store arrow)
5903            (condition-case ()            (condition-case ()
5904                (add-text-properties                (add-text-properties
5905                 apos (+ apos 2)                 apos (+ apos 2)
5906                 `(idlwave-class ,class face ,idlwave-class-arrow-face                 `(idlwave-class ,class face ,idlwave-class-arrow-face
5907                                 rear-nonsticky t))                                 rear-nonsticky t))
5908              (error nil)))              (error nil)))
5909          (setf (nth 2 info) class))          (setf (nth 2 info) class))
# Line 5639  Must accept two arguments: `apos' and `i Line 5920  Must accept two arguments: `apos' and `i
5920    (and (eq (nth 1 a) type-selector)    (and (eq (nth 1 a) type-selector)
5921         (or (and (nth 2 a) (eq class-selector t))         (or (and (nth 2 a) (eq class-selector t))
5922             (eq (nth 2 a) class-selector)             (eq (nth 2 a) class-selector)
5923             (memq (nth 2 a) super-classes)             (memq (nth 2 a) super-classes))))
5924             )))  
5925    (defun idlwave-add-file-link-selector (a)
5926      ;; Record a file link, if any, for the tested names during selection.
5927      (let ((sel (idlwave-selector a)) file)
5928        (if (and sel (setq file (idlwave-entry-has-help a)))
5929            (push (cons (car a) file) idlwave-completion-help-links))
5930        sel))
5931    
5932    
5933  (defun idlwave-where ()  (defun idlwave-where ()
5934    "Find out where we are.    "Find out where we are.
5935  The return value is a list with the following stuff:  The return value is a list with the following stuff:
5936  \(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR)  \(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR)
5937    
5938  PRO-LIST       (PRO POINT CLASS ARROW)  PRO-LIST       (PRO POINT CLASS ARROW)
5939  FUNC-LIST      (FUNC POINT CLASS ARROW)  FUNC-LIST      (FUNC POINT CLASS ARROW)
5940  COMPLETE-WHAT  a symbol indicating what kind of completion makes sense here  COMPLETE-WHAT  a symbol indicating what kind of completion makes sense here
5941  CW-LIST        (PRO-OR-FUNC POINT CLASS ARROW)  Like PRO-LIST, for what can  CW-LIST        (PRO-OR-FUNC POINT CLASS ARROW)  Like PRO-LIST, for what can
5942                 be completed here.                 be completed here.
5943  LAST-CHAR      last relevant character before point (non-white non-comment,  LAST-CHAR      last relevant character before point (non-white non-comment,
5944                 not part of current identifier or leading slash).                 not part of current identifier or leading slash).
# Line 5662  POINT:  Where is this Line 5950  POINT:  Where is this
5950  CLASS:  What class has the routine (nil=no, t=is method, but class unknown)  CLASS:  What class has the routine (nil=no, t=is method, but class unknown)
5951  ARROW:  Location of the arrow"  ARROW:  Location of the arrow"
5952    (idlwave-routines)    (idlwave-routines)
5953    (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point)))    (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point)))
5954           (bos (save-excursion (idlwave-start-of-substatement 'pre) (point)))           (bos (save-excursion (idlwave-start-of-substatement 'pre) (point)))
5955           (func-entry (idlwave-what-function bos))           (func-entry (idlwave-what-function bos))
5956           (func (car func-entry))           (func (car func-entry))
# Line 5677  ARROW:  Location of the arrow" Line 5965  ARROW:  Location of the arrow"
5965           (pro-point (or (nth 3 pro-entry) 0))           (pro-point (or (nth 3 pro-entry) 0))
5966           (last-char (idlwave-last-valid-char))           (last-char (idlwave-last-valid-char))
5967           (case-fold-search t)           (case-fold-search t)
5968             (match-string (buffer-substring bos (point)))
5969           cw cw-mod cw-arrow cw-class cw-point)           cw cw-mod cw-arrow cw-class cw-point)
5970      (if (< func-point pro-point) (setq func nil))      (if (< func-point pro-point) (setq func nil))
5971      (cond      (cond
5972       ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'"       ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'"
5973                      (buffer-substring bos (point)))                      match-string)
5974        (setq cw 'class))        (setq cw 'class))
5975       ((string-match       ((string-match
5976         "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'"         "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'"
5977         (buffer-substring (if (> pro-point 0) pro-point bos) (point)))         (if (> pro-point 0)
5978               (buffer-substring pro-point (point))
5979             match-string))
5980        (setq cw 'procedure cw-class pro-class cw-point pro-point        (setq cw 'procedure cw-class pro-class cw-point pro-point
5981              cw-arrow pro-arrow))              cw-arrow pro-arrow))
5982       ((string-match "\\`[ \t]*\\(pro\\|function\\)\\>"       ((string-match "\\`[ \t]*\\(pro\\|function\\)\\>"
5983                      (buffer-substring bos (point)))                      match-string)
5984        nil)        nil)
5985       ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'"       ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'"
5986                      (buffer-substring bos (point)))                      match-string)
5987        (setq cw 'class))        (setq cw 'class))                    
5988       ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'"       ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'"
5989                      (buffer-substring bos (point)))                      match-string)
5990        (setq cw 'class))        (setq cw 'class))                    
5991       ((and func       ((and func
5992             (> func-point pro-point)             (> func-point pro-point)
5993             (= func-level 1)             (= func-level 1)
5994             (memq last-char '(?\( ?,)))             (memq last-char '(?\( ?,)))
# Line 5715  ARROW:  Location of the arrow" Line 6006  ARROW:  Location of the arrow"
6006       (t       (t
6007        (setq cw 'function)        (setq cw 'function)
6008        (save-excursion        (save-excursion
6009          (if (re-search-backward "->[ \t]*\\(\\([$a-zA-Z0-9_]+\\)::\\)?[$a-zA-Z0-9_]*\\=" bos t)          (if (re-search-backward "->[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\s-*\\)?\\(\\([$a-zA-Z0-9_]+\\)::\\)?[$a-zA-Z0-9_]*\\=" bos t)
6010              (setq cw-arrow (copy-marker (match-beginning 0))              (setq cw-arrow (copy-marker (match-beginning 0))
6011                    cw-class (if (match-end 2)                    cw-class (if (match-end 4)
6012                                 (idlwave-sintern-class (match-string 2))                                 (idlwave-sintern-class (match-string 4))
6013                               t))))))                               t))))))
6014      (list (list pro pro-point pro-class pro-arrow)      (list (list pro pro-point pro-class pro-arrow)
6015            (list func func-point func-class func-arrow)            (list func func-point func-class func-arrow)
# Line 5728  ARROW:  Location of the arrow" Line 6019  ARROW:  Location of the arrow"
6019    
6020  (defun idlwave-this-word (&optional class)  (defun idlwave-this-word (&optional class)
6021    ;; Grab the word around point.  CLASS is for the `skip-chars=...' functions    ;; Grab the word around point.  CLASS is for the `skip-chars=...' functions
6022    (setq class (or class "a-zA-Z0-9$_"))    (setq class (or class "a-zA-Z0-9$_."))
6023    (save-excursion    (save-excursion
6024      (buffer-substring-no-properties      (buffer-substring
6025       (progn (skip-chars-backward class) (point))       (progn (skip-chars-backward class) (point))
6026       (progn (skip-chars-forward  class) (point)))))       (progn (skip-chars-forward  class) (point)))))
6027    
# Line 5743  ARROW:  Location of the arrow" Line 6034  ARROW:  Location of the arrow"
6034    ;;    searches to this point.    ;;    searches to this point.
6035    
6036    (catch 'exit    (catch 'exit
6037      (let (pos      (let (pos
6038            func-point            func-point
6039            (cnt 0)            (cnt 0)
6040            func arrow-start class)            func arrow-start class)
# Line 5758  ARROW:  Location of the arrow" Line 6049  ARROW:  Location of the arrow"
6049               (setq pos (point))               (setq pos (point))
6050               (incf cnt)               (incf cnt)
6051               (when (and (= (following-char) ?\()               (when (and (= (following-char) ?\()
6052                          (re-search-backward                          (re-search-backward
6053                           "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\="                           "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\="
6054                           bound t))                           bound t))
6055                 (setq func (match-string 2)                 (setq func (match-string 2)
6056                       func-point (goto-char (match-beginning 2))                       func-point (goto-char (match-beginning 2))
6057                       pos func-point)                       pos func-point)
6058                 (if (re-search-backward                 (if (re-search-backward
6059                      "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t)                      "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t)
6060                     (setq arrow-start (copy-marker (match-beginning 0))                     (setq arrow-start (copy-marker (match-beginning 0))
6061                           class (or (match-string 2) t)))                           class (or (match-string 2) t)))
6062                 (throw                 (throw
6063                  'exit                  'exit
6064                  (list                  (list
6065                   (idlwave-sintern-routine-or-method func class)                   (idlwave-sintern-routine-or-method func class)
6066                   (idlwave-sintern-class class)                   (idlwave-sintern-class class)
# Line 5785  ARROW:  Location of the arrow" Line 6076  ARROW:  Location of the arrow"
6076    ;;    searches to this point.    ;;    searches to this point.
6077    (let ((pos (point)) pro-point    (let ((pos (point)) pro-point
6078          pro class arrow-start string)          pro class arrow-start string)
6079      (save-excursion      (save-excursion
6080        ;;(idlwave-beginning-of-statement)        ;;(idlwave-beginning-of-statement)
6081        (idlwave-start-of-substatement 'pre)        (idlwave-start-of-substatement 'pre)
6082        (setq string (buffer-substring (point) pos))        (setq string (buffer-substring (point) pos))
6083        (if (string-match        (if (string-match
6084             "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string)             "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string)
6085            (setq pro (match-string 1 string)            (setq pro (match-string 1 string)
6086                  pro-point (+ (point) (match-beginning 1)))                  pro-point (+ (point) (match-beginning 1)))
6087          (if (and (idlwave-skip-object)          (if (and (idlwave-skip-object)
6088                   (setq string (buffer-substring (point) pos))                   (setq string (buffer-substring (point) pos))
6089                   (string-match                   (string-match
6090                    "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\'\\)" string))                    "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)"
6091                      string))
6092              (setq pro (if (match-beginning 4)              (setq pro (if (match-beginning 4)
6093                            (match-string 4 string))                            (match-string 4 string))
6094                    pro-point (if (match-beginning 4)                    pro-point (if (match-beginning 4)
# Line 5839  ARROW:  Location of the arrow" Line 6131  ARROW:  Location of the arrow"
6131                (throw 'exit nil))))                (throw 'exit nil))))
6132          (goto-char pos)          (goto-char pos)
6133        nil)))        nil)))
6134      
6135  (defun idlwave-last-valid-char ()  (defun idlwave-last-valid-char ()
6136    "Return the last character before point which is not white or a comment    "Return the last character before point which is not white or a comment
6137  and also not part of the current identifier.  Since we do this in  and also not part of the current identifier.  Since we do this in
# Line 5874  This function is not general, can only b Line 6166  This function is not general, can only b
6166    "A mark pointing to the beginning of the completion string.")    "A mark pointing to the beginning of the completion string.")
6167    
6168  (defun idlwave-complete-in-buffer (type stype list selector prompt isa  (defun idlwave-complete-in-buffer (type stype list selector prompt isa
6169                                          &optional prepare-display-function)                                          &optional prepare-display-function
6170                                            special-selector)
6171    "Perform TYPE completion of word before point against LIST.    "Perform TYPE completion of word before point against LIST.
6172  SELECTOR is the PREDICATE argument for the completion function.  Show  SELECTOR is the PREDICATE argument for the completion function.  Show
6173  PROMPT in echo area.  TYPE is one of 'function, 'procedure,  PROMPT in echo area.  TYPE is one of the intern types, e.g. 'function,
6174  'class-tag, or 'keyword."  'procedure, 'class-tag, 'keyword, 'sysvar, etc..  SPECIAL-SELECTOR is
6175    used only once, for `all-completions', and can be used to, e.g.,
6176    accumulate information on matching completions."
6177    (let* ((completion-ignore-case t)    (let* ((completion-ignore-case t)
6178           beg (end (point)) slash part spart completion all-completions           beg (end (point)) slash part spart completion all-completions
6179           dpart dcompletion)           dpart dcompletion)
# Line 5903  PROMPT in echo area.  TYPE is one of 'fu Line 6198  PROMPT in echo area.  TYPE is one of 'fu
6198            dpart (downcase part)            dpart (downcase part)
6199            spart (idlwave-sintern stype part)            spart (idlwave-sintern stype part)
6200            completion (try-completion part list selector)            completion (try-completion part list selector)
6201            dcompletion (if (stringp completion) (downcase completion)))            dcompletion (if (stringp completion) (downcase completion))
6202              idlwave-completion-help-links nil)
6203      (cond      (cond
6204       ((null completion)       ((null completion)
6205        ;; nothing available.        ;; nothing available.
# Line 5923  PROMPT in echo area.  TYPE is one of 'fu Line 6219  PROMPT in echo area.  TYPE is one of 'fu
6219            (idlwave-after-successful-completion type slash beg))            (idlwave-after-successful-completion type slash beg))
6220        t)        t)
6221       ((or (eq completion t)       ((or (eq completion t)
6222            (and (equal dpart dcompletion)            (and (= 1 (length (setq all-completions
                (= 1 (length (setq all-completions  
6223                                    (idlwave-uniquify                                    (idlwave-uniquify
6224                                     (all-completions part list selector)))))))                                     (all-completions part list
6225                                                        (or special-selector
6226                                                            selector))))))
6227                   (equal dpart dcompletion)))
6228        ;; This is already complete        ;; This is already complete
6229        (idlwave-after-successful-completion type slash beg)        (idlwave-after-successful-completion type slash beg)
6230        (message "%s is already the complete %s" part isa)        (message "%s is already the complete %s" part isa)
6231        nil)        nil)
6232       (t       (t        
6233        ;; We cannot add something - offer a list.        ;; We cannot add something - offer a list.
6234        (message "Making completion list...")        (message "Making completion list...")
6235          
6236          (unless idlwave-completion-help-links ; already set somewhere?
6237            (mapcar (lambda (x)  ; Pass link prop through to highlight-linked
6238                      (let ((link (get-text-property 0 'link (car x))))
6239                        (if link
6240                            (push (cons (car x) link)
6241                                  idlwave-completion-help-links))))
6242                    list))
6243        (let* ((list all-completions)        (let* ((list all-completions)
6244               ;; "complete" means, this is already a valid completion               ;; "complete" means, this is already a valid completion
6245               (complete (memq spart all-completions))               (complete (memq spart all-completions))
6246               (completion-highlight-first-word-only t) ; XEmacs               (completion-highlight-first-word-only t)) ; XEmacs
6247               (completion-fixup-function               ; Emacs  ;            (completion-fixup-function               ; Emacs
6248                (lambda () (and (eq (preceding-char) ?>)  ;             (lambda () (and (eq (preceding-char) ?>)
6249                                (re-search-backward " <" beg t)))))  ;                             (re-search-backward " <" beg t)))))
6250                
6251          (setq list (sort list (lambda (a b)          (setq list (sort list (lambda (a b)
6252                                  (string< (downcase a) (downcase b)))))                                  (string< (downcase a) (downcase b)))))
6253          (if prepare-display-function          (if prepare-display-function
# Line 5950  PROMPT in echo area.  TYPE is one of 'fu Line 6257  PROMPT in echo area.  TYPE is one of 'fu
6257                       idlwave-complete-empty-string-as-lower-case)                       idlwave-complete-empty-string-as-lower-case)
6258                   (not idlwave-completion-force-default-case))                   (not idlwave-completion-force-default-case))
6259              (setq list (mapcar (lambda (x)              (setq list (mapcar (lambda (x)
6260                                   (if (listp x)                                   (if (listp x)
6261                                       (setcar x (downcase (car x)))                                       (setcar x (downcase (car x)))
6262                                     (setq x (downcase x)))                                     (setq x (downcase x)))
6263                                   x)                                   x)
# Line 5970  PROMPT in echo area.  TYPE is one of 'fu Line 6277  PROMPT in echo area.  TYPE is one of 'fu
6277             (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\="             (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\="
6278                                 (- (point) 15) t)                                 (- (point) 15) t)
6279             (goto-char (point-min))             (goto-char (point-min))
6280             (re-search-forward             (re-search-forward
6281              "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t))))              "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t))))
6282        ;; Yank the full class specification        ;; Yank the full class specification
6283        (insert (match-string 2))        (insert (match-string 2))
6284      ;; Do the completion      ;; Do the completion, using list gathered from `idlwave-routines'
6285      (idlwave-complete-in-buffer 'class 'class (idlwave-class-alist) nil      (idlwave-complete-in-buffer
6286                                  "Select a class" "class")))       'class 'class (idlwave-class-alist) nil
6287         "Select a class" "class"
6288         '(lambda (list)  ;; Push it to help-links if system help available
6289            (mapcar (lambda (x)
6290                      (let* ((entry (idlwave-class-info x))
6291                             (link (nth 1 (assq 'link entry))))
6292                        (if link (push (cons x link)
6293                                       idlwave-completion-help-links))
6294                        x))
6295                    list)))))
6296    
6297  (defun idlwave-attach-classes (list type show-classes)  (defun idlwave-attach-classes (list type show-classes)
6298    ;; Attach the proper class list to a LIST of completion items.    ;; Attach the proper class list to a LIST of completion items.
# Line 5985  PROMPT in echo area.  TYPE is one of 'fu Line 6301  PROMPT in echo area.  TYPE is one of 'fu
6301    ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'.    ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'.
6302    (if (or (null show-classes)           ; don't want to see classes    (if (or (null show-classes)           ; don't want to see classes
6303            (null class-selector)         ; not a method call            (null class-selector)         ; not a method call
6304            (and            (and
6305             (stringp class-selector) ; the class is already known             (stringp class-selector) ; the class is already known
6306             (not super-classes)))    ; no possibilities for inheritance             (not super-classes)))    ; no possibilities for inheritance
6307        ;; In these cases, we do not have to do anything        ;; In these cases, we do not have to do anything
# Line 6000  PROMPT in echo area.  TYPE is one of 'fu Line 6316  PROMPT in echo area.  TYPE is one of 'fu
6316             (max (abs show-classes))             (max (abs show-classes))
6317             (lmax (if do-dots (apply 'max (mapcar 'length list))))             (lmax (if do-dots (apply 'max (mapcar 'length list))))
6318            classes nclasses class-info space)            classes nclasses class-info space)
6319        (mapcar        (mapcar
6320         (lambda (x)         (lambda (x)
6321           ;; get the classes           ;; get the classes
6322           (if (eq type 'class-tag)           (if (eq type 'class-tag)
6323               ;; Just one class for tags               ;; Just one class for tags
6324               (setq classes               (setq classes
6325                     (list                     (list
6326                      (idlwave-class-or-superclass-with-tag class-selector x)))                      (idlwave-class-or-superclass-with-tag class-selector x)))
6327             ;; Multiple classes for method of method-keyword             ;; Multiple classes for method or method-keyword
6328             (setq classes             (setq classes
6329                   (if (eq type 'kwd)                   (if (eq type 'kwd)
6330                       (idlwave-all-method-keyword-classes                       (idlwave-all-method-keyword-classes
6331                        method-selector x type-selector)                        method-selector x type-selector)
6332                     (idlwave-all-method-classes x type-selector)))                     (idlwave-all-method-classes x type-selector)))
6333             (if inherit             (if inherit
6334                 (setq classes                 (setq classes
6335                       (delq nil                       (delq nil
6336                             (mapcar (lambda (x) (if (memq x inherit) x nil))                             (mapcar (lambda (x) (if (memq x inherit) x nil))
6337                                     classes)))))                                     classes)))))
# Line 6036  PROMPT in echo area.  TYPE is one of 'fu Line 6352  PROMPT in echo area.  TYPE is one of 'fu
6352             ;; We do want properties             ;; We do want properties
6353             (setq x (copy-sequence x))             (setq x (copy-sequence x))
6354             (put-text-property 0 (length x)             (put-text-property 0 (length x)
6355                                'help-echo (mapconcat 'identity classes " ")                                'help-echo (mapconcat 'identity classes " ")
6356                                x))                                x))
6357           (if class-info           (if class-info
6358               (list x class-info)               (list x class-info)
6359             x))             x))
# Line 6052  PROMPT in echo area.  TYPE is one of 'fu Line 6368  PROMPT in echo area.  TYPE is one of 'fu
6368  (defun idlwave-attach-class-tag-classes (list)  (defun idlwave-attach-class-tag-classes (list)
6369    ;; Call idlwave-attach-classes with class structure tags    ;; Call idlwave-attach-classes with class structure tags
6370    (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes))    (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes))
6371                                            
6372    
6373  ;;----------------------------------------------------------------------  ;;----------------------------------------------------------------------
6374  ;;----------------------------------------------------------------------  ;;----------------------------------------------------------------------
# Line 6073  sort the list before displaying" Line 6389  sort the list before displaying"
6389            ((= 1 (length list))            ((= 1 (length list))
6390             (setq rtn (car list)))             (setq rtn (car list)))
6391            ((featurep 'xemacs)            ((featurep 'xemacs)
6392             (if sort (setq list (sort list (lambda (a b)             (if sort (setq list (sort list (lambda (a b)
6393                                              (string< (upcase a) (upcase b))))))                                              (string< (upcase a) (upcase b))))))
6394             (setq menu             (setq menu
6395                   (append (list title)                   (append (list title)
# Line 6084  sort the list before displaying" Line 6400  sort the list before displaying"
6400             (setq resp (get-popup-menu-response menu))             (setq resp (get-popup-menu-response menu))
6401             (funcall (event-function resp) (event-object resp)))             (funcall (event-function resp) (event-object resp)))
6402            (t            (t
6403             (if sort (setq list (sort list (lambda (a b)             (if sort (setq list (sort list (lambda (a b)
6404                                              (string< (upcase a) (upcase b))))))                                              (string< (upcase a) (upcase b))))))
6405             (setq menu (cons title             (setq menu (cons title
6406                              (list                              (list
# Line 6175  sort the list before displaying" Line 6491  sort the list before displaying"
6491      (setq idlwave-before-completion-wconf (current-window-configuration)))      (setq idlwave-before-completion-wconf (current-window-configuration)))
6492    
6493    (if (featurep 'xemacs)    (if (featurep 'xemacs)
6494        (idlwave-display-completion-list-xemacs        (idlwave-display-completion-list-xemacs
6495         list)         list)
6496      (idlwave-display-completion-list-emacs list))      (idlwave-display-completion-list-emacs list))
6497    
# Line 6204  sort the list before displaying" Line 6520  sort the list before displaying"
6520    (if (and (eq major-mode 'idlwave-shell-mode)    (if (and (eq major-mode 'idlwave-shell-mode)
6521             (boundp 'font-lock-mode)             (boundp 'font-lock-mode)
6522             (not font-lock-mode))             (not font-lock-mode))
6523        ;; Remove the fontification of the word before point        ;; For the shell, remove the fontification of the word before point
6524        (let ((beg (save-excursion        (let ((beg (save-excursion
6525                     (skip-chars-backward "a-zA-Z0-9_")                     (skip-chars-backward "a-zA-Z0-9_")
6526                     (point))))                     (point))))
# Line 6224  sort the list before displaying" Line 6540  sort the list before displaying"
6540         idlwave-before-completion-wconf         idlwave-before-completion-wconf
6541         (set-window-configuration idlwave-before-completion-wconf)))         (set-window-configuration idlwave-before-completion-wconf)))
6542    
6543    (defun idlwave-one-key-select (sym prompt delay)
6544      "Make the user select an element from the alist in the variable SYM.
6545    The keys of the alist are expected to be strings.  The function returns the
6546    car of the selected association.
6547    To do this, PROMPT is displayed and and the user must hit a letter key to
6548    select an entry.  If the user does not reply within DELAY seconds, a help
6549    window with the options is displayed automatically.
6550    The key which is associated with each option is generated automatically.
6551    First, the strings are checked for preselected keys, like in \"[P]rint\".
6552    If these don't exist, a letter in the string is automatically selected."
6553      (let* ((alist (symbol-value sym))
6554             (temp-buffer-show-hook (if (fboundp 'fit-window-to-buffer)
6555                                        '(fit-window-to-buffer)))
6556             keys-alist char)
6557        ;; First check the cache
6558        (if (and (eq (symbol-value sym) (get sym :one-key-alist-last)))
6559            (setq keys-alist (get sym :one-key-alist-cache))
6560          ;; Need to make new list
6561          (setq keys-alist (idlwave-make-one-key-alist alist))
6562          (put sym :one-key-alist-cache keys-alist)
6563          (put sym :one-key-alist-last alist))
6564        ;; Display prompt and wait for quick reply
6565        (message "%s[%s]" prompt
6566                 (mapconcat (lambda(x) (char-to-string (car x)))
6567                            keys-alist ""))
6568        (if (sit-for delay)
6569            ;; No quick reply: Show help
6570            (save-window-excursion
6571              (with-output-to-temp-buffer "*Completions*"
6572                (mapcar (lambda(x)
6573                          (princ (nth 1 x))
6574                          (princ "\n"))
6575                        keys-alist))            
6576              (setq char (read-char)))
6577          (setq char (read-char)))
6578        (message nil)
6579        ;; Return the selected result
6580        (nth 2 (assoc char keys-alist))))
6581    
6582    ;; Used for, e.g., electric debug super-examine.
6583    (defun idlwave-make-one-key-alist (alist)
6584      "Make an alist for single key selection."
6585      (let ((l alist) keys-alist name start char help
6586            (cnt 0)
6587            (case-fold-search nil))
6588        (while l
6589          (setq name (car (car l))
6590                l (cdr l))
6591          (catch 'exit
6592            ;; First check if the configuration predetermined a key
6593            (if (string-match "\\[\\(.\\)\\]" name)
6594                (progn
6595                  (setq char (string-to-char (downcase (match-string 1 name)))
6596                        help (format "%c:  %s" char name)
6597                        keys-alist (cons (list char help name) keys-alist))
6598                  (throw 'exit t)))
6599            ;; Then check for capital letters
6600            (setq start 0)
6601            (while (string-match "[A-Z]" name start)
6602              (setq start (match-end 0)
6603                    char (string-to-char (downcase (match-string 0 name))))
6604              (if (not (assoc char keys-alist))
6605                  (progn
6606                    (setq help (format "%c:  %s" char
6607                                       (replace-match
6608                                        (concat "[" (match-string 0 name) "]")
6609                                              t t name))
6610                          keys-alist (cons (list char help name) keys-alist))
6611                    (throw 'exit t))))
6612            ;; Now check for lowercase letters
6613            (setq start 0)
6614            (while (string-match "[a-z]" name start)
6615              (setq start (match-end 0)
6616                    char (string-to-char (match-string 0 name)))
6617              (if (not (assoc char keys-alist))
6618                  (progn
6619                    (setq help (format "%c:  %s" char
6620                                       (replace-match
6621                                        (concat "[" (match-string 0 name) "]")
6622                                        t t name))
6623                          keys-alist (cons (list char help name) keys-alist))
6624                    (throw 'exit t))))
6625            ;; Bummer, nothing found!  Use a stupid number
6626            (setq char (string-to-char (int-to-string (setq cnt (1+ cnt))))
6627                  help (format "%c:  %s" char name)
6628                  keys-alist (cons (list char help name) keys-alist))))
6629        (nreverse keys-alist)))
6630    
6631  (defun idlwave-set-local (var value &optional buffer)  (defun idlwave-set-local (var value &optional buffer)
6632    "Set the buffer-local value of VAR in BUFFER to VALUE."    "Set the buffer-local value of VAR in BUFFER to VALUE."
6633    (save-excursion    (save-excursion
# Line 6288  sort the list before displaying" Line 6692  sort the list before displaying"
6692  (defun idlwave-make-modified-completion-map-emacs (old-map)  (defun idlwave-make-modified-completion-map-emacs (old-map)
6693    "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."    "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."
6694    (let ((new-map (copy-keymap old-map)))    (let ((new-map (copy-keymap old-map)))
6695      (substitute-key-definition      (substitute-key-definition
6696       'choose-completion 'idlwave-choose-completion new-map)       'choose-completion 'idlwave-choose-completion new-map)
6697      (substitute-key-definition      (substitute-key-definition
6698       'mouse-choose-completion 'idlwave-mouse-choose-completion new-map)       'mouse-choose-completion 'idlwave-mouse-choose-completion new-map)
# Line 6309  sort the list before displaying" Line 6713  sort the list before displaying"
6713  ;;----------------------------------------------------------------------  ;;----------------------------------------------------------------------
6714    
6715  ;;; ------------------------------------------------------------------------  ;;; ------------------------------------------------------------------------
6716  ;;; Sturucture parsing code, and code to manage class info  ;;; Stucture parsing code, and code to manage class info
6717    
6718  ;;  ;;
6719  ;; - Go again over the documentation how to write a completion  ;; - Go again over the documentation how to write a completion
6720  ;;   plugin.  It is in self.el, but currently still very bad.  ;;   plugin.  It is in self.el, but currently still very bad.
6721  ;;   This could be in a separate file in the distribution, or  ;;   This could be in a separate file in the distribution, or
6722  ;;   in an appendix for the manual.  ;;   in an appendix for the manual.  
6723    
6724    (defvar idlwave-struct-skip
6725      "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*"
6726      "Regexp for skipping continued blank or comment-only lines in
6727    structures")
6728    
6729    (defvar idlwave-struct-tag-regexp
6730      (concat "[{,]" ;leading comma/brace
6731              idlwave-struct-skip ; 4 groups
6732              "\\([a-zA-Z][a-zA-Z0-9_]*\\)" ;the tag itself, group 5
6733              "[ \t]*:") ; the final colon
6734      "Regexp for structure tags.")
6735    
6736  (defun idlwave-struct-tags ()  (defun idlwave-struct-tags ()
6737    "Return a list of all tags in the structure defined at point.    "Return a list of all tags in the structure defined at point.
# Line 6326  Point is expected just before the openin Line 6742  Point is expected just before the openin
6742             (end (cdr borders))             (end (cdr borders))
6743             tags)             tags)
6744        (goto-char beg)        (goto-char beg)
6745        (while (re-search-forward "[{,][ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*[ \t]*\\)?\\([a-zA-Z][a-zA-Z0-9_]*\\)[ \t]*:" end t)        (save-restriction
6746          ;; Check if we are still on the top level of the structure.          (narrow-to-region beg end)
6747          (if (and (condition-case nil (progn (up-list -1) t) (error nil))          (while (re-search-forward idlwave-struct-tag-regexp end t)
6748                   (= (point) beg))            ;; Check if we are still on the top level of the structure.
6749              (push (match-string 5) tags))            (if (and (condition-case nil (progn (up-list -1) t) (error nil))
6750          (goto-char (match-end 0)))                     (= (point) beg))
6751        (nreverse tags))))                (push (match-string-no-properties 5) tags))
6752              (goto-char (match-end 0))))
6753            (nreverse tags))))
6754    
6755  (defun idlwave-find-struct-tag (tag)  (defun idlwave-find-struct-tag (tag)
6756    "Find a given TAG in the structure defined at point."    "Find a given TAG in the structure defined at point."
# Line 6340  Point is expected just before the openin Line 6758  Point is expected just before the openin
6758           (beg (car borders))           (beg (car borders))
6759           (end (cdr borders))           (end (cdr borders))
6760           (case-fold-search t))           (case-fold-search t))
6761      (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:")      (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:")
6762                         end t)))                         end t)))
6763    
6764  (defun idlwave-struct-inherits ()  (defun idlwave-struct-inherits ()
# Line 6353  Point is expected just before the openin Line 6771  Point is expected just before the openin
6771             (case-fold-search t)             (case-fold-search t)
6772             names)             names)
6773        (goto-char beg)        (goto-char beg)
6774        (while (re-search-forward "[{,][ \t]*\\(\\$.*\n[ \t]*\\)?inherits[ \t]*\\(\\$.*\n[ \t]*\\)?\\([a-zA-Z][a-zA-Z0-9_]*\\)" end t)        (save-restriction
6775          ;; Check if we are still on the top level of the structure.          (narrow-to-region beg end)
6776          (if (and (condition-case nil (progn (up-list -1) t) (error nil))          (while (re-search-forward
6777                   (= (point) beg))                  (concat "[{,]"  ;leading comma/brace
6778              (push (match-string 3) names))                          idlwave-struct-skip ; 4 groups
6779          (goto-char (match-end 0)))                          "inherits"    ; The INHERITS tag
6780                            idlwave-struct-skip ; 4 more
6781                            "\\([a-zA-Z][a-zA-Z0-9_]*\\)") ; The super-group, #9
6782                    end t)
6783              ;; Check if we are still on the top level of the structure.
6784              (if (and (condition-case nil (progn (up-list -1) t) (error nil))
6785                       (= (point) beg))
6786                  (push (match-string-no-properties 9) names))
6787              (goto-char (match-end 0))))
6788        (nreverse names))))        (nreverse names))))
6789    
6790  (defun idlwave-in-structure ()  (defun idlwave-in-structure ()
6791    "Return t if point is inside an IDL structure."    "Return t if point is inside an IDL structure definition."
6792    (let ((beg (point)))    (let ((beg (point)))
6793      (save-excursion      (save-excursion
6794        (if (not (or (idlwave-in-comment) (idlwave-in-quote)))        (if (not (or (idlwave-in-comment) (idlwave-in-quote)))
# Line 6382  Point is expected just before the openin Line 6808  Point is expected just before the openin
6808        (cons beg (point)))))        (cons beg (point)))))
6809    
6810  (defun idlwave-find-structure-definition (&optional var name bound)  (defun idlwave-find-structure-definition (&optional var name bound)
6811    "Search forward for a structure definition.    "Search forward for a structure definition.  If VAR is non-nil,
6812  If VAR is non-nil, search for a structure assigned to variable VAR.  search for a structure assigned to variable VAR.  If NAME is non-nil,
6813  If NAME is non-nil, search for a named structure NAME.  If BOUND is an  search for a named structure NAME, if a string, or a generic named
6814  integer, limit the search.  If BOUND is the symbol `all', we search  structure otherwise.  If BOUND is an integer, limit the search.  If
6815  first back and then forward through the entire file.  If BOUND is the  BOUND is the symbol `all', we search first back and then forward
6816  symbol `back' we search only backward."  through the entire file.  If BOUND is the symbol `back' we search only
6817    backward."
6818    (let* ((ws "[ \t]*\\(\\$.*\n[ \t]*\\)*")    (let* ((ws "[ \t]*\\(\\$.*\n[ \t]*\\)*")
6819           (case-fold-search t)           (case-fold-search t)
6820           (lim (if (integerp bound) bound nil))           (lim (if (integerp bound) bound nil))
# Line 6396  symbol `back' we search only backward." Line 6823  symbol `back' we search only backward."
6823                    (concat "\\<" (regexp-quote (downcase var)) "\\>" ws)                    (concat "\\<" (regexp-quote (downcase var)) "\\>" ws)
6824                  "\\(\\)")                  "\\(\\)")
6825                "=" ws "\\({\\)"                "=" ws "\\({\\)"
6826                (if name (concat ws "\\<" (downcase name) "[^a-zA-Z0-9_$]") ""))))                (if name
6827                      (if (stringp name)
6828                          (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]")
6829                        ;; Just a generic name
6830                        (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ","))
6831                    ""))))
6832      (if (or (and (or (eq bound 'all) (eq bound 'back))      (if (or (and (or (eq bound 'all) (eq bound 'back))
6833                   (re-search-backward re nil t))                   (re-search-backward re nil t))
6834              (and (not (eq bound 'back)) (re-search-forward re lim t)))              (and (not (eq bound 'back)) (re-search-forward re lim t)))
6835          (goto-char (match-beginning 3)))))          (progn
6836              (goto-char (match-beginning 3))
6837              (match-string-no-properties 5)))))
6838    
6839    (defvar idlwave-class-info nil)
6840    (defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo
6841    (defvar idlwave-class-reset nil) ; to reset buffer-local classes
6842    
 (defvar idlwave-class-info nil)  
 (defvar idlwave-system-class-info nil)  
6843  (add-hook 'idlwave-update-rinfo-hook  (add-hook 'idlwave-update-rinfo-hook
6844            (lambda () (setq idlwave-class-info nil)))            (lambda () (setq idlwave-class-reset t)))
6845  (add-hook 'idlwave-after-load-rinfo-hook  (add-hook 'idlwave-after-load-rinfo-hook
6846            (lambda () (setq idlwave-class-info nil)))            (lambda () (setq idlwave-class-info nil)))
6847    
6848  (defun idlwave-class-info (class)  (defun idlwave-class-info (class)
6849    (let (list entry)    (let (list entry)
6850      (unless idlwave-class-info      (if idlwave-class-info
6851        ;; Info is nil, put in the system stuff.          (if idlwave-class-reset
6852                (setq          
6853                 idlwave-class-reset nil
6854                 idlwave-class-info ; Remove any visited in a buffer
6855                 (delq nil (mapcar
6856                            (lambda (x)
6857                              (let ((filebuf
6858                                     (idlwave-class-file-or-buffer
6859                                      (or (cdr (assq 'found-in x)) (car x)))))
6860                                (if (cdr filebuf)
6861                                    nil
6862                                  x)))
6863                            idlwave-class-info))))
6864          ;; Info is nil, put in the system stuff to start.
6865        (setq idlwave-class-info idlwave-system-class-info)        (setq idlwave-class-info idlwave-system-class-info)
6866        (setq list idlwave-class-info)        (setq list idlwave-class-info)
6867        (while (setq entry (pop list))        (while (setq entry (pop list))
6868          (idlwave-sintern-class-info entry)))          (idlwave-sintern-class-info entry)))
6869      (setq class (idlwave-sintern-class class))      (setq class (idlwave-sintern-class class))
6870      (setq entry (assq class idlwave-class-info))      (or (assq class idlwave-class-info)
6871      (unless entry          (progn (idlwave-scan-class-info class)
6872        (setq entry (idlwave-find-class-info class))                 (assq class idlwave-class-info)))))
       (when entry  
         ;; Sintern and cache the info  
         (idlwave-sintern-class-info entry)  
         (push entry idlwave-class-info)))  
     entry))  
6873    
6874  (defun idlwave-sintern-class-info (entry)  (defun idlwave-sintern-class-info (entry)
6875    "Sintern the class names in a class-info entry."    "Sintern the class names in a class-info entry."
# Line 6436  symbol `back' we search only backward." Line 6880  symbol `back' we search only backward."
6880          (setcdr inherits (mapcar (lambda (x) (idlwave-sintern-class x 'set))          (setcdr inherits (mapcar (lambda (x) (idlwave-sintern-class x 'set))
6881                                   (cdr inherits))))))                                   (cdr inherits))))))
6882    
6883  (defun idlwave-find-class-definition (class)  (defun idlwave-find-class-definition (class &optional all-hook alt-class)
6884    (let ((case-fold-search t))    "Find class structure definition(s)
6885      (if (re-search-forward  If ALL-HOOK is set, find all named structure definitions in a given
6886           (concat "^[ \t]*pro[ \t]+" (downcase class) "__define" "\\>") nil t)  class__define routine, on which ALL-HOOK will be run.  If ALT-CLASS is
6887          ;; FIXME: should we limit to end of pro here?  set, look for the name__define pro, and inside of it, for the ALT-CLASS
6888          (idlwave-find-structure-definition nil class))))  class/struct definition"
6889      (let ((case-fold-search t) end-lim list name)
6890        (when (re-search-forward
6891               (concat "^[ \t]*pro[ \t]+" (downcase class) "__define" "\\>") nil t)
6892          (if all-hook
6893              (progn
6894                ;; For everything there
6895                (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point)))
6896                (while (setq name
6897                             (idlwave-find-structure-definition nil t end-lim))
6898                  (funcall all-hook name)))
6899            (idlwave-find-structure-definition nil (or alt-class class))))))
6900    
6901    
6902  (defun idlwave-find-class-info (class)  (defun idlwave-class-file-or-buffer (class)
6903    "Find the __define procedure for a class structure and return info entry."    "Find buffer visiting CLASS definition"
6904    (let* ((pro (concat (downcase class) "__define"))    (let* ((pro (concat (downcase class) "__define"))
6905           (class (idlwave-sintern-class class))           (file (idlwave-routine-source-file
6906           (idlwave-auto-routine-info-updates nil)                  (nth 3 (idlwave-rinfo-assoc pro 'pro nil
6907           (file (cdr (nth 3 (idlwave-rinfo-assoc pro 'pro nil                                              (idlwave-routines))))))
6908                                                  (idlwave-routines)))))      (cons file (if file (idlwave-get-buffer-visiting file)))))
6909           buf)  
6910      (if (or (not file)  
6911              (not (file-regular-p  (defun idlwave-scan-class-info (class)
6912                    (setq file (idlwave-expand-lib-file-name file)))))    "Scan all class and named structure info in the class__define pro"
6913          nil ; Cannot get info    (let* ((idlwave-auto-routine-info-updates nil)
6914             (filebuf (idlwave-class-file-or-buffer class))
6915             (file (car filebuf))
6916             (buf (cdr filebuf))
6917             (class (idlwave-sintern-class class)))
6918        (if (or
6919             (not file)
6920             (and ;; neither a regular file nor a visited buffer
6921              (not buf)
6922              (not (file-regular-p file))))
6923            nil ; Cannot find the file/buffer to get any info
6924        (save-excursion        (save-excursion
6925          (if (setq buf (idlwave-get-buffer-visiting file))          (if buf (set-buffer buf)
6926              (set-buffer buf)            ;; Read the file in temporarily
6927            (set-buffer (get-buffer-create " *IDLWAVE-tmp*"))            (set-buffer (get-buffer-create " *IDLWAVE-tmp*"))
6928            (erase-buffer)            (erase-buffer)
6929            (unless (eq major-mode 'idlwave-mode)            (unless (eq major-mode 'idlwave-mode)
# Line 6465  symbol `back' we search only backward." Line 6931  symbol `back' we search only backward."
6931            (insert-file-contents file))            (insert-file-contents file))
6932          (save-excursion          (save-excursion
6933            (goto-char 1)            (goto-char 1)
6934            (if (idlwave-find-class-definition class)            (idlwave-find-class-definition class
6935                (list class             ;; Scan all of the structures found there
6936                      (cons 'tags (idlwave-struct-tags))             (lambda (name)
6937                      (cons 'inherits (idlwave-struct-inherits)))))))))               (let* ((this-class (idlwave-sintern-class name))
6938                        (entry
6939                         (list this-class
6940                               (cons 'tags (idlwave-struct-tags))
6941                               (cons 'inherits (idlwave-struct-inherits)))))
6942                   (if (not (eq this-class class))
6943                       (setq entry (nconc entry (list (cons 'found-in class)))))
6944                   (idlwave-sintern-class-info entry)
6945                   (push entry idlwave-class-info)))))))))
6946    
6947    (defun idlwave-class-found-in (class)
6948      "Return the FOUND-IN property of the class."
6949      (cdr (assq 'found-in (idlwave-class-info class))))
6950  (defun idlwave-class-tags (class)  (defun idlwave-class-tags (class)
6951    "Return the native tags in CLASS."    "Return the native tags in CLASS."
6952    (cdr (assq 'tags (idlwave-class-info class))))    (cdr (assq 'tags (idlwave-class-info class))))
# Line 6477  symbol `back' we search only backward." Line 6954  symbol `back' we search only backward."
6954    "Return the direct superclasses of CLASS."    "Return the direct superclasses of CLASS."
6955    (cdr (assq 'inherits (idlwave-class-info class))))    (cdr (assq 'inherits (idlwave-class-info class))))
6956    
6957    
6958  (defun idlwave-all-class-tags (class)  (defun idlwave-all-class-tags (class)
6959    "Return a list of native and inherited tags in CLASS."    "Return a list of native and inherited tags in CLASS."
6960    (condition-case err    (condition-case err
6961        (apply 'append (mapcar 'idlwave-class-tags        (apply 'append (mapcar 'idlwave-class-tags
6962                               (cons class (idlwave-all-class-inherits class))))                               (cons class (idlwave-all-class-inherits class))))
6963      (error      (error          
6964       (idlwave-class-tag-reset)       (idlwave-class-tag-reset)
6965       (error "%s" (error-message-string err)))))       (error "%s" (error-message-string err)))))
6966    
# Line 6518  The list is cached in `idlwave-class-inf Line 6996  The list is cached in `idlwave-class-inf
6996            (nconc info (list (cons 'all-inherits all-inherits)))            (nconc info (list (cons 'all-inherits all-inherits)))
6997            all-inherits))))))            all-inherits))))))
6998    
6999    (defun idlwave-entry-keywords (entry &optional record-link)
7000      "Return the flat entry keywords alist from routine-info entry.  
7001    If RECORD-LINK is non-nil, the keyword text is copied and a text
7002    property indicating the link is added."
7003      (let (kwds)
7004        (mapcar
7005         (lambda (key-list)
7006           (let ((file (car key-list)))
7007             (mapcar (lambda (key-cons)
7008                       (let ((key (car key-cons))
7009                             (link (cdr key-cons)))
7010                         (when (and record-link file)
7011                             (setq key (copy-sequence key))
7012                             (put-text-property
7013                              0 (length key)
7014                              'link
7015                              (concat
7016                               file
7017                               (if link
7018                                   (concat idlwave-html-link-sep
7019                                           (number-to-string link))))
7020                              key))
7021                         (push (list key) kwds)))
7022                     (cdr key-list))))
7023         (nthcdr 5 entry))
7024        (nreverse kwds)))
7025    
7026    (defun idlwave-entry-find-keyword (entry keyword)
7027      "Find keyword KEYWORD in entry ENTRY, and return (with link) if set"
7028      (catch 'exit
7029        (mapc
7030         (lambda (key-list)
7031           (let ((file (car key-list))
7032                 (kwd (assoc keyword (cdr key-list))))
7033             (when kwd
7034               (setq kwd (cons (car kwd)
7035                               (if (and file (cdr kwd))
7036                                   (concat file
7037                                           idlwave-html-link-sep
7038                                           (number-to-string (cdr kwd)))
7039                                 (cdr kwd))))
7040               (throw 'exit kwd))))
7041         (nthcdr 5 entry))))
7042    
7043  ;;==========================================================================  ;;==========================================================================
7044  ;;  ;;
# Line 6539  The list is cached in `idlwave-class-inf Line 7060  The list is cached in `idlwave-class-inf
7060          (case-fold-search t))          (case-fold-search t))
7061      (if (save-excursion      (if (save-excursion
7062            ;; Check if the context is right            ;; Check if the context is right
7063            (skip-chars-backward "[a-zA-Z0-9._$]")            (skip-chars-backward "a-zA-Z0-9._$")
7064            (and (< (point) (- pos 4))            (and (< (point) (- pos 4))
7065                 (looking-at "self\\.")))                 (looking-at "self\\.")))
7066          (let* ((class-selector (nth 2 (idlwave-current-routine)))          (let* ((class-selector (nth 2 (idlwave-current-routine)))
# Line 6550  The list is cached in `idlwave-class-inf Line 7071  The list is cached in `idlwave-class-inf
7071            ;; Check if we need to update the "current" class            ;; Check if we need to update the "current" class
7072            (if (not (equal class-selector idlwave-current-tags-class))            (if (not (equal class-selector idlwave-current-tags-class))
7073                (idlwave-prepare-class-tag-completion class-selector))                (idlwave-prepare-class-tag-completion class-selector))
7074            (setq idlwave-completion-help-info            (setq idlwave-completion-help-info
7075                  (list 'idlwave-complete-class-structure-tag-help                  (list 'idlwave-complete-class-structure-tag-help
7076                        (idlwave-sintern-routine                        (idlwave-sintern-routine
7077                         (concat class-selector "__define"))                         (concat class-selector "__define"))
7078                        nil))                        nil))
7079            (let  ((idlwave-cpl-bold idlwave-current-native-class-tags))            (let  ((idlwave-cpl-bold idlwave-current-native-class-tags))
7080              (idlwave-complete-in-buffer              (idlwave-complete-in-buffer
7081               'class-tag 'class-tag               'class-tag 'class-tag
7082               idlwave-current-class-tags nil               idlwave-current-class-tags nil
7083               (format "Select a tag of class %s" class-selector)               (format "Select a tag of class %s" class-selector)
7084               "class tag"               "class tag"
# Line 6582  The list is cached in `idlwave-class-inf Line 7103  The list is cached in `idlwave-class-inf
7103  ;===========================================================================  ;===========================================================================
7104  ;;  ;;
7105  ;; Completing system variables and their structure fields  ;; Completing system variables and their structure fields
7106  ;; This is also a plugin.  It is a bit bigger since we support loading  ;; This is also a plugin.
 ;; current system variables from the shell and highlighting in the  
 ;; completions buffer.  
7107    
7108  (defvar idlwave-sint-sysvars nil)  (defvar idlwave-sint-sysvars nil)
7109  (defvar idlwave-sint-sysvartags nil)  (defvar idlwave-sint-sysvartags nil)
# Line 6592  The list is cached in `idlwave-class-inf Line 7111  The list is cached in `idlwave-class-inf
7111  (idlwave-new-sintern-type 'sysvartag)  (idlwave-new-sintern-type 'sysvartag)
7112  (add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag)  (add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag)
7113  (add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset)  (add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset)
 (add-hook 'idlwave-after-load-rinfo-hook 'idlwave-remember-builtin-sysvars)  
7114  (add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist)  (add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist)
7115    
7116    (defvar idlwave-executive-commands-alist nil
7117      "Alist of system variables and their help files.")
7118    
7119  (defvar idlwave-system-variables-alist nil  (defvar idlwave-system-variables-alist nil
7120    "Alist of system variables and the associated structure tags.    "Alist of system variables and the associated structure tags.
7121  Gets set in `idlw-rinfo.el'.")  Gets set in `idlw-rinfo.el'.")
 (defvar idlwave-builtin-system-variables nil)  
7122    
7123  (defun idlwave-complete-sysvar-or-tag ()  (defun idlwave-complete-sysvar-or-tag ()
7124    "Complete a system variable."    "Complete a system variable."
# Line 6610  Gets set in `idlw-rinfo.el'.") Line 7130  Gets set in `idlw-rinfo.el'.")
7130               (skip-chars-backward "[a-zA-Z0-9_$]")               (skip-chars-backward "[a-zA-Z0-9_$]")
7131               (equal (char-before) ?!))               (equal (char-before) ?!))
7132             (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help))             (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help))
7133             (idlwave-complete-in-buffer 'sysvar 'sysvar             (idlwave-complete-in-buffer 'sysvar 'sysvar
7134                                         idlwave-system-variables-alist nil                                         idlwave-system-variables-alist nil
7135                                         "Select a system variable"                                         "Select a system variable"
7136                                         "system variable")                                         "system variable")
7137             t)  ; return t to skip other completions             t)  ; return t to skip other completions
7138            ((save-excursion            ((save-excursion
7139               ;; Check if the context is right for sysvar tag               ;; Check if the context is right for sysvar tag
7140               (skip-chars-backward "[a-zA-Z0-9_$.]")               (skip-chars-backward "a-zA-Z0-9_$.")
7141               (and (equal (char-before) ?!)               (and (equal (char-before) ?!)
7142                    (looking-at "\\([a-zA-Z][a-zA-Z0-9_$]*\\)\\.")                    (looking-at "\\([a-zA-Z][a-zA-Z0-9_$]*\\)\\.")
7143                    (<= (match-end 0) pos)))                    (<= (match-end 0) pos)))
7144             ;; Complete a system variable tag             ;; Complete a system variable tag
7145             (let* ((var (idlwave-sintern-sysvar (match-string 1)))             (let* ((var (idlwave-sintern-sysvar (match-string 1)))
7146                    (entry (assq var idlwave-system-variables-alist))                    (entry (assq var idlwave-system-variables-alist))
7147                    (tags (cdr entry)))                    (tags (cdr (assq 'tags entry))))
7148               (or entry (error "!%s is not know to be a system variable" var))               (or entry (error "!%s is not a known system variable" var))
7149               (or tags (error "System variable !%s is not a structure" var))               (or tags (error "System variable !%s is not a structure" var))
7150               (setq idlwave-completion-help-info               (setq idlwave-completion-help-info
7151                     (list 'idlwave-complete-sysvar-help var))                     (list 'idlwave-complete-sysvar-tag-help var))
7152               (idlwave-complete-in-buffer 'sysvartag 'sysvartag               (idlwave-complete-in-buffer 'sysvartag 'sysvartag
7153                                           tags nil                                           tags nil
7154                                           "Select a system variable tag"                                           "Select a system variable tag"
7155                                           "system variable tag")                                           "system variable tag")
7156               t)) ; return t to skip other completions               t)) ; return t to skip other completions
7157            (t nil))))            (t nil))))
7158    
 ;; Here we fake help using the routine "system variables" with keyword  
 ;; set to the sysvar.  Name and kwd are global variables here.  
 (defvar name)  
 (defvar kwd)  
7159  (defun idlwave-complete-sysvar-help (mode word)  (defun idlwave-complete-sysvar-help (mode word)
7160    (cond    (let ((word (or (nth 1 idlwave-completion-help-info) word))
7161     ((eq mode 'test)          (entry (assoc word idlwave-system-variables-alist)))
7162      (or (and (eq nil (nth 1 idlwave-completion-help-info))      (cond
7163               (member (downcase word) idlwave-builtin-system-variables))       ((eq mode 'test)
7164          (and (stringp (nth 1 idlwave-completion-help-info))        (and (stringp word) entry (nth 1 (assq 'link entry))))
7165               (member (downcase (nth 1 idlwave-completion-help-info))       ((eq mode 'set)
7166                       idlwave-builtin-system-variables))))        (if entry (setq link (nth 1 (assq 'link entry))))) ;; setting dynamic!!!
7167     ((eq mode 'set)       (t (error "This should not happen")))))
7168      (setq name "system variables"  
7169            kwd (concat "!"  (defun idlwave-complete-sysvar-tag-help (mode word)
7170                        (if (stringp (nth 1 idlwave-completion-help-info))    (let* ((var (nth 1 idlwave-completion-help-info))
7171                            (nth 1 idlwave-completion-help-info)          (entry (assoc var idlwave-system-variables-alist))
7172                          word))))          (tags (cdr (assq 'tags entry)))
7173     (t (error "This should not happen"))))          (main (nth 1 (assq 'link entry)))
7174            target main-base)
7175        (cond
7176         ((eq mode 'test) ; we can at least link the main
7177          (and (stringp word) entry main))
7178         ((eq mode 'set)
7179          (if entry
7180              (setq link
7181                    (if (setq target (cdr (assoc word tags)))
7182                      (idlwave-substitute-link-target main target)
7183                    main)))) ;; setting dynamic!!!
7184         (t (error "This should not happen")))))
7185    
7186    (defun idlwave-substitute-link-target (link target)
7187      "Substitute the target anchor for the given link."
7188      (let (main-base)
7189        (setq main-base (if (string-match "#" link)
7190                            (substring link 0 (match-beginning 0))
7191                          link))
7192        (if target
7193            (concat main-base idlwave-html-link-sep (number-to-string target))
7194          link)))
7195    
7196  ;; Fake help in the source buffer for class structure tags.  ;; Fake help in the source buffer for class structure tags.
7197  ;; kwd and name are global-variables here.  ;; KWD AND NAME ARE GLOBAL-VARIABLES HERE.
7198    (defvar name)
7199    (defvar kwd)
7200  (defvar idlwave-help-do-class-struct-tag nil)  (defvar idlwave-help-do-class-struct-tag nil)
7201  (defun idlwave-complete-class-structure-tag-help (mode word)  (defun idlwave-complete-class-structure-tag-help (mode word)
7202    (cond    (cond
7203     ((eq mode 'test) ; nothing gets fontified for class tags     ((eq mode 'test) ; nothing gets fontified for class tags
7204      nil)      nil)
7205     ((eq mode 'set)     ((eq mode 'set)
7206      (let (class-with)      (let (class-with found-in)
7207        (when (setq class-with        (when (setq class-with
7208                  (idlwave-class-or-superclass-with-tag                  (idlwave-class-or-superclass-with-tag
7209                   idlwave-current-tags-class                   idlwave-current-tags-class
7210                   word))                   word))
7211          (if (assq (idlwave-sintern-class class-with)          (if (assq (idlwave-sintern-class class-with)
7212                    idlwave-system-class-info)                    idlwave-system-class-info)
7213              (error "No help available for system class tags."))              (error "No help available for system class tags."))
7214          (setq name (concat class-with "__define"))))          (if (setq found-in (idlwave-class-found-in class-with))
7215                (setq name (cons (concat found-in "__define") class-with))
7216              (setq name (concat class-with "__define")))))
7217      (setq kwd word      (setq kwd word
7218            idlwave-help-do-class-struct-tag t))            idlwave-help-do-class-struct-tag t))
7219     (t (error "This should not happen"))))     (t (error "This should not happen"))))
# Line 6680  Gets set in `idlw-rinfo.el'.") Line 7221  Gets set in `idlw-rinfo.el'.")
7221  (defun idlwave-class-or-superclass-with-tag (class tag)  (defun idlwave-class-or-superclass-with-tag (class tag)
7222    "Find and return the CLASS or one of its superclass with the    "Find and return the CLASS or one of its superclass with the
7223  associated TAG, if any."  associated TAG, if any."
7224    (let ((sclasses (cons class (cdr (assq 'all-inherits    (let ((sclasses (cons class (cdr (assq 'all-inherits
7225                                           (idlwave-class-info class)))))                                           (idlwave-class-info class)))))
7226          cl)          cl)
7227     (catch 'exit     (catch 'exit
# Line 6689  associated TAG, if any." Line 7230  associated TAG, if any."
7230         (let ((tags (idlwave-class-tags cl)))         (let ((tags (idlwave-class-tags cl)))
7231           (while tags           (while tags
7232             (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t))             (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t))
7233               (throw 'exit cl))               (throw 'exit cl))        
7234             (setq tags (cdr tags))))))))             (setq tags (cdr tags))))))))
7235    
7236    
7237  (defun idlwave-sysvars-reset ()  (defun idlwave-sysvars-reset ()
7238    (if (and (fboundp 'idlwave-shell-is-running)    (if (and (fboundp 'idlwave-shell-is-running)
7239             (idlwave-shell-is-running))             (idlwave-shell-is-running)
7240               idlwave-idlwave_routine_info-compiled)
7241        (idlwave-shell-send-command "idlwave_get_sysvars"        (idlwave-shell-send-command "idlwave_get_sysvars"
7242                                    'idlwave-process-sysvars 'hide)))                                    'idlwave-process-sysvars 'hide)))
7243    
# Line 6705  associated TAG, if any." Line 7247  associated TAG, if any."
7247          idlwave-sint-sysvartags nil)          idlwave-sint-sysvartags nil)
7248    (idlwave-sintern-sysvar-alist))    (idlwave-sintern-sysvar-alist))
7249    
 (defun idlwave-remember-builtin-sysvars ()  
   (setq idlwave-builtin-system-variables  
         (mapcar 'downcase  
                 (mapcar 'car idlwave-system-variables-alist))))  
   
7250  (defun idlwave-sintern-sysvar-alist ()  (defun idlwave-sintern-sysvar-alist ()
7251    (let ((list idlwave-system-variables-alist) entry)    (let ((list idlwave-system-variables-alist) entry tags)
7252      (while (setq entry (pop list))      (while (setq entry (pop list))
7253        (setcar entry (idlwave-sintern-sysvar (car entry) 'set))        (setcar entry (idlwave-sintern-sysvar (car entry) 'set))
7254        (setcdr entry (mapcar (lambda (x)        (setq tags (assq 'tags entry))
7255                                (list (idlwave-sintern-sysvartag (car x) 'set)))        (if tags
7256                              (cdr entry))))))            (setcdr tags
7257                      (mapcar (lambda (x)
7258                                (cons (idlwave-sintern-sysvartag (car x) 'set)
7259                                      (cdr x)))
7260                              (cdr tags)))))))
7261    
7262  (defvar idlwave-shell-command-output)  (defvar idlwave-shell-command-output)
7263  (defun idlwave-shell-filter-sysvars ()  (defun idlwave-shell-filter-sysvars ()
7264    "Get the system variables and structure tags."    "Get any new system variables and tags."
7265    (let ((text idlwave-shell-command-output)    (let ((text idlwave-shell-command-output)
7266          (start 0)          (start 0)
7267          (old idlwave-system-variables-alist)          (old idlwave-system-variables-alist)
7268          var tags type name class)          var tags type name class link old-entry)
7269      (setq idlwave-system-variables-alist nil)      (setq idlwave-system-variables-alist nil)
7270      (while (string-match "^IDLWAVE-SYSVAR: !\\([a-zA-Z0-9_$]+\\)\\( \\(.*\\)\\)?"      (while (string-match "^IDLWAVE-SYSVAR: !\\([a-zA-Z0-9_$]+\\)\\( \\(.*\\)\\)?"
7271                           text start)                           text start)
7272        (setq start (match-end 0)        (setq start (match-end 0)
7273              var (match-string 1 text)              var (match-string 1 text)
7274              tags (if (match-end 3) (idlwave-split-string (match-string 3 text))))              tags (if (match-end 3)
7275                         (idlwave-split-string (match-string 3 text))))
7276          ;; Maintain old links, if present
7277          (setq old-entry (assq (idlwave-sintern-sysvar var) old))
7278          (setq link (assq 'link old-entry))
7279        (setq idlwave-system-variables-alist        (setq idlwave-system-variables-alist
7280              (cons (cons var (mapcar 'list tags))              (cons (list var
7281                            (cons
7282                             'tags
7283                             (mapcar (lambda (x)
7284                                       (cons x
7285                                             (cdr (assq
7286                                                   (idlwave-sintern-sysvartag x)
7287                                                   (cdr (assq 'tags old-entry))))))
7288                                     tags)) link)
7289                    idlwave-system-variables-alist)))                    idlwave-system-variables-alist)))
7290      ;; Keep the old value if query was not successful      ;; Keep the old value if query was not successful
7291      (setq idlwave-system-variables-alist      (setq idlwave-system-variables-alist
# Line 6751  associated TAG, if any." Line 7304  associated TAG, if any."
7304                                 'face 'font-lock-string-face)))))))                                 'face 'font-lock-string-face)))))))
7305    
7306  (defun idlwave-uniquify (list)  (defun idlwave-uniquify (list)
7307    (let (nlist)    (let ((ht (make-hash-table :size (length list) :test 'equal)))
7308      (loop for x in list do      (delq nil
7309        (add-to-list 'nlist x))            (mapcar (lambda (x)
7310      nlist))                      (unless (gethash x ht)
7311                          (puthash x t ht)
7312                          x))
7313                      list))))
7314    
7315  (defun idlwave-after-successful-completion (type slash &optional verify)  (defun idlwave-after-successful-completion (type slash &optional verify)
7316    "Add `=' or `(' after successful completion of keyword and function.    "Add `=' or `(' after successful completion of keyword and function.
# Line 6779  Restore the pre-completion window config Line 7335  Restore the pre-completion window config
7335        nil)))        nil)))
7336    
7337    ;; Restore the pre-completion window configuration if this is safe.    ;; Restore the pre-completion window configuration if this is safe.
7338      
7339    (if (or (eq verify 'force)                                    ; force    (if (or (eq verify 'force)                                    ; force
7340            (and            (and
7341             (get-buffer-window "*Completions*")                  ; visible             (get-buffer-window "*Completions*")                  ; visible
7342             (idlwave-local-value 'idlwave-completion-p             (idlwave-local-value 'idlwave-completion-p
7343                                  "*Completions*")                ; cib-buffer                                  "*Completions*")                ; cib-buffer
7344             (eq (marker-buffer idlwave-completion-mark)             (eq (marker-buffer idlwave-completion-mark)
7345                 (current-buffer))                                ; buffer OK                 (current-buffer))                                ; buffer OK
# Line 6810  visits the source file, finding help in Line 7366  visits the source file, finding help in
7366  `idlwave-help-source-try-header' is non-nil) or the routine definition  `idlwave-help-source-try-header' is non-nil) or the routine definition
7367  itself."  itself."
7368    (interactive "P")    (interactive "P")
   (idlwave-require-online-help)  
7369    (idlwave-do-context-help arg))    (idlwave-do-context-help arg))
7370    
7371  (defun idlwave-mouse-completion-help (ev)  (defun idlwave-mouse-completion-help (ev)
7372    "Display online help about the completion at point."    "Display online help about the completion at point."
7373    (interactive "eP")    (interactive "eP")
7374    (idlwave-require-online-help)    ;; Restore last-command for next command, to make
7375    ;; Restore last-command for next command, to make scrolling of completions    ;; scrolling/cancelling of completions work.
   ;; work.  
7376    (setq this-command last-command)    (setq this-command last-command)
7377    (idlwave-do-mouse-completion-help ev))    (idlwave-do-mouse-completion-help ev))
7378    
 (defvar idlwave-help-is-loaded nil  
   "Is online help avaiable?")  
 ;; The following variables will be defined by `idlw-help.el'.  
 (defvar idlwave-help-frame-width nil)  
 (defvar idlwave-help-file nil)  
 (defvar idlwave-help-topics nil)  
   
 (defun idlwave-help-directory ()  
   "Return the help directory, or nil if that is not known."  
   (or (and (stringp idlwave-help-directory)  
            (> (length idlwave-help-directory) 0)  
            idlwave-help-directory)  
       (getenv "IDLWAVE_HELP_DIRECTORY")))  
   
 (defun idlwave-require-online-help ()  
   (if idlwave-help-is-loaded  
       t  ;; everything is OK.  
     (let* ((dir (or (idlwave-help-directory)  
                     (error "Online Help not installed (help directory unknown) - download at idlwave.org")))  
            (lfile1 (expand-file-name "idlw-help.elc" dir))  
            (lfile2 (expand-file-name "idlw-help.el" dir))  
            (hfile (expand-file-name "idlw-help.txt" dir)))  
       (if (or (and (file-regular-p lfile1) (load-file lfile1))  
               (and (file-regular-p lfile2) (load-file lfile2)))  
           (progn  
             (if (and idlwave-help-frame-parameters  
                      (not (assoc 'width idlwave-help-frame-parameters)))  
                 (push (cons 'width idlwave-help-frame-width)  
                       idlwave-help-frame-parameters))  
             (or idlwave-help-topics  
                 (error "File `%s' in help dir `%s' does not define `idlwave-help-topics'"  
                          "idlw-help.el" dir)))  
         (error "No such file `%s' in help dir `%s'" "idlw-help.el" dir))  
       (if (file-regular-p hfile)  
           (setq idlwave-help-is-loaded t  
                 idlwave-help-file hfile)  
         (error "No such file `%s' in dir `%s'" "idlw-help.txt" dir)))))  
   
7379  (defun idlwave-routine-info (&optional arg external)  (defun idlwave-routine-info (&optional arg external)
7380    "Display a routines calling sequence and list of keywords.    "Display a routines calling sequence and list of keywords.  When
7381  When point is on the name a function or procedure, or in the argument  point is on the name a function or procedure, or in the argument list
7382  list of a function or procedure, this command displays a help buffer  of a function or procedure, this command displays a help buffer with
7383  with the information.  When called with prefix arg, enforce class  the information.  When called with prefix arg, enforce class query.
 query.  
7384    
7385  When point is on an object operator `->', display the class stored in  When point is on an object operator `->', display the class stored in
7386  this arrow, if any (see `idlwave-store-inquired-class').  With a  this arrow, if any (see `idlwave-store-inquired-class').  With a
# Line 6903  prefix arg, the class property is cleare Line 7418  prefix arg, the class property is cleare
7418          (error "Don't know which calling sequence to show")))))          (error "Don't know which calling sequence to show")))))
7419    
7420  (defun idlwave-resolve (&optional arg)  (defun idlwave-resolve (&optional arg)
7421    "Call RESOLVE on the module name at point.    "Call RESOLVE_ROUTINE on the module name at point.
7422  Like `idlwave-routine-info', this looks for a routine call at point.  Like `idlwave-routine-info', this looks for a routine call at point.
7423  After confirmation in the minibuffer, it will use the shell to issue  After confirmation in the minibuffer, it will use the shell to issue
7424  a RESOLVE call for this routine, to attempt to make it defined and its  a RESOLVE call for this routine, to attempt to make it defined and its
# Line 6922  With ARG, enforce query for the class of Line 7437  With ARG, enforce query for the class of
7437      (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)"      (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)"
7438                        resolve)                        resolve)
7439          (setq type (match-string 1 resolve)          (setq type (match-string 1 resolve)
7440                class (if (match-beginning 2)                class (if (match-beginning 2)
7441                          (match-string 3 resolve)                          (match-string 3 resolve)
7442                        nil)                        nil)
7443                name (match-string 4 resolve)))                name (match-string 4 resolve)))
# Line 6931  With ARG, enforce query for the class of Line 7446  With ARG, enforce query for the class of
7446    
7447      (cond      (cond
7448       ((null class)       ((null class)
7449        (idlwave-shell-send-command        (idlwave-shell-send-command
7450         (format "resolve_routine,'%s'%s" (downcase name) kwd)         (format "resolve_routine,'%s'%s" (downcase name) kwd)
7451         'idlwave-update-routine-info         'idlwave-update-routine-info
7452         nil t))         nil t))
7453       (t       (t
7454        (idlwave-shell-send-command        (idlwave-shell-send-command
7455         (format "resolve_routine,'%s__define'%s" (downcase class) kwd)         (format "resolve_routine,'%s__define'%s" (downcase class) kwd)
7456         (list 'idlwave-shell-send-command         (list 'idlwave-shell-send-command
7457               (format "resolve_routine,'%s__%s'%s"               (format "resolve_routine,'%s__%s'%s"
7458                       (downcase class) (downcase name) kwd)                       (downcase class) (downcase name) kwd)
7459               '(idlwave-update-routine-info)               '(idlwave-update-routine-info)
7460               nil t))))))               nil t))))))
7461    
7462  (defun idlwave-find-module (&optional arg)  (defun idlwave-find-module (&optional arg)
7463    "Find the source code of an IDL module.    "Find the source code of an IDL module.
7464  Works for modules for which IDLWAVE has routine info available.  Works for modules for which IDLWAVE has routine info available.  The
7465  The function offers as default the module name `idlwave-routine-info' would  function offers as default the module name `idlwave-routine-info'
7466  use.  With ARG force class query for object methods."  would use.  With ARG limit to this buffer.  With two prefix ARG's
7467    force class query for object methods."
7468    (interactive "P")    (interactive "P")
7469    (let* ((idlwave-query-class nil)    (let* ((idlwave-query-class nil)
7470           (idlwave-force-class-query (equal arg '(4)))           (idlwave-force-class-query (equal arg '(16)))
7471             (this-buffer (equal arg '(4)))
7472           (module (idlwave-fix-module-if-obj_new (idlwave-what-module)))           (module (idlwave-fix-module-if-obj_new (idlwave-what-module)))
7473           (default (concat (idlwave-make-full-name (nth 2 module) (car module))           (default (if module
7474                            (if (eq (nth 1 module) 'pro) "<p>" "<f>")))                        (concat (idlwave-make-full-name
7475           (list                                 (nth 2 module) (car module))
7476            (delq nil                                (if (eq (nth 1 module) 'pro) "<p>" "<f>"))
7477                  (mapcar (lambda (x)                      "none"))
7478                            (if (eq 'system (car-safe (nth 3 x)))           (list
7479                                ;; Take out system routines with no source.            (idlwave-uniquify
7480                                nil             (delq nil
7481                              (cons                   (mapcar (lambda (x)
7482                               (concat (idlwave-make-full-name (nth 2 x) (car x))                             (if (eq 'system (car-safe (nth 3 x)))
7483                                       (if (eq (nth 1 x) 'pro) "<p>" "<f>"))                                 ;; Take out system routines with no source.
7484                               (cdr x))))                                 nil
7485                          (idlwave-routines))))                               (list
7486                                  (concat (idlwave-make-full-name
7487                                           (nth 2 x) (car x))
7488                                          (if (eq (nth 1 x) 'pro) "<p>" "<f>")))))
7489                             (if this-buffer
7490                                 (idlwave-save-buffer-update)
7491                               (idlwave-routines))))))
7492           (name (idlwave-completing-read           (name (idlwave-completing-read
7493                  (format "Module (Default %s): "                  (if (or (not this-buffer)
7494                          (if default default "none"))                          (assoc default list))
7495                        (format "Module (Default %s): " default)
7496                      (format "Module in this file: "))
7497                  list))                  list))
7498           type class)           type class)
7499      (if (string-match "\\`\\s-*\\'" name)      (if (string-match "\\`\\s-*\\'" name)
# Line 6985  use.  With ARG force class query for obj Line 7510  use.  With ARG force class query for obj
7510            type (cond ((equal type "f") 'fun)            type (cond ((equal type "f") 'fun)
7511                       ((equal type "p") 'pro)                       ((equal type "p") 'pro)
7512                       (t t)))                       (t t)))
7513      (idlwave-do-find-module name type class)))      (idlwave-do-find-module name type class nil this-buffer)))
7514    
7515  (defun idlwave-do-find-module (name type class &optional force-source)  (defun idlwave-do-find-module (name type class
7516                                        &optional force-source this-buffer)
7517    (let ((name1 (idlwave-make-full-name class name))    (let ((name1 (idlwave-make-full-name class name))
7518          source buf1 entry          source buf1 entry
7519          (buf (current-buffer))          (buf (current-buffer))
7520          (pos (point))          (pos (point))
7521          name2)          file name2)
7522      (setq entry (idlwave-best-rinfo-assq name type class (idlwave-routines))      (setq entry (idlwave-best-rinfo-assq name type class (idlwave-routines)
7523                                             'WITH-FILE)
7524            source (or force-source (nth 3 entry))            source (or force-source (nth 3 entry))
7525            name2 (if (nth 2 entry)            name2 (if (nth 2 entry)
7526                      (idlwave-make-full-name (nth 2 entry) name)                      (idlwave-make-full-name (nth 2 entry) name)
7527                    name1))                    name1))
7528        (if source  
7529            (setq file (idlwave-routine-source-file source)))
7530        (unless file  ; Try to find it on the path.
7531          (setq file
7532                (idlwave-expand-lib-file-name
7533                 (if class
7534                     (format "%s__define.pro" (downcase class))
7535                   (format "%s.pro" (downcase name))))))
7536      (cond      (cond
7537       ((or (null name) (equal name ""))       ((or (null name) (equal name ""))
7538        (error "Abort"))        (error "Abort"))
      ((null entry)  
       (error "Nothing known about a module %s" name2))  
7539       ((eq (car source) 'system)       ((eq (car source) 'system)
7540        (error "Source code for system routine %s is not available"        (error "Source code for system routine %s is not available"
7541               name2))               name2))
7542       ((equal (cdr source) "")       ((or (not file) (not (file-regular-p file)))
7543        (error "Source code for routine %s is not available"        (error "Source code for routine %s is not available"
7544               name2))               name2))
7545       ((memq (car source) '(buffer lib compiled))       (t
7546        (setq buf1        (when (not this-buffer)
7547              (if (eq (car source) 'lib)          (setq buf1
7548                  (idlwave-find-file-noselect                (idlwave-find-file-noselect file 'find))
7549                   (idlwave-expand-lib-file-name          (pop-to-buffer buf1 t))
                   (or (cdr source)  
                       (format "%s.pro" (downcase name)))) 'find)  
               (idlwave-find-file-noselect (cdr source) 'find)))  
       (pop-to-buffer buf1 t)  
7550        (goto-char (point-max))        (goto-char (point-max))
7551        (let ((case-fold-search t))        (let ((case-fold-search t))
7552          (if (re-search-backward          (if (re-search-backward
7553               (concat "^[ \t]*\\<"               (concat "^[ \t]*\\<"
7554                       (cond ((equal type "f") "function")                       (cond ((eq type 'fun) "function")
7555                             ((equal type "p") "pro")                             ((eq type 'pro) "pro")
7556                             (t "\\(pro\\|function\\)"))                             (t "\\(pro\\|function\\)"))
7557                       "\\>[ \t]+"                       "\\>[ \t]+"
7558                       (regexp-quote (downcase name2))                       (regexp-quote (downcase name2))
7559                       "[^a-zA-Z0-9_$]")                       "[^a-zA-Z0-9_$]")
7560               nil t)               nil t)
# Line 7045  Used by `idlwave-routine-info' and `idlw Line 7574  Used by `idlwave-routine-info' and `idlw
7574        ;; This is a function or procedure definition statement        ;; This is a function or procedure definition statement
7575        ;; We return the defined routine as module.        ;; We return the defined routine as module.
7576        (list        (list
7577         (idlwave-sintern-routine-or-method (match-string 4)         (idlwave-sintern-routine-or-method (match-string-no-properties 4)
7578                                            (match-string 2))                                            (match-string-no-properties 2))
7579         (if (equal (downcase (match-string 1)) "pro") 'pro 'fun)         (if (equal (downcase (match-string 1)) "pro") 'pro 'fun)
7580         (idlwave-sintern-class (match-string 3)))         (idlwave-sintern-class (match-string 3)))
7581    
7582      ;; Not a definition statement - analyze precise positon.      ;; Not a definition statement - analyze precise position.
7583      (let* ((where (idlwave-where))      (let* ((where (idlwave-where))
7584             (cw (nth 2 where))             (cw (nth 2 where))
7585             (pro (car (nth 0 where)))             (pro (car (nth 0 where)))
# Line 7062  Used by `idlwave-routine-info' and `idlw Line 7591  Used by `idlwave-routine-info' and `idlw
7591        (cond        (cond
7592         ((and (eq cw 'procedure)         ((and (eq cw 'procedure)
7593               (not (equal this-word "")))               (not (equal this-word "")))
7594          (setq this-word (idlwave-sintern-routine-or-method          (setq this-word (idlwave-sintern-routine-or-method
7595                           this-word (nth 2 (nth 3 where))))                           this-word (nth 2 (nth 3 where))))
7596          (list this-word 'pro          (list this-word 'pro
7597                (idlwave-determine-class                (idlwave-determine-class
7598                 (cons this-word (cdr (nth 3 where)))                 (cons this-word (cdr (nth 3 where)))
7599                 'pro)))                 'pro)))
7600         ((and (eq cw 'function)         ((and (eq cw 'function)
7601               (not (equal this-word ""))               (not (equal this-word ""))
7602               (or (eq next-char ?\()     ; exclude arrays, vars.               (or (eq next-char ?\()     ; exclude arrays, vars.
7603                   (looking-at "[a-zA-Z0-9_]*[ \t]*(")))                   (looking-at "[a-zA-Z0-9_]*[ \t]*(")))
7604          (setq this-word (idlwave-sintern-routine-or-method          (setq this-word (idlwave-sintern-routine-or-method
7605                           this-word (nth 2 (nth 3 where))))                           this-word (nth 2 (nth 3 where))))
7606          (list this-word 'fun          (list this-word 'fun
7607                (idlwave-determine-class                (idlwave-determine-class
# Line 7109  Used by `idlwave-routine-info' and `idlw Line 7638  Used by `idlwave-routine-info' and `idlw
7638        class)))        class)))
7639    
7640  (defun idlwave-fix-module-if-obj_new (module)  (defun idlwave-fix-module-if-obj_new (module)
7641    "Check if MODULE points to obj_new.  If yes, and if the cursor is in the    "Check if MODULE points to obj_new.  
7642  keyword region, change to the appropriate Init method."  If yes, and if the cursor is in the keyword region, change to the
7643    appropriate Init method."
7644    (let* ((name (car module))    (let* ((name (car module))
7645           (pos (point))           (pos (point))
7646           (case-fold-search t)           (case-fold-search t)
# Line 7129  keyword region, change to the appropriat Line 7659  keyword region, change to the appropriat
7659                               (idlwave-sintern-class class)))))                               (idlwave-sintern-class class)))))
7660      module))      module))
7661    
7662    (defun idlwave-fix-keywords (name type class keywords &optional super-classes)
7663  (defun idlwave-fix-keywords (name type class keywords)    "Update a list of keywords.
7664    ;; This fixes the list of keywords.  Translate OBJ_NEW, adding all super-class keywords, or all keywords
7665    from all classes if class equals t."
7666    (let ((case-fold-search t))    (let ((case-fold-search t))
7667    
7668      ;; If this is the OBJ_NEW function, try to figure out the class and use      ;; If this is the OBJ_NEW function, try to figure out the class and use
# Line 7147  keyword region, change to the appropriat Line 7678  keyword region, change to the appropriat
7678                               string)                               string)
7679                 (setq class (idlwave-sintern-class (match-string 1 string)))                 (setq class (idlwave-sintern-class (match-string 1 string)))
7680                 (setq idlwave-current-obj_new-class class)                 (setq idlwave-current-obj_new-class class)
7681                 (setq keywords                 (setq keywords
7682                       (append keywords                       (append keywords
7683                               (nth 5 (idlwave-rinfo-assq                               (idlwave-entry-keywords
7684                                       (idlwave-sintern-method "INIT")                                (idlwave-rinfo-assq
7685                                       'fun                                 (idlwave-sintern-method "INIT")
7686                                       class                                 'fun
7687                                       (idlwave-routines))))))))                                 class
7688                                   (idlwave-routines)) 'do-link))))))
7689        
7690      ;; If the class is `t', combine all keywords of all methods NAME      ;; If the class is `t', combine all keywords of all methods NAME
7691      (when (eq class t)      (when (eq class t)
7692        (loop for x in (idlwave-routines) do        (mapc (lambda (entry)
7693              (and (nth 2 x)                ; non-nil class                (and
7694                   (eq (nth 1 x) type)      ; correct type                 (nth 2 entry)             ; non-nil class
7695                   (eq (car x) name)        ; correct name                 (eq (nth 1 entry) type)   ; correct type
7696                   (mapcar (lambda (k) (add-to-list 'keywords k))                 (setq keywords
7697                           (nth 5 x))))                       (append keywords
7698                                 (idlwave-entry-keywords entry 'do-link)))))
7699                (idlwave-all-assq name (idlwave-routines)))
7700        (setq keywords (idlwave-uniquify keywords)))        (setq keywords (idlwave-uniquify keywords)))
7701        
7702      ;; If we have inheritance, add all keywords from superclasses, if      ;; If we have inheritance, add all keywords from superclasses, if
7703      ;; the user indicated that method in      ;; the user indicated that method in `idlwave-keyword-class-inheritance'
7704      ;; `idlwave-keyword-class-inheritance'      (when (and
7705      (when (and             super-classes
7706             idlwave-keyword-class-inheritance             idlwave-keyword-class-inheritance
7707             (stringp class)             (stringp class)
7708             (or (assq (idlwave-sintern-keyword "_extra") keywords)             (or (assq (idlwave-sintern-keyword "_extra") keywords)
7709                 (assq (idlwave-sintern-keyword "_ref_extra") keywords))                 (assq (idlwave-sintern-keyword "_ref_extra") keywords))
            (boundp 'super-classes)  
7710             ;; Check if one of the keyword-class regexps matches the name             ;; Check if one of the keyword-class regexps matches the name
7711             (let ((regexps idlwave-keyword-class-inheritance) re)             (let ((regexps idlwave-keyword-class-inheritance) re)
7712               (catch 'exit               (catch 'exit
7713                 (while (setq re (pop regexps))                 (while (setq re (pop regexps))
7714                   (if (string-match re name) (throw 'exit t))))))                   (if (string-match re name) (throw 'exit t))))))
7715        (loop for x in (idlwave-routines) do  
7716              (and (nth 2 x)                           ; non-nil class        (loop for entry in (idlwave-routines) do
7717                   (or (eq (nth 2 x) class)            ; the right class              (and (nth 2 entry)                           ; non-nil class
7718                       (memq (nth 2 x) super-classes)) ; an inherited class                   (memq (nth 2 entry) super-classes)      ; an inherited class
7719                   (eq (nth 1 x) type)                 ; correct type                   (eq (nth 1 entry) type)                 ; correct type
7720                   (eq (car x) name)                   ; correct name                   (eq (car entry) name)                   ; correct name
7721                   (mapcar (lambda (k) (add-to-list 'keywords k))                   (mapcar (lambda (k) (add-to-list 'keywords k))
7722                           (nth 5 x))))                           (idlwave-entry-keywords entry 'do-link))))
7723        (setq keywords (idlwave-uniquify keywords)))        (setq keywords (idlwave-uniquify keywords)))
7724        
7725      ;; Return the final list      ;; Return the final list
7726      keywords))      keywords))
7727    
# Line 7208  If we do not know about MODULE, just ret Line 7741  If we do not know about MODULE, just ret
7741           (class (nth 2 module))           (class (nth 2 module))
7742           (kwd (idlwave-sintern-keyword keyword))           (kwd (idlwave-sintern-keyword keyword))
7743           (entry (idlwave-best-rinfo-assoc name type class (idlwave-routines)))           (entry (idlwave-best-rinfo-assoc name type class (idlwave-routines)))
7744           (kwd-alist (nth 5 entry))           (kwd-alist (idlwave-entry-keywords entry))
7745           (extra (or (assq (idlwave-sintern-keyword "_EXTRA") kwd-alist)           (extra (or (assq (idlwave-sintern-keyword "_EXTRA") kwd-alist)
7746                      (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist)))                      (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist)))
7747           (completion-ignore-case t)           (completion-ignore-case t)
7748           candidates)           candidates)
7749      (cond ((assq kwd kwd-alist)      (cond ((assq kwd kwd-alist)
7750             kwd)             kwd)
7751            ((setq candidates (all-completions kwd kwd-alist))            ((setq candidates (all-completions kwd kwd-alist))
7752             (if (= (length candidates) 1)             (if (= (length candidates) 1)
7753                 (car candidates)                 (car candidates)
7754               candidates))               candidates))
7755            ((and entry extra)            ((and entry extra)
7756             ;; Inheritance may cause this keyword to be correct             ;; Inheritance may cause this keyword to be correct
7757             keyword)             keyword)
7758            (entry            (entry
7759             ;; We do know the function, which does not have the keyword.             ;; We do know the function, which does not have the keyword.
# Line 7232  If we do not know about MODULE, just ret Line 7765  If we do not know about MODULE, just ret
7765    
7766  (defvar idlwave-rinfo-mouse-map (make-sparse-keymap))  (defvar idlwave-rinfo-mouse-map (make-sparse-keymap))
7767  (defvar idlwave-rinfo-map (make-sparse-keymap))  (defvar idlwave-rinfo-map (make-sparse-keymap))
7768  (define-key idlwave-rinfo-mouse-map  (define-key idlwave-rinfo-mouse-map
7769    (if (featurep 'xemacs) [button2] [mouse-2])    (if (featurep 'xemacs) [button2] [mouse-2])
7770    'idlwave-mouse-active-rinfo)    'idlwave-mouse-active-rinfo)
7771  (define-key idlwave-rinfo-mouse-map  (define-key idlwave-rinfo-mouse-map
7772    (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])    (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
7773    'idlwave-mouse-active-rinfo-shift)    'idlwave-mouse-active-rinfo-shift)
7774  (define-key idlwave-rinfo-mouse-map  (define-key idlwave-rinfo-mouse-map
7775    (if (featurep 'xemacs) [button3] [mouse-3])    (if (featurep 'xemacs) [button3] [mouse-3])
7776    'idlwave-mouse-active-rinfo-right)    'idlwave-mouse-active-rinfo-right)
7777  (define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space)  (define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space)
# Line 7264  If we do not know about MODULE, just ret Line 7797  If we do not know about MODULE, just ret
7797    (let* ((initial-class (or initial-class class))    (let* ((initial-class (or initial-class class))
7798           (entry (or (idlwave-best-rinfo-assq name type class           (entry (or (idlwave-best-rinfo-assq name type class
7799                                               (idlwave-routines))                                               (idlwave-routines))
7800                      (idlwave-rinfo-assq name type class                      (idlwave-rinfo-assq name type class
7801                                          idlwave-unresolved-routines)))                                          idlwave-unresolved-routines)))
7802           (name (or (car entry) name))           (name (or (car entry) name))
7803           (class (or (nth 2 entry) class))           (class (or (nth 2 entry) class))
# Line 7272  If we do not know about MODULE, just ret Line 7805  If we do not know about MODULE, just ret
7805           (twins (idlwave-routine-twins entry))           (twins (idlwave-routine-twins entry))
7806           (dtwins (idlwave-study-twins twins))           (dtwins (idlwave-study-twins twins))
7807           (all dtwins)           (all dtwins)
7808           (system (idlwave-rinfo-assq           (system (eq (car (nth 3 entry)) 'system))
                   name type class idlwave-system-routines))  
          (have-sysdoc (and system (idlwave-help-directory)))  
          ;; (source (nth 3 entry))  
          (have-olh (and (or system idlwave-extra-help-function)  
                         (idlwave-help-directory)))  
7809           (calling-seq (nth 4 entry))           (calling-seq (nth 4 entry))
7810           (keywords (nth 5 entry))           (keywords (idlwave-entry-keywords entry 'do-link))
7811           (olh (nth 6 entry))           (html-file (car (nth 5 entry)))
7812           (help-echo-kwd           (help-echo-kwd
7813            (if have-olh            "Button2: Insert KEYWORD (SHIFT=`/KEYWORD') | Button3: Online Help ")
               "Button2: Insert KEYWORD (SHIFT=`/KEYWORD')    Button3: Online Help "  
             "Button2: Insert KEYWORD (SHIFT=`/KEYWORD')."))  
7814           (help-echo-use           (help-echo-use
7815            (if have-olh            "Button2/3: Online Help")
               "Button2/3: Online Help"  
             nil))  
7816           (help-echo-src           (help-echo-src
7817            (if (idlwave-help-directory)            "Button2: Jump to source and back | Button3: Source in Help window.")
               "Button2: Pop to source and back.             Button3: Source in Help window."  
             "Button2: Pop to source and back."))  
7818           (help-echo-class           (help-echo-class
7819            "Button2: Display info about same method in superclass")            "Button2: Display info about same method in superclass")
7820           (col 0)           (col 0)
7821           (data (list name type class (current-buffer) olh initial-class))           (data (list name type class (current-buffer) nil initial-class))
7822           (km-prop (if (featurep 'xemacs) 'keymap 'local-map))           (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
7823           (face 'idlwave-help-link-face)           (face 'idlwave-help-link-face)
7824           beg props win cnt total)           beg props win cnt total)
7825        ;; Fix keywords, but don't add chained super-classes, since these
7826        ;; are shown separately for that super-class
7827      (setq keywords (idlwave-fix-keywords name type class keywords))      (setq keywords (idlwave-fix-keywords name type class keywords))
7828      (cond      (cond
7829       ((null entry)       ((null entry)
# Line 7308  If we do not know about MODULE, just ret Line 7832  If we do not know about MODULE, just ret
7832       ((or (null name) (equal name ""))       ((or (null name) (equal name ""))
7833        (error "No function or procedure call at point"))        (error "No function or procedure call at point"))
7834       ((null calling-seq)       ((null calling-seq)
7835        (error "Calling sequence of %s %s is not available" type name))        (error "Calling sequence of %s %s not available" type name))
7836       (t       (t
7837        (save-excursion        (save-excursion
7838          (move-marker idlwave-rinfo-marker (point))          (move-marker idlwave-rinfo-marker (point))
# Line 7332  If we do not know about MODULE, just ret Line 7856  If we do not know about MODULE, just ret
7856                (insert c)                (insert c)
7857                (if (equal (downcase c) (downcase class))                (if (equal (downcase c) (downcase class))
7858                    (add-text-properties beg (point) (list 'face 'bold))                    (add-text-properties beg (point) (list 'face 'bold))
7859                    ;; If Method exists in a different class link it
7860                  (if (idlwave-rinfo-assq name type c (idlwave-routines))                  (if (idlwave-rinfo-assq name type c (idlwave-routines))
7861                      (add-text-properties beg (point) props))))                      (add-text-properties beg (point) props))))
7862              (insert "\n")))              (insert "\n")))
7863          (setq props (if have-olh          (setq props (list 'mouse-face 'highlight
7864                          (list 'mouse-face 'highlight                            km-prop idlwave-rinfo-mouse-map
7865                                km-prop idlwave-rinfo-mouse-map                            'help-echo help-echo-use
7866                                'help-echo help-echo-use                            'data (cons 'usage data)))
7867                                'data (cons 'usage data))))          (if html-file (setq props (append (list 'face face 'link html-file)
7868          (if have-sysdoc (setq props (append (list 'face face) props)))                                            props)))
7869          (insert "Usage:    ")          (insert "Usage:    ")
7870          (setq beg (point))          (setq beg (point))
7871          (insert (if class          (insert (if class
7872                      (format calling-seq class name)                      (format calling-seq class name class name class name)
7873                    (format calling-seq name))                    (format calling-seq name name name name))
7874                  "\n")                  "\n")
7875          (add-text-properties beg (point) props)          (add-text-properties beg (point) props)
7876            
7877          (insert "Keywords:")          (insert "Keywords:")
7878          (if (null keywords)          (if (null keywords)
7879              (insert " No keywords accepted.")              (insert " No keywords accepted.")
7880            (setq col 9)            (setq col 9)
7881            (mapcar            (mapcar
7882             (lambda (x)             (lambda (x)
7883               (if (>= (+ col 1 (length (car x)))               (if (>= (+ col 1 (length (car x)))
7884                       (window-width))                       (window-width))
7885                   (progn                   (progn
7886                     (insert "\n         ")                     (insert "\n         ")
7887                     (setq col 9)))                     (setq col 9)))
7888               (insert " ")               (insert " ")
7889               (setq beg (point)               (setq beg (point)
7890                       ;; Relevant keywords already have link property attached
7891                     props (list 'mouse-face 'highlight                     props (list 'mouse-face 'highlight
7892                                 km-prop idlwave-rinfo-mouse-map                                 km-prop idlwave-rinfo-mouse-map
7893                                 'data (cons 'keyword data)                                 'data (cons 'keyword data)
7894                                 'help-echo help-echo-kwd                                 'help-echo help-echo-kwd
7895                                 'keyword (car x)))                                 'keyword (car x)))
7896               (if have-sysdoc (setq props (append (list 'face face) props)))               (if system (setq props (append (list 'face face) props)))
7897               (insert (car x))               (insert (car x))
7898               (add-text-properties beg (point) props)               (add-text-properties beg (point) props)
7899               (setq col (+ col 1 (length (car x)))))               (setq col (+ col 1 (length (car x)))))
7900             keywords))             keywords))
7901            
7902          (setq cnt 1 total (length all))          (setq cnt 1 total (length all))
7903            ;; Here entry is (key file (list of type-conses))
7904          (while (setq entry (pop all))          (while (setq entry (pop all))
7905            (setq props (list 'mouse-face 'highlight            (setq props (list 'mouse-face 'highlight
7906                              km-prop idlwave-rinfo-mouse-map                              km-prop idlwave-rinfo-mouse-map
7907                              'help-echo help-echo-src                              'help-echo help-echo-src
7908                              'source (cons (car (nth 2 entry)) (nth 1 entry))                              'source (list (car (car (nth 2 entry))) ;type
7909                                              (nth 1 entry)
7910                                              nil
7911                                              (cdr (car (nth 2 entry))))
7912                              'data (cons 'source data)))                              'data (cons 'source data)))
7913            (idlwave-insert-source-location            (idlwave-insert-source-location
7914             (format "\n%-8s  %s"             (format "\n%-8s  %s"
7915                     (if (equal cnt 1)                     (if (equal cnt 1)
7916                         (if (> total 1) "Sources:" "Source:")                         (if (> total 1) "Sources:" "Source:")
7917                       "")                       "")
# Line 7390  If we do not know about MODULE, just ret Line 7920  If we do not know about MODULE, just ret
7920            (incf cnt)            (incf cnt)
7921            (when (and all (> cnt idlwave-rinfo-max-source-lines))            (when (and all (> cnt idlwave-rinfo-max-source-lines))
7922              ;; No more source lines, please              ;; No more source lines, please
7923              (insert (format              (insert (format
7924                       "\n          Source information truncated to %d entries."                       "\n          Source information truncated to %d entries."
7925                       idlwave-rinfo-max-source-lines))                       idlwave-rinfo-max-source-lines))
7926              (setq all nil)))              (setq all nil)))
7927            (beginning-of-buffer)
7928          (setq buffer-read-only t))          (setq buffer-read-only t))
7929        (display-buffer "*Help*")        (display-buffer "*Help*")
7930        (if (and (setq win (get-buffer-window "*Help*"))        (if (and (setq win (get-buffer-window "*Help*"))
# Line 7404  If we do not know about MODULE, just ret Line 7934  If we do not know about MODULE, just ret
7934                (unwind-protect                (unwind-protect
7935                    (progn                    (progn
7936                      (select-window win)                      (select-window win)
7937                      (enlarge-window (- (/ (frame-height) 2)                      (enlarge-window (- (/ (frame-height) 2)
7938                                         (window-height)))                                         (window-height)))
7939                      (shrink-window-if-larger-than-buffer))                      (shrink-window-if-larger-than-buffer))
7940                  (select-window ww)))))))))                  (select-window ww)))))))))
7941    
7942  (defun idlwave-insert-source-location (prefix entry &optional file-props)  (defun idlwave-insert-source-location (prefix entry &optional file-props)
7943    "Insert a source location into the routine info buffer.    "Insert a source location into the routine info buffer.
7944  Start line with PREFIX.  Start line with PREFIX.  If a file name is inserted, add FILE-PROPS to
7945  If a file name is inserted, add FILE-PROPS to it."  it."
   
7946    (let* ((key (car entry))    (let* ((key (car entry))
7947           (file (nth 1 entry))           (file (nth 1 entry))
7948           (types (nth 2 entry))           (types (nth 2 entry))
7949           (shell-flag (member 'compiled types))           (shell-flag (assq 'compiled types))
7950           (buffer-flag (member 'buffer types))           (buffer-flag (assq 'buffer types))
7951           (lib-flag (member 'lib types))           (user-flag (assq 'user types))
7952           (ndupl (or (and buffer-flag (idlwave-count-eq 'buffer types))           (lib-flag (assq 'lib types))
7953                      (and lib-flag (idlwave-count-eq 'lib types))           (ndupl (or (and buffer-flag (idlwave-count-memq 'buffer types))
7954                        (and user-flag (idlwave-count-memq 'user types))
7955                        (and lib-flag (idlwave-count-memq 'lib types))
7956                      1))                      1))
7957           (doflags t)           (doflags t)
7958           beg special)           beg special)
# Line 7431  If a file name is inserted, add FILE-PRO Line 7962  If a file name is inserted, add FILE-PRO
7962      (cond      (cond
7963       ((eq key 'system)       ((eq key 'system)
7964        (setq doflags nil)        (setq doflags nil)
7965                                  (insert "System    "))        (insert "System    "))
7966    
7967       ((eq key 'builtin)       ((eq key 'builtin)
7968        (setq doflags nil)        (setq doflags nil)
7969                                  (insert "Builtin   "))        (insert "Builtin   "))
7970    
7971       ((and (not file) shell-flag)       ((and (not file) shell-flag)
7972                                  (insert "Unresolved"))        (insert "Unresolved"))
7973       ((null file)               (insert "ERROR"))  
7974       ((setq special (idlwave-special-lib-test file))       ((null file)              
7975        (insert (format "%-10s" special)))        (insert "ERROR"))
7976        
7977       ((idlwave-syslib-p file)       ((idlwave-syslib-p file)
7978        (if (string-match "obsolete" (file-name-directory file))        (if (string-match "obsolete" (file-name-directory file))
7979                                  (insert "Obsolete  ")            (insert "Obsolete  ")
7980                                  (insert "SystemLib ")))          (insert "SystemLib ")))
7981    
7982         ;; New special syntax: taken directly from routine-info for
7983         ;; library catalog routines
7984         ((setq special (or (cdr lib-flag) (cdr user-flag)))
7985          (insert (format "%-10s" special)))
7986    
7987         ;; Old special syntax: a matching regexp
7988         ((setq special (idlwave-special-lib-test file))
7989          (insert (format "%-10s" special)))
7990        
7991         ;; Catch-all with file
7992       ((idlwave-lib-p file)      (insert "Library   "))       ((idlwave-lib-p file)      (insert "Library   "))
7993    
7994         ;; Sanity catch all
7995       (t                         (insert "Other     ")))       (t                         (insert "Other     ")))
7996    
7997      (when doflags      (when doflags
7998        (insert (concat        (insert (concat
7999                 "  ["                 "  ["
8000                 (if lib-flag "C" "-")                 (if lib-flag "L" "-")
8001                   (if user-flag "C" "-")
8002                 (if shell-flag "S" "-")                 (if shell-flag "S" "-")
8003                 (if buffer-flag "B" "-")                 (if buffer-flag "B" "-")
8004                 "] ")))                 "] ")))
8005      (when (> ndupl 1)      (when (> ndupl 1)
8006        (setq beg (point))        (setq beg (point))
8007        (insert (format "(%dx) " ndupl))        (insert (format "(%dx) " ndupl))
8008        (add-text-properties beg (point) (list 'face 'bold)))        (add-text-properties beg (point) (list 'face 'bold)))
# Line 7478  Return the name of the special lib if th Line 8026  Return the name of the special lib if th
8026                    alist nil)))                    alist nil)))
8027        rtn)        rtn)
8028       (t nil))))       (t nil))))
8029      
8030  (defun idlwave-mouse-active-rinfo-right (ev)  (defun idlwave-mouse-active-rinfo-right (ev)
8031    (interactive "e")    (interactive "e")
8032    (idlwave-mouse-active-rinfo ev 'right))    (idlwave-mouse-active-rinfo ev 'right))
# Line 7497  Optional args RIGHT and SHIFT indicate, Line 8045  Optional args RIGHT and SHIFT indicate,
8045  was pressed."  was pressed."
8046    (interactive "e")    (interactive "e")
8047    (if ev (mouse-set-point ev))    (if ev (mouse-set-point ev))
8048    (let (data id name type class buf keyword bufwin source word initial-class)    (let (data id name type class buf bufwin source word initial-class)
8049      (setq data (get-text-property (point) 'data)      (setq data (get-text-property (point) 'data)
8050            source (get-text-property (point) 'source)            source (get-text-property (point) 'source)
8051            keyword (get-text-property (point) 'keyword)            keyword (get-text-property (point) 'keyword)
8052              link (get-text-property (point) 'link)
8053            id (car data)            id (car data)
8054            name (nth 1 data) type (nth 2 data) class (nth 3 data)            name (nth 1 data) type (nth 2 data) class (nth 3 data)
8055            buf (nth 4 data)            buf (nth 4 data)
8056            initial-class (nth 6 data)            initial-class (nth 6 data)
8057            word (idlwave-this-word)            word (idlwave-this-word)
8058            bufwin (get-buffer-window buf t))            bufwin (get-buffer-window buf t))
8059      (cond ((eq id 'class)  
8060        (cond ((eq id 'class) ; Switch class being displayed
8061             (if (window-live-p bufwin) (select-window bufwin))             (if (window-live-p bufwin) (select-window bufwin))
8062             (idlwave-display-calling-sequence             (idlwave-display-calling-sequence
8063              (idlwave-sintern-method name)              (idlwave-sintern-method name)
8064              type (idlwave-sintern-class word)              type (idlwave-sintern-class word)
8065              initial-class))              initial-class))
8066            ((eq id 'usage)            ((eq id 'usage) ; Online help on this routine
8067             (idlwave-require-online-help)             (idlwave-online-help link name type class))
8068             (idlwave-online-help nil name type class))            ((eq id 'source) ; Source in help or buffer
8069            ((eq id 'source)             (if right ; In help
            (if (and right (idlwave-help-directory))  
8070                 (let ((idlwave-extra-help-function 'idlwave-help-with-source)                 (let ((idlwave-extra-help-function 'idlwave-help-with-source)
8071                       (idlwave-help-source-try-header nil)                       (idlwave-help-source-try-header nil)
8072                       ;; Fake idlwave-routines, to make help find the right entry                       ;; Fake idlwave-routines so help will find the right entry
8073                       (idlwave-routines                       (idlwave-routines
8074                        (list (list (nth 1 data) (nth 2 data) (nth 3 data) source ""))))                        (list (list name type class source ""))))
                  (idlwave-require-online-help)  
8075                   (idlwave-help-get-special-help name type class nil))                   (idlwave-help-get-special-help name type class nil))
8076                 ;; Otherwise just pop to the source
8077               (setq idlwave-popup-source (not idlwave-popup-source))               (setq idlwave-popup-source (not idlwave-popup-source))
8078               (if idlwave-popup-source               (if idlwave-popup-source
8079                   (condition-case err                   (condition-case err
# Line 7539  was pressed." Line 8088  was pressed."
8088                 (goto-char (marker-position idlwave-rinfo-marker)))))                 (goto-char (marker-position idlwave-rinfo-marker)))))
8089            ((eq id 'keyword)            ((eq id 'keyword)
8090             (if right             (if right
8091                 (progn                 (idlwave-online-help link name type class keyword)
                  (idlwave-require-online-help)  
                  (idlwave-online-help nil name type class keyword))  
8092               (idlwave-rinfo-insert-keyword keyword buf shift))))))               (idlwave-rinfo-insert-keyword keyword buf shift))))))
8093    
8094  (defun idlwave-rinfo-insert-keyword (keyword buffer &optional shift)  (defun idlwave-rinfo-insert-keyword (keyword buffer &optional shift)
# Line 7555  was pressed." Line 8102  was pressed."
8102        (setq bwin (get-buffer-window buffer)))        (setq bwin (get-buffer-window buffer)))
8103      (if (eq (preceding-char) ?/)      (if (eq (preceding-char) ?/)
8104          (insert keyword)          (insert keyword)
8105        (unless (save-excursion        (unless (save-excursion
8106                  (re-search-backward                  (re-search-backward
8107                   "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\="                   "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\="
8108                   (min (- (point) 100) (point-min)) t))                   (min (- (point) 100) (point-min)) t))
8109          (insert ", "))          (insert ", "))
8110        (if shift (insert "/"))        (if shift (insert "/"))
# Line 7608  When IDL hits a routine call which is no Line 8155  When IDL hits a routine call which is no
8155  the load path in order to find a definition.  The output of this  the load path in order to find a definition.  The output of this
8156  command can be used to detect possible name clashes during this process."  command can be used to detect possible name clashes during this process."
8157    (idlwave-routines)  ; Make sure everything is loaded.    (idlwave-routines)  ; Make sure everything is loaded.
8158    (unless idlwave-library-routines    (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines)
8159      (or (y-or-n-p      (or (y-or-n-p
8160           "You don't have a library catalog.  Continue anyway? ")           "You don't have any user or library catalogs.  Continue anyway? ")
8161          (error "Abort")))          (error "Abort")))
8162    (let* ((routines (append idlwave-system-routines    (let* ((routines (append idlwave-system-routines
8163                             idlwave-compiled-routines                             idlwave-compiled-routines
8164                             idlwave-library-routines                             idlwave-library-catalog-routines
8165                               idlwave-user-catalog-routines
8166                             idlwave-buffer-routines                             idlwave-buffer-routines
8167                             nil))                             nil))
8168           (km-prop (if (featurep 'xemacs) 'keymap 'local-map))           (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
8169           (keymap (make-sparse-keymap))           (keymap (make-sparse-keymap))
8170           (props (list 'mouse-face 'highlight           (props (list 'mouse-face 'highlight
8171                        km-prop keymap                        km-prop keymap
8172                        'help-echo "Mouse2: Find source"))                        'help-echo "Mouse2: Find source"))      
8173           (nroutines (length (or special-routines routines)))           (nroutines (length (or special-routines routines)))
8174           (step (/ nroutines 99))           (step (/ nroutines 99))
8175           (n 0)           (n 0)
# Line 7645  command can be used to detect possible n Line 8193  command can be used to detect possible n
8193      (message "Sorting routines...done")      (message "Sorting routines...done")
8194    
8195      (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)])      (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)])
8196        (lambda (ev)        (lambda (ev)
8197          (interactive "e")          (interactive "e")
8198          (mouse-set-point ev)          (mouse-set-point ev)
8199          (apply 'idlwave-do-find-module          (apply 'idlwave-do-find-module
8200                 (get-text-property (point) 'find-args))))                 (get-text-property (point) 'find-args))))
8201      (define-key keymap [(return)]      (define-key keymap [(return)]
8202        (lambda ()        (lambda ()
8203          (interactive)          (interactive)
8204          (apply 'idlwave-do-find-module          (apply 'idlwave-do-find-module
8205                 (get-text-property (point) 'find-args))))                 (get-text-property (point) 'find-args))))
# Line 7674  command can be used to detect possible n Line 8222  command can be used to detect possible n
8222          ;; Mark all twins as dealt with          ;; Mark all twins as dealt with
8223          (setq done (append twins done))          (setq done (append twins done))
8224          (when (or (> (length dtwins) 1)          (when (or (> (length dtwins) 1)
8225                    (> (idlwave-count-eq 'lib (nth 2 (car dtwins))) 1)                    (> (idlwave-count-memq 'lib (nth 2 (car dtwins))) 1)
8226                    (> (idlwave-count-eq 'buffer (nth 2 (car dtwins))) 1))                    (> (idlwave-count-memq 'user (nth 2 (car dtwins))) 1)
8227                      (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1))
8228            (incf cnt)            (incf cnt)
8229            (insert (format "\n%s%s"            (insert (format "\n%s%s"
8230                            (idlwave-make-full-name (nth 2 routine) (car routine))                            (idlwave-make-full-name (nth 2 routine)
8231                                                      (car routine))
8232                            (if (eq (nth 1 routine) 'fun) "()" "")))                            (if (eq (nth 1 routine) 'fun) "()" "")))
8233            (while (setq twin (pop dtwins))            (while (setq twin (pop dtwins))
8234              (setq props1 (append (list 'find-args              (setq props1 (append (list 'find-args
8235                                         (list (nth 0 routine)                                         (list (nth 0 routine)
8236                                               (nth 1 routine)                                               (nth 1 routine)
8237                                               (nth 2 routine)                                               (nth 2 routine)))
                                              (cons 'lib (nth 1 twin))))  
8238                                   props))                                   props))
8239              (idlwave-insert-source-location "\n   - " twin props1))))              (idlwave-insert-source-location "\n   - " twin props1))))
8240        (goto-char (point-min))        (goto-char (point-min))
# Line 7701  command can be used to detect possible n Line 8250  command can be used to detect possible n
8250  (defun idlwave-print-source (routine)  (defun idlwave-print-source (routine)
8251    (let* ((source (nth 3 routine))    (let* ((source (nth 3 routine))
8252           (stype (car source))           (stype (car source))
8253           (sfile (cdr source)))           (sfile (idlwave-routine-source-file source)))
8254      (if (and (eq stype 'lib) sfile)      (if (idlwave-syslib-p sfile) (setq stype 'syslib))
         (progn  
           (setq sfile (idlwave-expand-lib-file-name sfile))  
           (if (idlwave-syslib-p sfile) (setq stype 'syslib))))  
8255      (if (and (eq stype 'compiled)      (if (and (eq stype 'compiled)
8256               (or (not (stringp sfile))               (or (not (stringp sfile))
8257                   (not (string-match "\\S-" sfile))))                   (not (string-match "\\S-" sfile))))
8258          (setq stype 'unresolved))          (setq stype 'unresolved))
8259      (princ (format "      %-10s %s\n"      (princ (format "      %-10s %s\n"
8260                     stype                     stype
8261                     (if sfile sfile "No source code available")))))                     (if sfile sfile "No source code available")))))
8262    
# Line 7729  ENTRY will also be returned, as the firs Line 8275  ENTRY will also be returned, as the firs
8275                 (eq type (nth 1 candidate))                 (eq type (nth 1 candidate))
8276                 (eq class (nth 2 candidate)))                 (eq class (nth 2 candidate)))
8277            (push candidate twins)))            (push candidate twins)))
8278      (if (setq candidate (idlwave-rinfo-assq name type class      (if (setq candidate (idlwave-rinfo-assq name type class
8279                                              idlwave-unresolved-routines))                                              idlwave-unresolved-routines))
8280          (push candidate twins))          (push candidate twins))
8281      (cons entry (nreverse twins))))      (cons entry (nreverse twins))))
8282    
8283  (defun idlwave-study-twins (entries)  (defun idlwave-study-twins (entries)
8284    "Return dangerous twins of first entry in TWINS.    "Return dangerous twins of first entry in ENTRIES.  
8285  Dangerous twins are routines with same name, but in different files  Dangerous twins are routines with same name, but in different files on
8286  on the load path.  the load path.  If a file is in the system library and has an entry in
8287  If a file is in the system library and has an entry in the  the `idlwave-system-routines' list, we omit the latter as
8288  `idlwave-system-routines' list, we omit the latter because many IDL  non-dangerous because many IDL routines are implemented as library
8289  routines are implemented as library routines."  routines, and may have been scanned."
8290    (let* ((entry (car entries))    (let* ((entry (car entries))
8291           (name (car entry))      ;           (name (car entry))      ;
8292           (type (nth 1 entry))    ; Must be bound for           (type (nth 1 entry))    ; Must be bound for
8293           (class (nth 2 entry))   ;  idlwave-routine-twin-compare           (class (nth 2 entry))   ;  idlwave-routine-twin-compare
8294           (cnt 0)           (cnt 0)
8295           source type file thefile alist syslibp key)           source type type-cons file alist syslibp key)
8296      (while (setq entry (pop entries))      (while (setq entry (pop entries))
8297        (incf cnt)        (incf cnt)
8298        (setq source (nth 3 entry)        (setq source (nth 3 entry)
8299              type (car source)              type (car source)
8300              file (cdr source))              type-cons (cons type (nth 3 source))
8301        (if (eq type 'lib)              file (idlwave-routine-source-file source))
8302            (setq file (idlwave-expand-lib-file-name file)))  
8303        ;; Make KEY to index entry properly        ;; Make KEY to index entry properly
8304        (setq key (cond ((eq type 'system) type)        (setq key (cond ((eq type 'system) type)
8305                        (file (file-truename file))                        (file (file-truename file))
8306                        (t 'unresolved)))                        (t 'unresolved)))
8307        (if (and file  
8308          ;; Check for an entry in the system library
8309          (if (and file
8310                 (not syslibp)                 (not syslibp)
8311                 (idlwave-syslib-p file))                 (idlwave-syslib-p file))
           ;; We do have an entry in the system library  
8312            (setq syslibp t))            (setq syslibp t))
8313          
8314        (setq thefile (or thefile file))        ;; If there's more than one matching entry for the same file, just
8315          ;; append the type-cons to the type list.
8316        (if (setq entry (assoc key alist))        (if (setq entry (assoc key alist))
8317            (push type (nth 2 entry))            (push type-cons (nth 2 entry))
8318          (push (list key file (list type)) alist)))          (push (list key file (list type-cons)) alist)))
8319        
8320      (setq alist (nreverse alist))      (setq alist (nreverse alist))
8321        
8322      (when syslibp      (when syslibp
8323        ;; File is system *library* - remove any system entry        ;; File is in system *library* - remove any 'system entry
8324        (setq alist (delq (assoc 'system alist) alist)))        (setq alist (delq (assq 'system alist) alist)))
8325        
8326        ;; If 'system remains and we've scanned the syslib, it's a builtin
8327        ;; (rather than a !DIR/lib/.pro file bundled as source).
8328      (when (and (idlwave-syslib-scanned-p)      (when (and (idlwave-syslib-scanned-p)
8329                 (setq entry (assoc 'system alist)))                 (setq entry (assoc 'system alist)))
8330        (setcar entry 'builtin))        (setcar entry 'builtin))
# Line 7809  compares twins on the basis of their fil Line 8359  compares twins on the basis of their fil
8359       ((not (eq type (nth 1 b)))       ((not (eq type (nth 1 b)))
8360        ;; Type decides        ;; Type decides
8361        (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0)))        (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0)))
8362       (t       (t
8363        ;; A and B are twins - so the decision is more complicated.        ;; A and B are twins - so the decision is more complicated.
8364        ;; Call twin-compare with the proper arguments.        ;; Call twin-compare with the proper arguments.
8365        (idlwave-routine-entry-compare-twins a b)))))        (idlwave-routine-entry-compare-twins a b)))))
8366    
8367  (defun idlwave-routine-entry-compare-twins (a b)  (defun idlwave-routine-entry-compare-twins (a b)
8368    "Compare two routine entries, under the assumption that they are twins.    "Compare two routine entries, under the assumption that they are
8369  This basically calles `idlwave-routine-twin-compare' with the correct args."  twins.  This basically calls `idlwave-routine-twin-compare' with the
8370    (let ((name (car a)) (type (nth 1 a)) (class (nth 2 a)) ; needed outside  correct args."
8371          (atype (car (nth 3 a)))    (let* ((name (car a)) (type (nth 1 a)) (class (nth 2 a)) ; needed outside
8372          (btype (car (nth 3 b)))           (asrc (nth 3 a))
8373          (afile (cdr (nth 3 a)))           (atype (car asrc))
8374          (bfile (cdr (nth 3 b))))           (bsrc (nth 3 b))
8375      (if (eq atype 'lib)           (btype (car bsrc))
8376          (setq afile (idlwave-expand-lib-file-name afile)))           (afile (idlwave-routine-source-file asrc))
8377      (if (eq btype 'lib)           (bfile (idlwave-routine-source-file bsrc)))
         (setq bfile (idlwave-expand-lib-file-name bfile)))  
8378      (idlwave-routine-twin-compare      (idlwave-routine-twin-compare
8379       (if (stringp afile)       (if (stringp afile)
8380           (list (file-truename afile) afile (list atype))           (list (file-truename afile) afile (list atype))
# Line 7860  This expects NAME TYPE CLASS to be bound Line 8409  This expects NAME TYPE CLASS to be bound
8409           (bbufp (memq 'buffer btypes))           (bbufp (memq 'buffer btypes))
8410           ;; On search path?           ;; On search path?
8411           (tpath-alist (idlwave-true-path-alist))           (tpath-alist (idlwave-true-path-alist))
8412           (apathp (assoc akey tpath-alist))           (apathp (and (stringp akey)
8413           (bpathp (assoc bkey tpath-alist))                        (assoc (file-name-directory akey) tpath-alist)))
8414             (bpathp (and (stringp bkey)
8415                          (assoc (file-name-directory bkey) tpath-alist)))
8416           ;; How early on search path?  High number means early since we           ;; How early on search path?  High number means early since we
8417           ;; measure the tail of the path list           ;; measure the tail of the path list
8418           (anpath (length (memq apathp tpath-alist)))           (anpath (length (memq apathp tpath-alist)))
# Line 7895  This expects NAME TYPE CLASS to be bound Line 8446  This expects NAME TYPE CLASS to be bound
8446       ((> anpath bnpath)                t)       ; Who is first on path?       ((> anpath bnpath)                t)       ; Who is first on path?
8447       (t                                nil))))  ; Default       (t                                nil))))  ; Default
8448    
8449    (defun idlwave-routine-source-file (source)
8450      (if (nth 2 source)
8451          (expand-file-name (nth 1 source) (nth 2 source))
8452        (nth 1 source)))
8453    
8454  (defun idlwave-downcase-safe (string)  (defun idlwave-downcase-safe (string)
8455    "Donwcase if string, else return unchanged."    "Donwcase if string, else return unchanged."
8456    (if (stringp string)    (if (stringp string)
# Line 7905  This expects NAME TYPE CLASS to be bound Line 8461  This expects NAME TYPE CLASS to be bound
8461    "How often is ELT in LIST?"    "How often is ELT in LIST?"
8462    (length (delq nil (mapcar (lambda (x) (eq x elt)) list))))    (length (delq nil (mapcar (lambda (x) (eq x elt)) list))))
8463    
8464    (defun idlwave-count-memq (elt alist)
8465      "How often is ELT a key in ALIST?"
8466      (length (delq nil (mapcar (lambda (x) (eq (car x) elt)) alist))))
8467    
8468  (defun idlwave-syslib-p (file)  (defun idlwave-syslib-p (file)
8469    "Non-nil of FILE is in the system library."    "Non-nil if FILE is in the system library."
8470    (let* ((true-syslib (file-name-as-directory    (let* ((true-syslib (file-name-as-directory
8471                         (file-truename                         (file-truename
8472                          (expand-file-name "lib" (idlwave-sys-dir)))))                          (expand-file-name "lib" (idlwave-sys-dir)))))
# Line 7918  This expects NAME TYPE CLASS to be bound Line 8478  This expects NAME TYPE CLASS to be bound
8478    (let ((true-dir (file-name-directory (file-truename file))))    (let ((true-dir (file-name-directory (file-truename file))))
8479      (assoc true-dir (idlwave-true-path-alist))))      (assoc true-dir (idlwave-true-path-alist))))
8480    
8481    (defun idlwave-path-alist-add-flag (list-entry flag)
8482      "Add a flag to the path list entry, if not set."
8483      (let ((flags (cdr list-entry)))
8484        (add-to-list 'flags flag)
8485        (setcdr list-entry flags)))
8486    
8487    (defun idlwave-path-alist-remove-flag (list-entry flag)
8488      "Remove a flag to the path list entry, if set."
8489      (let ((flags (delq flag (cdr list-entry))))
8490        (setcdr list-entry flags)))
8491    
8492  (defun idlwave-true-path-alist ()  (defun idlwave-true-path-alist ()
8493    "Return `idlwave-path-alist' alist with true-names.    "Return `idlwave-path-alist' alist with true-names.
8494  Info is cached, but relies on the functons setting `idlwave-path-alist'  Info is cached, but relies on the functions setting `idlwave-path-alist'
8495  to reset the variable `idlwave-true-path-alist' to nil."  to reset the variable `idlwave-true-path-alist' to nil."
8496    (or idlwave-true-path-alist    (or idlwave-true-path-alist
8497        (setq idlwave-true-path-alist        (setq idlwave-true-path-alist
# Line 7966  Assumes that point is at the beginning o Line 8537  Assumes that point is at the beginning o
8537    (forward-sexp 2)    (forward-sexp 2)
8538    (forward-sexp -1)    (forward-sexp -1)
8539    (let ((begin (point)))    (let ((begin (point)))
8540      (re-search-forward "[a-zA-Z][a-zA-Z0-9$_]+\\(::[a-zA-Z][a-zA-Z0-9$_]+\\)?")      (re-search-forward
8541         "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?")
8542      (if (fboundp 'buffer-substring-no-properties)      (if (fboundp 'buffer-substring-no-properties)
8543          (buffer-substring-no-properties begin (point))          (buffer-substring-no-properties begin (point))
8544        (buffer-substring begin (point)))))        (buffer-substring begin (point)))))
# Line 7982  Assumes that point is at the beginning o Line 8554  Assumes that point is at the beginning o
8554                   'imenu)                   'imenu)
8555               (error nil)))))               (error nil)))))
8556    
8557  ;; Here we kack func-menu.el in order to support this new mode.  ;; Here we hack func-menu.el in order to support this new mode.
8558  ;; The latest versions of func-menu.el already have this stuff in, so  ;; The latest versions of func-menu.el already have this stuff in, so
8559  ;; we hack only if it is not already there.  ;; we hack only if it is not already there.
8560  (when (fboundp 'eval-after-load)  (when (fboundp 'eval-after-load)
# Line 8005  Assumes that point is at the beginning o Line 8577  Assumes that point is at the beginning o
8577    (start-process "idldeclient" nil    (start-process "idldeclient" nil
8578                   idlwave-shell-explicit-file-name "-c" "-e"                   idlwave-shell-explicit-file-name "-c" "-e"
8579                   (buffer-file-name) "&"))                   (buffer-file-name) "&"))
8580                    
8581  (defun idlwave-launch-idlhelp ()  (defun idlwave-launch-idlhelp ()
8582    "Start the IDLhelp application."    "Start the IDLhelp application."
8583    (interactive)    (interactive)
8584    (start-process "idlhelp" nil idlwave-help-application))    (start-process "idlhelp" nil idlwave-help-application))
8585    
8586  ;; Menus - using easymenu.el  ;; Menus - using easymenu.el
8587  (defvar idlwave-mode-menu-def  (defvar idlwave-mode-menu-def
8588    `("IDLWAVE"    `("IDLWAVE"
# Line 8065  Assumes that point is at the beginning o Line 8637  Assumes that point is at the beginning o
8637        ["9 Class Name"  idlwave-complete-class t]))        ["9 Class Name"  idlwave-complete-class t]))
8638      ("Routine Info"      ("Routine Info"
8639       ["Show Routine Info" idlwave-routine-info t]       ["Show Routine Info" idlwave-routine-info t]
8640       ["Online Context Help" idlwave-context-help (idlwave-help-directory)]       ["Online Context Help" idlwave-context-help t]
8641       "--"       "--"
8642       ["Find Routine Source" idlwave-find-module t]       ["Find Routine Source" idlwave-find-module t]
8643       ["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)]       ["Resolve Routine" idlwave-resolve (featurep 'idlw-shell)]
8644       "--"       "--"
8645       ["Update Routine Info" idlwave-update-routine-info t]       ["Update Routine Info" idlwave-update-routine-info t]
8646       "--"       "--"
8647       "IDL Library Catalog"       "IDL User Catalog"
8648       ["Select Catalog Directories" (idlwave-create-libinfo-file nil) t]       ["Select Catalog Directories" (idlwave-create-user-catalog-file nil) t]
8649       ["Scan Directories" (idlwave-update-routine-info '(16))       ["Scan Directories" (idlwave-update-routine-info '(16))
8650        (and idlwave-path-alist (not idlwave-catalog-process))]        (and idlwave-path-alist (not idlwave-catalog-process))]
8651       ["Scan Directories &" (idlwave-update-routine-info '(64))       ["Scan Directories &" (idlwave-update-routine-info '(64))
# Line 8097  Assumes that point is at the beginning o Line 8669  Assumes that point is at the beginning o
8669      ("Customize"      ("Customize"
8670       ["Browse IDLWAVE Group" idlwave-customize t]       ["Browse IDLWAVE Group" idlwave-customize t]
8671       "--"       "--"
8672       ["Build Full Customize Menu" idlwave-create-customize-menu       ["Build Full Customize Menu" idlwave-create-customize-menu
8673        (fboundp 'customize-menu-create)])        (fboundp 'customize-menu-create)])
8674      ("Documentation"      ("Documentation"
8675       ["Describe Mode" describe-mode t]       ["Describe Mode" describe-mode t]
# Line 8114  Assumes that point is at the beginning o Line 8686  Assumes that point is at the beginning o
8686    '("Debug"    '("Debug"
8687      ["Start IDL shell" idlwave-shell t]      ["Start IDL shell" idlwave-shell t]
8688      ["Save and .RUN buffer" idlwave-shell-save-and-run      ["Save and .RUN buffer" idlwave-shell-save-and-run
8689       (and (boundp 'idlwave-shell-automatic-start)       (and (boundp 'idlwave-shell-automatic-start)
8690            idlwave-shell-automatic-start)]))            idlwave-shell-automatic-start)]))
8691    
8692  (if (or (featurep 'easymenu) (load "easymenu" t))  (if (or (featurep 'easymenu) (load "easymenu" t))
8693      (progn      (progn
8694        (easy-menu-define idlwave-mode-menu idlwave-mode-map        (easy-menu-define idlwave-mode-menu idlwave-mode-map
8695                          "IDL and WAVE CL editing menu"                          "IDL and WAVE CL editing menu"
8696                          idlwave-mode-menu-def)                          idlwave-mode-menu-def)
8697        (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map        (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
8698                          "IDL and WAVE CL editing menu"                          "IDL and WAVE CL editing menu"
8699                          idlwave-mode-debug-menu-def)))                          idlwave-mode-debug-menu-def)))
8700    
8701  (defun idlwave-customize ()  (defun idlwave-customize ()
8702    "Call the customize function with idlwave as argument."    "Call the customize function with idlwave as argument."
8703    (interactive)    (interactive)
8704    ;; Try to load the code for the shell, so that we can customize it    ;; Try to load the code for the shell, so that we can customize it
8705    ;; as well.    ;; as well.
8706    (or (featurep 'idlw-shell)    (or (featurep 'idlw-shell)
8707        (load "idlw-shell" t))        (load "idlw-shell" t))
# Line 8140  Assumes that point is at the beginning o Line 8712  Assumes that point is at the beginning o
8712    (interactive)    (interactive)
8713    (if (fboundp 'customize-menu-create)    (if (fboundp 'customize-menu-create)
8714        (progn        (progn
8715          ;; Try to load the code for the shell, so that we can customize it          ;; Try to load the code for the shell, so that we can customize it
8716          ;; as well.          ;; as well.
8717          (or (featurep 'idlw-shell)          (or (featurep 'idlw-shell)
8718              (load "idlw-shell" t))              (load "idlw-shell" t))
8719          (easy-menu-change          (easy-menu-change
8720           '("IDLWAVE") "Customize"           '("IDLWAVE") "Customize"
8721           `(["Browse IDLWAVE group" idlwave-customize t]           `(["Browse IDLWAVE group" idlwave-customize t]
8722             "--"             "--"
# Line 8192  This function was written since `list-ab Line 8764  This function was written since `list-ab
8764    (let ((table (symbol-value 'idlwave-mode-abbrev-table))    (let ((table (symbol-value 'idlwave-mode-abbrev-table))
8765          abbrevs          abbrevs
8766          str rpl func fmt (len-str 0) (len-rpl 0))          str rpl func fmt (len-str 0) (len-rpl 0))
8767      (mapatoms      (mapatoms
8768       (lambda (sym)       (lambda (sym)
8769         (if (symbol-value sym)         (if (symbol-value sym)
8770             (progn             (progn
# Line 8218  This function was written since `list-ab Line 8790  This function was written since `list-ab
8790      (with-output-to-temp-buffer "*Help*"      (with-output-to-temp-buffer "*Help*"
8791        (if arg        (if arg
8792            (progn            (progn
8793              (princ "Abbreviations and Actions in IDLWAVE-Mode\n")              (princ "Abbreviations and Actions in IDLWAVE-Mode\n")
8794              (princ "=========================================\n\n")              (princ "=========================================\n\n")
8795              (princ (format fmt "KEY" "REPLACE" "HOOK"))              (princ (format fmt "KEY" "REPLACE" "HOOK"))
8796              (princ (format fmt "---" "-------" "----")))              (princ (format fmt "---" "-------" "----")))
# Line 8241  This function was written since `list-ab Line 8813  This function was written since `list-ab
8813  ;; Add .pro files to speedbar for support, if it's loaded  ;; Add .pro files to speedbar for support, if it's loaded
8814  (eval-after-load "speedbar" '(speedbar-add-supported-extension ".pro"))  (eval-after-load "speedbar" '(speedbar-add-supported-extension ".pro"))
8815    
 ;; Try to load online help, but catch any errors.  
 (condition-case nil  
     (idlwave-require-online-help)  
   (error nil))  
   
8816  ;; Set an idle timer to load the routine info.  ;; Set an idle timer to load the routine info.
8817  ;; Will only work on systems which support this.  ;; Will only work on systems which support this.
8818  (or idlwave-routines (idlwave-start-load-rinfo-timer))  (or idlwave-routines (idlwave-start-load-rinfo-timer))
8819    
8820    ;;;###autoload(add-to-list 'auto-mode-alist '("\\.[Pp][Rr][Oo]\\'" . idlwave-mode))
8821    
8822  ;; Run the hook  ;; Run the hook
8823  (run-hooks 'idlwave-load-hook)  (run-hooks 'idlwave-load-hook)
8824    
8825  (provide 'idlwave)  (provide 'idlwave)
8826    
8827  ;;; arch-tag: f77f3b0c-c37c-424f-a328-0886fd42b6fb  ;; arch-tag: f77f3b0c-c37c-424f-a328-0886fd42b6fb
8828  ;;; idlwave.el ends here  ;;; idlwave.el ends here

Legend:
Removed from v.3.17.2.5  
changed lines
  Added in v.3.17.2.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26