/[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.43 by lektu, Thu Jun 16 14:54:09 2005 UTC revision 3.44 by jdsmith, Mon Jul 4 01:51:23 2005 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, 2003, 2004, 2005  ;; Copyright (c) 1999, 2000, 2001, 2002, 2003, 2004, 2005
3  ;;  Free Software Foundation  ;;    Free Software Foundation
4    
5  ;; Authors: J.D. Smith <jdsmith@as.arizona.edu>  ;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
6  ;;          Carsten Dominik <dominik@science.uva.nl>  ;;          Carsten Dominik <dominik@science.uva.nl>
7  ;;          Chris Chase <chase@att.com>  ;;          Chris Chase <chase@att.com>
8  ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>  ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>
9  ;; Version: 5.5  ;; Version: 5.7_22
10  ;; Keywords: languages  ;; Keywords: languages
11    
12  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 28  Line 28 
28    
29  ;;; Commentary:  ;;; Commentary:
30    
31    ;; IDLWAVE enables feature-rich development and interaction with IDL.
32    
33  ;; In the remotely distant past, based on pascal.el, though bears  ;; In the remotely distant past, based on pascal.el, though bears
34  ;; little resemblance to it now.  ;; little resemblance to it now.
35  ;;  ;;
# Line 70  Line 72 
72  ;; of the documentation is available from the maintainers webpage (see  ;; of the documentation is available from the maintainers webpage (see
73  ;; SOURCE).  ;; SOURCE).
74  ;;  ;;
75  ;;  ;;
76  ;; ACKNOWLEDGMENTS  ;; ACKNOWLEDGMENTS
77  ;; ===============  ;; ===============
78  ;;  ;;
# Line 111  Line 113 
113  ;;   IDLWAVE support for the IDL-derived PV-WAVE CL language of Visual  ;;   IDLWAVE support for the IDL-derived PV-WAVE CL language of Visual
114  ;;   Numerics, Inc. is growing less and less complete as the two  ;;   Numerics, Inc. is growing less and less complete as the two
115  ;;   languages grow increasingly apart.  The mode probably shouldn't  ;;   languages grow increasingly apart.  The mode probably shouldn't
116  ;;   even have "WAVE" in it's title, but it's catchy, and was required  ;;   even have "WAVE" in its title, but it's catchy, and was required
117  ;;   to avoid conflict with the CORBA idl.el mode.  Caveat WAVEor.  ;;   to avoid conflict with the CORBA idl.el mode.  Caveat WAVEor.
118  ;;  ;;
119  ;;   Moving the point backwards in conjunction with abbrev expansion  ;;   Moving the point backwards in conjunction with abbrev expansion
# Line 120  Line 122 
122  ;;   up inserting the character that expanded the abbrev after moving  ;;   up inserting the character that expanded the abbrev after moving
123  ;;   point backward, e.g., "\cl" expanded with a space becomes  ;;   point backward, e.g., "\cl" expanded with a space becomes
124  ;;   "LONG( )" with point before the close paren.  This is solved by  ;;   "LONG( )" with point before the close paren.  This is solved by
125  ;;   using a temporary function in `post-command-hook' - not pretty,  ;;   using a temporary function in `post-command-hook' - not pretty,
126  ;;   but it works.  ;;   but it works.
127  ;;  ;;
128  ;;   Tabs and spaces are treated equally as whitespace when filling a  ;;   Tabs and spaces are treated equally as whitespace when filling a
# Line 159  Line 161 
161  (unless (fboundp 'char-valid-p)  (unless (fboundp 'char-valid-p)
162    (defalias 'char-valid-p 'characterp))    (defalias 'char-valid-p 'characterp))
163    
164    (if (not (fboundp 'cancel-timer))
165        (condition-case nil
166            (require 'timer)
167          (error nil)))
168    
169  (eval-and-compile  (eval-and-compile
170    ;; Kludge to allow `defcustom' for Emacs 19.    ;; Kludge to allow `defcustom' for Emacs 19.
171    (condition-case () (require 'custom) (error nil))    (condition-case () (require 'custom) (error nil))
# Line 166  Line 173 
173        nil ;; We've got what we needed        nil ;; We've got what we needed
174      ;; We have the old or no custom-library, hack around it!      ;; We have the old or no custom-library, hack around it!
175      (defmacro defgroup (&rest args) nil)      (defmacro defgroup (&rest args) nil)
176      (defmacro defcustom (var value doc &rest args)      (defmacro defcustom (var value doc &rest args)
177        `(defvar ,var ,value ,doc))))        `(defvar ,var ,value ,doc))))
178    
179  (defgroup idlwave nil  (defgroup idlwave nil
180    "Major mode for editing IDL .pro files"    "Major mode for editing IDL .pro files"
181    :tag "IDLWAVE"    :tag "IDLWAVE"
182    :link '(url-link :tag "Home Page"    :link '(url-link :tag "Home Page"
183                     "http://idlwave.org")                     "http://idlwave.org")
184    :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el"    :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el"
185                                  "idlw-shell.el")                                  "idlw-shell.el")
# Line 286  extends to the end of the match for the Line 293  extends to the end of the match for the
293    
294  (defcustom idlwave-auto-fill-split-string t  (defcustom idlwave-auto-fill-split-string t
295    "*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.
296  When the line end falls within a string, string concatenation with the  When the line end falls within a string, string concatenation with the
297  '+' operator will be used to distribute a long string over lines.  '+' operator will be used to distribute a long string over lines.  
298  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.
299    
300  This variable is ignored when `idlwave-fill-comment-line-only' is  This variable is ignored when `idlwave-fill-comment-line-only' is
# Line 351  usually a good idea.." Line 358  usually a good idea.."
358  Initializing the routine info can take long, in particular if a large  Initializing the routine info can take long, in particular if a large
359  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
360  of seconds specified by this variable, it starts the initialization.  of seconds specified by this variable, it starts the initialization.
361  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
362  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
363  user input has arrived in the mean time, initialization proceeds immediately  user input has arrived in the mean time, initialization proceeds immediately
364  to the next step.  to the next step.
# Line 403  t         All available Line 410  t         All available
410                 (const :tag "When saving a buffer" save-buffer)                 (const :tag "When saving a buffer" save-buffer)
411                 (const :tag "After a buffer was killed" kill-buffer)                 (const :tag "After a buffer was killed" kill-buffer)
412                 (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))))
413                  
414  (defcustom idlwave-rinfo-max-source-lines 5  (defcustom idlwave-rinfo-max-source-lines 5
415    "*Maximum number of source files displayed in the Routine Info window.    "*Maximum number of source files displayed in the Routine Info window.
416  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 436  value of `!DIR'.  See also `idlwave-libr Line 443  value of `!DIR'.  See also `idlwave-libr
443    :group 'idlwave-routine-info    :group 'idlwave-routine-info
444    :type 'directory)    :type 'directory)
445    
446  (defcustom idlwave-config-directory  (defcustom idlwave-config-directory
447    (convert-standard-filename "~/.idlwave")    (convert-standard-filename "~/.idlwave")
448    "*Directory for configuration files and user-library catalog."    "*Directory for configuration files and user-library catalog."
449    :group 'idlwave-routine-info    :group 'idlwave-routine-info
# Line 451  value of `!DIR'.  See also `idlwave-libr Line 458  value of `!DIR'.  See also `idlwave-libr
458  (defcustom idlwave-special-lib-alist nil  (defcustom idlwave-special-lib-alist nil
459    "Alist of regular expressions matching special library directories.    "Alist of regular expressions matching special library directories.
460  When listing routine source locations, IDLWAVE gives a short hint where  When listing routine source locations, IDLWAVE gives a short hint where
461  the file defining the routine is located.  By default it lists `SystemLib'  the file defining the routine is located.  By default it lists `SystemLib'
462  for routines in the system library `!DIR/lib' and `Library' for anything  for routines in the system library `!DIR/lib' and `Library' for anything
463  else.  This variable can define additional types.  The car of each entry  else.  This variable can define additional types.  The car of each entry
464  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 462  chars are allowed." Line 469  chars are allowed."
469            (cons regexp string)))            (cons regexp string)))
470    
471  (defcustom idlwave-auto-write-paths t  (defcustom idlwave-auto-write-paths t
472    "Write out path (!PATH) and system directory (!DIR) info automatically.    "Write out path (!PATH) and system directory (!DIR) info automatically.  
473  Path info is needed to locate library catalog files.  If non-nil,  Path info is needed to locate library catalog files.  If non-nil,
474  whenever the path-list changes as a result of shell-query, etc., it is  whenever the path-list changes as a result of shell-query, etc., it is
475  written to file.  Otherwise, the menu option \"Write Paths\" can be  written to file.  Otherwise, the menu option \"Write Paths\" can be
# Line 493  used to force a write." Line 500  used to force a write."
500  This variable determines the case (UPPER/lower/Capitalized...) of  This variable determines the case (UPPER/lower/Capitalized...) of
501  words inserted into the buffer by completion.  The preferred case can  words inserted into the buffer by completion.  The preferred case can
502  be specified separately for routine names, keywords, classes and  be specified separately for routine names, keywords, classes and
503  methods.  methods.
504  This alist should therefore have entries for `routine' (normal  This alist should therefore have entries for `routine' (normal
505  functions and procedures, i.e. non-methods), `keyword', `class', and  functions and procedures, i.e. non-methods), `keyword', `class', and
506  `method'.  Plausible values are  `method'.  Plausible values are
# Line 580  certain methods this assumption is almos Line 587  certain methods this assumption is almos
587  for which to assume this can be set here."  for which to assume this can be set here."
588    :group 'idlwave-routine-info    :group 'idlwave-routine-info
589    :type '(repeat (regexp :tag "Match method:")))    :type '(repeat (regexp :tag "Match method:")))
590      
591    
592  (defcustom idlwave-completion-show-classes 1  (defcustom idlwave-completion-show-classes 1
593    "*Number of classes to show when completing object methods and keywords.    "*Number of classes to show when completing object methods and keywords.
# Line 645  should contain at least two elements: (m Line 652  should contain at least two elements: (m
652  specify if the class should be found during method and keyword  specify if the class should be found during method and keyword
653  completion, respectively.  completion, respectively.
654    
655  The alist may have additional entries specifying exceptions from the  The alist may have additional entries specifying exceptions from the
656  keyword completion rule for specific methods, like INIT or  keyword completion rule for specific methods, like INIT or
657  GETPROPERTY.  In order to turn on class specification for the INIT  GETPROPERTY.  In order to turn on class specification for the INIT
658  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 669  particular object method call.  This hap Line 676  particular object method call.  This hap
676  value of the variable `idlwave-query-class'.  value of the variable `idlwave-query-class'.
677    
678  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
679  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
680  editing session, IDLWAVE will not have to ask again.  When this  editing session, IDLWAVE will not have to ask again.  When this
681  variable is non-nil, IDLWAVE will store and reuse the class information.  variable is non-nil, IDLWAVE will store and reuse the class information.
682  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 1049  IDL process is made." Line 1056  IDL process is made."
1056    :group 'idlwave-misc    :group 'idlwave-misc
1057    :type 'boolean)    :type 'boolean)
1058    
1059  (defcustom idlwave-default-font-lock-items  (defcustom idlwave-default-font-lock-items
1060    '(pros-and-functions batch-files idlwave-idl-keywords label goto    '(pros-and-functions batch-files idlwave-idl-keywords label goto
1061                         common-blocks class-arrows)                         common-blocks class-arrows)
1062    "Items which should be fontified on the default fontification level 2.    "Items which should be fontified on the default fontification level 2.
# Line 1111  As a user, you should not set this to t. Line 1118  As a user, you should not set this to t.
1118  ;;; and Carsten Dominik...  ;;; and Carsten Dominik...
1119    
1120  ;; The following are the reserved words in IDL.  Maybe we should  ;; The following are the reserved words in IDL.  Maybe we should
1121  ;; highlight some more stuff as well?  ;; highlight some more stuff as well?      
1122  ;; Procedure declarations.  Fontify keyword plus procedure name.  ;; Procedure declarations.  Fontify keyword plus procedure name.
1123  (defvar idlwave-idl-keywords  (defvar idlwave-idl-keywords
1124    ;; To update this regexp, update the list of keywords and    ;; To update this regexp, update the list of keywords and
1125    ;; evaluate the form.    ;; evaluate the form.
1126    ;;    (insert    ;;    (insert
1127    ;;     (prin1-to-string    ;;     (prin1-to-string
1128    ;;      (concat    ;;      (concat
1129    ;;       "\\<\\("    ;;       "\\<\\("
1130    ;;       (regexp-opt    ;;       (regexp-opt
1131    ;;        '("||" "&&" "and" "or" "xor" "not"    ;;        '("||" "&&" "and" "or" "xor" "not"
1132    ;;          "eq" "ge" "gt" "le" "lt" "ne"    ;;          "eq" "ge" "gt" "le" "lt" "ne"
1133    ;;          "for" "do" "endfor"    ;;          "for" "do" "endfor"
1134    ;;          "if" "then" "endif" "else" "endelse"    ;;          "if" "then" "endif" "else" "endelse"
1135    ;;          "case" "of" "endcase"    ;;          "case" "of" "endcase"
1136    ;;          "switch" "break" "continue" "endswitch"    ;;          "switch" "break" "continue" "endswitch"
1137    ;;          "begin" "end"    ;;          "begin" "end"
1138    ;;          "repeat" "until" "endrep"    ;;          "repeat" "until" "endrep"
1139    ;;          "while" "endwhile"    ;;          "while" "endwhile"
1140    ;;          "goto" "return"    ;;          "goto" "return"
1141    ;;          "inherits" "mod"    ;;          "inherits" "mod"
1142    ;;          "compile_opt" "forward_function"    ;;          "compile_opt" "forward_function"
# Line 1152  As a user, you should not set this to t. Line 1159  As a user, you should not set this to t.
1159            (2 font-lock-reference-face nil t)      ; block name            (2 font-lock-reference-face nil t)      ; block name
1160            (font-lock-match-c++-style-declaration-item-and-skip-to-next            (font-lock-match-c++-style-declaration-item-and-skip-to-next
1161             ;; Start with point after block name and comma             ;; Start with point after block name and comma
1162             (goto-char (match-end 0))  ; needed for XEmacs, could be nil             (goto-char (match-end 0))  ; needed for XEmacs, could be nil
1163             nil             nil
1164             (1 font-lock-variable-name-face)       ; variable names             (1 font-lock-variable-name-face)       ; variable names
1165             )))             )))
# Line 1207  As a user, you should not set this to t. Line 1214  As a user, you should not set this to t.
1214         ;; All operators (not used because too noisy)         ;; All operators (not used because too noisy)
1215         (all-operators         (all-operators
1216          '("[-*^#+<>/]" (0 font-lock-keyword-face)))          '("[-*^#+<>/]" (0 font-lock-keyword-face)))
1217            
1218         ;; Arrows with text property `idlwave-class'         ;; Arrows with text property `idlwave-class'
1219         (class-arrows         (class-arrows
1220          '(idlwave-match-class-arrows (0 idlwave-class-arrow-face))))          '(idlwave-match-class-arrows (0 idlwave-class-arrow-face))))
# Line 1244  As a user, you should not set this to t. Line 1251  As a user, you should not set this to t.
1251    
1252  (defvar idlwave-font-lock-defaults  (defvar idlwave-font-lock-defaults
1253    '((idlwave-font-lock-keywords    '((idlwave-font-lock-keywords
1254       idlwave-font-lock-keywords-1       idlwave-font-lock-keywords-1
1255       idlwave-font-lock-keywords-2       idlwave-font-lock-keywords-2
1256       idlwave-font-lock-keywords-3)       idlwave-font-lock-keywords-3)
1257      nil t      nil t
1258      ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w"))      ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w"))
1259      beginning-of-line))      beginning-of-line))
1260    
1261  (put 'idlwave-mode 'font-lock-defaults  (put 'idlwave-mode 'font-lock-defaults
1262       idlwave-font-lock-defaults) ; XEmacs       idlwave-font-lock-defaults) ; XEmacs
1263    
1264  (defconst idlwave-comment-line-start-skip "^[ \t]*;"  (defconst idlwave-comment-line-start-skip "^[ \t]*;"
# Line 1259  As a user, you should not set this to t. Line 1266  As a user, you should not set this to t.
1266  That is the _beginning_ of a line containing a comment delimiter `;' preceded  That is the _beginning_ of a line containing a comment delimiter `;' preceded
1267  only by whitespace.")  only by whitespace.")
1268    
1269  (defconst idlwave-begin-block-reg  (defconst idlwave-begin-block-reg
1270    "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>"    "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>"
1271    "Regular expression to find the beginning of a block. The case does    "Regular expression to find the beginning of a block. The case does
1272  not matter. The search skips matches in comments.")  not matter. The search skips matches in comments.")
# Line 1336  blocks starting with a BEGIN statement. Line 1343  blocks starting with a BEGIN statement.
1343     '(goto . ("goto\\>" nil))     '(goto . ("goto\\>" nil))
1344     '(case . ("case\\>" nil))     '(case . ("case\\>" nil))
1345     '(switch . ("switch\\>" nil))     '(switch . ("switch\\>" nil))
1346     (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *"     (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *"
1347                               "\\(" idlwave-method-call "\\s *\\)?"                               "\\(" idlwave-method-call "\\s *\\)?"
1348                               idlwave-identifier                               idlwave-identifier
1349                               "\\s *(") nil))                               "\\s *(") nil))
1350     (cons 'call (list (concat     (cons 'call (list (concat
1351                        "\\(" idlwave-method-call "\\s *\\)?"                        "\\(" idlwave-method-call "\\s *\\)?"
1352                        idlwave-identifier                        idlwave-identifier
1353                        "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil))                        "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil))
1354     (cons 'assign (list (concat     (cons 'assign (list (concat
1355                          "\\(" idlwave-variable "\\) *=") nil)))                          "\\(" idlwave-variable "\\) *=") nil)))
1356      
1357    "Associated list of statement matching regular expressions.    "Associated list of statement matching regular expressions.
1358  Each regular expression matches the start of an IDL statement.  The  Each regular expression matches the start of an IDL statement.  The
1359  first element of each association is a symbol giving the statement  first element of each association is a symbol giving the statement
# Line 1369  the leftover unidentified statements con Line 1376  the leftover unidentified statements con
1376  ;; 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
1377  ;; of length one rather than a single character.  ;; of length one rather than a single character.
1378  ;; The code in this file accepts either format for compatibility.  ;; The code in this file accepts either format for compatibility.
1379  (defvar idlwave-comment-indent-char ?\  (defvar idlwave-comment-indent-char ?\
1380    "Character to be inserted for IDL comment indentation.    "Character to be inserted for IDL comment indentation.
1381  Normally a space.")  Normally a space.")
1382    
# Line 1377  Normally a space.") Line 1384  Normally a space.")
1384    "Character which is inserted as a last character on previous line by    "Character which is inserted as a last character on previous line by
1385     \\[idlwave-split-line] to begin a continuation line.  Normally $.")     \\[idlwave-split-line] to begin a continuation line.  Normally $.")
1386    
1387  (defconst idlwave-mode-version "5.5")  (defconst idlwave-mode-version "5.7_22")
1388    
1389  (defmacro idlwave-keyword-abbrev (&rest args)  (defmacro idlwave-keyword-abbrev (&rest args)
1390    "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 1484  Capitalize system variables - action onl Line 1491  Capitalize system variables - action onl
1491        ;; Add action        ;; Add action
1492        (let* ((table (if select 'idlwave-indent-action-table        (let* ((table (if select 'idlwave-indent-action-table
1493                        'idlwave-indent-expand-table))                        'idlwave-indent-expand-table))
1494               (cell (assoc key (eval table))))               (table-key (regexp-quote key))
1495                 (cell (assoc table-key (eval table))))
1496          (if cell          (if cell
1497              ;; Replace action command              ;; Replace action command
1498              (setcdr cell cmd)              (setcdr cell cmd)
1499            ;; New action            ;; New action
1500            (set table (append (eval table) (list (cons key cmd)))))))            (set table (append (eval table) (list (cons table-key cmd)))))))
1501    ;; Make key binding for action    ;; Make key binding for action
1502    (if (or (and (null select) (= (length key) 1))    (if (or (and (null select) (= (length key) 1))
1503            (equal select 'noaction)            (equal select 'noaction)
# Line 1516  Capitalize system variables - action onl Line 1524  Capitalize system variables - action onl
1524  (define-key idlwave-mode-map "\C-c{"    'idlwave-beginning-of-block)  (define-key idlwave-mode-map "\C-c{"    'idlwave-beginning-of-block)
1525  (define-key idlwave-mode-map "\C-c}"    'idlwave-end-of-block)  (define-key idlwave-mode-map "\C-c}"    'idlwave-end-of-block)
1526  (define-key idlwave-mode-map "\C-c]"    'idlwave-close-block)  (define-key idlwave-mode-map "\C-c]"    'idlwave-close-block)
1527  (define-key idlwave-mode-map "\M-\C-h"  'idlwave-mark-subprogram)  (define-key idlwave-mode-map [(meta control h)] 'idlwave-mark-subprogram)
1528  (define-key idlwave-mode-map "\M-\C-n"  'idlwave-forward-block)  (define-key idlwave-mode-map "\M-\C-n"  'idlwave-forward-block)
1529  (define-key idlwave-mode-map "\M-\C-p"  'idlwave-backward-block)  (define-key idlwave-mode-map "\M-\C-p"  'idlwave-backward-block)
1530  (define-key idlwave-mode-map "\M-\C-d"  'idlwave-down-block)  (define-key idlwave-mode-map "\M-\C-d"  'idlwave-down-block)
# Line 1540  Capitalize system variables - action onl Line 1548  Capitalize system variables - action onl
1548           (not (equal idlwave-shell-debug-modifiers '())))           (not (equal idlwave-shell-debug-modifiers '())))
1549    ;; Bind the debug commands also with the special modifiers.    ;; Bind the debug commands also with the special modifiers.
1550    (let ((shift (memq 'shift idlwave-shell-debug-modifiers))    (let ((shift (memq 'shift idlwave-shell-debug-modifiers))
1551          (mods-noshift (delq 'shift          (mods-noshift (delq 'shift
1552                              (copy-sequence idlwave-shell-debug-modifiers))))                              (copy-sequence idlwave-shell-debug-modifiers))))
1553      (define-key idlwave-mode-map      (define-key idlwave-mode-map
1554        (vector (append mods-noshift (list (if shift ?C ?c))))        (vector (append mods-noshift (list (if shift ?C ?c))))
1555        'idlwave-shell-save-and-run)        'idlwave-shell-save-and-run)
1556      (define-key idlwave-mode-map      (define-key idlwave-mode-map
1557        (vector (append mods-noshift (list (if shift ?B ?b))))        (vector (append mods-noshift (list (if shift ?B ?b))))
1558        'idlwave-shell-break-here)        'idlwave-shell-break-here)
1559      (define-key idlwave-mode-map      (define-key idlwave-mode-map
1560        (vector (append mods-noshift (list (if shift ?E ?e))))        (vector (append mods-noshift (list (if shift ?E ?e))))
1561        'idlwave-shell-run-region)))        'idlwave-shell-run-region)))
1562  (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-c" 'idlwave-shell-save-and-run)
# Line 1575  Capitalize system variables - action onl Line 1583  Capitalize system variables - action onl
1583  (autoload 'idlwave-shell-run-region "idlw-shell"  (autoload 'idlwave-shell-run-region "idlw-shell"
1584    "Compile and run the region." t)    "Compile and run the region." t)
1585  (define-key idlwave-mode-map "\C-c\C-v"   'idlwave-find-module)  (define-key idlwave-mode-map "\C-c\C-v"   'idlwave-find-module)
1586    (define-key idlwave-mode-map "\C-c\C-t"   'idlwave-find-module-this-file)
1587  (define-key idlwave-mode-map "\C-c?"      'idlwave-routine-info)  (define-key idlwave-mode-map "\C-c?"      'idlwave-routine-info)
1588  (define-key idlwave-mode-map "\M-?"       'idlwave-context-help)  (define-key idlwave-mode-map "\M-?"       'idlwave-context-help)
1589  (define-key idlwave-mode-map [(control meta ?\?)] 'idlwave-online-help)  (define-key idlwave-mode-map [(control meta ?\?)] 'idlwave-online-help)
# Line 1584  Capitalize system variables - action onl Line 1593  Capitalize system variables - action onl
1593  (define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete)  (define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete)
1594  (define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info)  (define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info)
1595  (define-key idlwave-mode-map "\C-c="    'idlwave-resolve)  (define-key idlwave-mode-map "\C-c="    'idlwave-resolve)
1596  (define-key idlwave-mode-map  (define-key idlwave-mode-map
1597    (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])    (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])
1598    'idlwave-mouse-context-help)    'idlwave-mouse-context-help)
1599    
# Line 1595  Capitalize system variables - action onl Line 1604  Capitalize system variables - action onl
1604  ;                                                   (lambda (char) 0)))  ;                                                   (lambda (char) 0)))
1605  (idlwave-action-and-binding "<"  '(idlwave-surround -1 -1))  (idlwave-action-and-binding "<"  '(idlwave-surround -1 -1))
1606  ;; Binding works for both > and ->, by changing the length of the token.  ;; Binding works for both > and ->, by changing the length of the token.
1607  (idlwave-action-and-binding ">"  '(idlwave-surround -1 -1 '(?-) 1  (idlwave-action-and-binding ">"  '(idlwave-surround -1 -1 '(?-) 1
1608                                                      'idlwave-gtr-pad-hook))                                                      'idlwave-gtr-pad-hook))
1609  (idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t)  (idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t)
1610  (idlwave-action-and-binding ","  '(idlwave-surround 0 -1))  (idlwave-action-and-binding ","  '(idlwave-surround 0 -1))
# Line 1629  idlwave-mode-abbrev-table unless TABLE i Line 1638  idlwave-mode-abbrev-table unless TABLE i
1638        (error (apply 'define-abbrev args)))))        (error (apply 'define-abbrev args)))))
1639    
1640  (condition-case nil  (condition-case nil
1641      (modify-syntax-entry (string-to-char idlwave-abbrev-start-char)      (modify-syntax-entry (string-to-char idlwave-abbrev-start-char)
1642                           "w" idlwave-mode-syntax-table)                           "w" idlwave-mode-syntax-table)
1643    (error nil))    (error nil))
1644    
# Line 1702  idlwave-mode-abbrev-table unless TABLE i Line 1711  idlwave-mode-abbrev-table unless TABLE i
1711  (idlwave-define-abbrev "s"  "size()"       (idlwave-keyword-abbrev 1))  (idlwave-define-abbrev "s"  "size()"       (idlwave-keyword-abbrev 1))
1712  (idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1))  (idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1))
1713  (idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0))  (idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0))
1714    (idlwave-define-abbrev "pv" "ptr_valid()" (idlwave-keyword-abbrev 1))
1715    (idlwave-define-abbrev "ipv" "if ptr_valid() then" (idlwave-keyword-abbrev 6))
1716    
1717  ;; This section is reserved words only. (From IDL user manual)  ;; This section is reserved words only. (From IDL user manual)
1718  ;;  ;;
# Line 1751  idlwave-mode-abbrev-table unless TABLE i Line 1762  idlwave-mode-abbrev-table unless TABLE i
1762  (defvar imenu-extract-index-name-function)  (defvar imenu-extract-index-name-function)
1763  (defvar imenu-prev-index-position-function)  (defvar imenu-prev-index-position-function)
1764  ;; defined later - so just make the compiler hush  ;; defined later - so just make the compiler hush
1765  (defvar idlwave-mode-menu)  (defvar idlwave-mode-menu)  
1766  (defvar idlwave-mode-debug-menu)  (defvar idlwave-mode-debug-menu)
1767    
1768  ;;;###autoload  ;;;###autoload
1769  (defun idlwave-mode ()  (defun idlwave-mode ()
1770    "Major mode for editing IDL source files (version 5.5).    "Major mode for editing IDL source files (version 5.7_22).
1771    
1772  The main features of this mode are  The main features of this mode are
1773    
# Line 1836  The main features of this mode are Line 1847  The main features of this mode are
1847     \\i         IF statement template     \\i         IF statement template
1848     \\elif      IF-ELSE statement template     \\elif      IF-ELSE statement template
1849     \\b         BEGIN     \\b         BEGIN
1850      
1851     For a full list, use \\[idlwave-list-abbrevs].  Some templates also     For a full list, use \\[idlwave-list-abbrevs].  Some templates also
1852     have direct keybindings - see the list of keybindings below.     have direct keybindings - see the list of keybindings below.
1853    
# Line 1878  The main features of this mode are Line 1889  The main features of this mode are
1889    
1890    (interactive)    (interactive)
1891    (kill-all-local-variables)    (kill-all-local-variables)
1892      
1893    (if idlwave-startup-message    (if idlwave-startup-message
1894        (message "Emacs IDLWAVE mode version %s." idlwave-mode-version))        (message "Emacs IDLWAVE mode version %s." idlwave-mode-version))
1895    (setq idlwave-startup-message nil)    (setq idlwave-startup-message nil)
1896      
1897    (setq local-abbrev-table idlwave-mode-abbrev-table)    (setq local-abbrev-table idlwave-mode-abbrev-table)
1898    (set-syntax-table idlwave-mode-syntax-table)    (set-syntax-table idlwave-mode-syntax-table)
1899      
1900    (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action)    (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action)
1901      
1902    (make-local-variable idlwave-comment-indent-function)    (make-local-variable idlwave-comment-indent-function)
1903    (set idlwave-comment-indent-function 'idlwave-comment-hook)    (set idlwave-comment-indent-function 'idlwave-comment-hook)
1904      
1905    (set (make-local-variable 'comment-start-skip) ";+[ \t]*")    (set (make-local-variable 'comment-start-skip) ";+[ \t]*")
1906    (set (make-local-variable 'comment-start) ";")    (set (make-local-variable 'comment-start) ";")
1907    (set (make-local-variable 'require-final-newline) mode-require-final-newline)    (set (make-local-variable 'require-final-newline) mode-require-final-newline)
1908    (set (make-local-variable 'abbrev-all-caps) t)    (set (make-local-variable 'abbrev-all-caps) t)
1909    (set (make-local-variable 'indent-tabs-mode) nil)    (set (make-local-variable 'indent-tabs-mode) nil)
1910    (set (make-local-variable 'completion-ignore-case) t)    (set (make-local-variable 'completion-ignore-case) t)
1911      
1912    (use-local-map idlwave-mode-map)    (use-local-map idlwave-mode-map)
1913    
1914    (when (featurep 'easymenu)    (when (featurep 'easymenu)
# Line 1907  The main features of this mode are Line 1918  The main features of this mode are
1918    (setq mode-name "IDLWAVE")    (setq mode-name "IDLWAVE")
1919    (setq major-mode 'idlwave-mode)    (setq major-mode 'idlwave-mode)
1920    (setq abbrev-mode t)    (setq abbrev-mode t)
1921      
1922    (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill)    (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill)
1923    (setq comment-end "")    (setq comment-end "")
1924    (set (make-local-variable 'comment-multi-line) nil)    (set (make-local-variable 'comment-multi-line) nil)
1925    (set (make-local-variable 'paragraph-separate)    (set (make-local-variable 'paragraph-separate)
1926         "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$")         "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$")
1927    (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]")    (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]")
1928    (set (make-local-variable 'paragraph-ignore-fill-prefix) nil)    (set (make-local-variable 'paragraph-ignore-fill-prefix) nil)
# Line 1920  The main features of this mode are Line 1931  The main features of this mode are
1931    ;; Set tag table list to use IDLTAGS as file name.    ;; Set tag table list to use IDLTAGS as file name.
1932    (if (boundp 'tag-table-alist)    (if (boundp 'tag-table-alist)
1933        (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS")))        (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS")))
1934      
1935    ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow    ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow
1936    ;; Following line is for Emacs - XEmacs uses the corresponding property    ;; Following line is for Emacs - XEmacs uses the corresponding property
1937    ;; on the `idlwave-mode' symbol.    ;; on the `idlwave-mode' symbol.
# Line 1935  The main features of this mode are Line 1946  The main features of this mode are
1946         'idlwave-prev-index-position)         'idlwave-prev-index-position)
1947    
1948    ;; Make a local post-command-hook and add our hook to it    ;; Make a local post-command-hook and add our hook to it
   ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility  
   (make-local-hook 'post-command-hook)  
1949    (add-hook 'post-command-hook 'idlwave-command-hook nil 'local)    (add-hook 'post-command-hook 'idlwave-command-hook nil 'local)
1950    
1951    ;; Make local hooks for buffer updates    ;; Make local hooks for buffer updates
   ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility  
   (make-local-hook 'kill-buffer-hook)  
1952    (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local)    (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local)
   (make-local-hook 'after-save-hook)  
1953    (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local)    (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local)
1954    (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local)    (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local)
1955    
# Line 1961  The main features of this mode are Line 1967  The main features of this mode are
1967    (unless idlwave-setup-done    (unless idlwave-setup-done
1968      (if (not (file-directory-p idlwave-config-directory))      (if (not (file-directory-p idlwave-config-directory))
1969          (make-directory idlwave-config-directory))          (make-directory idlwave-config-directory))
1970      (setq idlwave-user-catalog-file (expand-file-name      (setq idlwave-user-catalog-file (expand-file-name
1971                                       idlwave-user-catalog-file                                       idlwave-user-catalog-file
1972                                       idlwave-config-directory)                                       idlwave-config-directory)
1973          idlwave-path-file (expand-file-name          idlwave-path-file (expand-file-name
1974                             idlwave-path-file                             idlwave-path-file
1975                             idlwave-config-directory))                             idlwave-config-directory))
1976      (idlwave-read-paths)  ; we may need these early      (idlwave-read-paths)  ; we may need these early
1977      (setq idlwave-setup-done t)))      (setq idlwave-setup-done t)))
1978    
1979  ;;  ;;
1980  ;; Code Formatting ----------------------------------------------------  ;; Code Formatting ----------------------------------------------------
1981  ;;  ;;
1982    
1983  (defun idlwave-push-mark (&rest rest)  (defun idlwave-push-mark (&rest rest)
1984    "Push mark for compatibility with Emacs 18/19."    "Push mark for compatibility with Emacs 18/19."
# Line 2121  Also checks if the correct end statement Line 2127  Also checks if the correct end statement
2127          (if (> end-pos eol-pos)          (if (> end-pos eol-pos)
2128              (setq end-pos pos))              (setq end-pos pos))
2129          (goto-char end-pos)          (goto-char end-pos)
2130          (setq end (buffer-substring          (setq end (buffer-substring
2131                     (progn                     (progn
2132                       (skip-chars-backward "a-zA-Z")                       (skip-chars-backward "a-zA-Z")
2133                       (point))                       (point))
# Line 2143  Also checks if the correct end statement Line 2149  Also checks if the correct end statement
2149              (sit-for 1))              (sit-for 1))
2150             (t             (t
2151              (beep)              (beep)
2152              (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?"              (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?"
2153                       end1 end)                       end1 end)
2154              (sit-for 1))))))))              (sit-for 1))))))))
2155    ;;(delete-char 1))    ;;(delete-char 1))
# Line 2155  Also checks if the correct end statement Line 2161  Also checks if the correct end statement
2161         ((looking-at "pro\\|case\\|switch\\|function\\>")         ((looking-at "pro\\|case\\|switch\\|function\\>")
2162          (assoc (downcase (match-string 0)) idlwave-block-matches))          (assoc (downcase (match-string 0)) idlwave-block-matches))
2163         ((looking-at "begin\\>")         ((looking-at "begin\\>")
2164          (let ((limit (save-excursion          (let ((limit (save-excursion
2165                         (idlwave-beginning-of-statement)                         (idlwave-beginning-of-statement)
2166                         (point))))                         (point))))
2167            (cond            (cond
2168             ((re-search-backward ":[ \t]*\\=" limit t)             ((re-search-backward ":[ \t]*\\=" limit t)
# Line 2184  Also checks if the correct end statement Line 2190  Also checks if the correct end statement
2190      (insert "end")      (insert "end")
2191      (idlwave-show-begin)))      (idlwave-show-begin)))
2192    
2193  (defun idlwave-gtr-pad-hook (char)  (defun idlwave-gtr-pad-hook (char)
2194    "Let the > symbol expand around -> if present.  The new token length    "Let the > symbol expand around -> if present.  The new token length
2195  is returned."  is returned."  
2196    2)    2)
2197    
2198  (defun idlwave-surround (&optional before after escape-chars length ec-hook)  (defun idlwave-surround (&optional before after escape-chars length ec-hook)
# Line 2216  return value." Line 2222  return value."
2222      (let* ((length (or length 1)) ; establish a default for LENGTH      (let* ((length (or length 1)) ; establish a default for LENGTH
2223             (prev-char (char-after (- (point) (1+ length)))))             (prev-char (char-after (- (point) (1+ length)))))
2224        (when (or (not (memq prev-char escape-chars))        (when (or (not (memq prev-char escape-chars))
2225                  (and (fboundp ec-hook)                  (and (fboundp ec-hook)
2226                       (setq length                       (setq length
2227                             (save-excursion (funcall ec-hook prev-char)))))                             (save-excursion (funcall ec-hook prev-char)))))
2228          (backward-char length)          (backward-char length)
2229          (save-restriction          (save-restriction
# Line 2439  Returns non-nil if successfull." Line 2445  Returns non-nil if successfull."
2445          (let ((eos (save-excursion          (let ((eos (save-excursion
2446                       (idlwave-block-jump-out -1 'nomark)                       (idlwave-block-jump-out -1 'nomark)
2447                       (point))))                       (point))))
2448            (if (setq status (idlwave-find-key            (if (setq status (idlwave-find-key
2449                              idlwave-end-block-reg -1 'nomark eos))                              idlwave-end-block-reg -1 'nomark eos))
2450                (idlwave-beginning-of-statement)                (idlwave-beginning-of-statement)
2451              (message "No nested block before beginning of containing block.")))              (message "No nested block before beginning of containing block.")))
# Line 2447  Returns non-nil if successfull." Line 2453  Returns non-nil if successfull."
2453        (let ((eos (save-excursion        (let ((eos (save-excursion
2454                     (idlwave-block-jump-out 1 'nomark)                     (idlwave-block-jump-out 1 'nomark)
2455                     (point))))                     (point))))
2456          (if (setq status (idlwave-find-key          (if (setq status (idlwave-find-key
2457                            idlwave-begin-block-reg 1 'nomark eos))                            idlwave-begin-block-reg 1 'nomark eos))
2458              (idlwave-end-of-statement)              (idlwave-end-of-statement)
2459            (message "No nested block before end of containing block."))))            (message "No nested block before end of containing block."))))
# Line 2461  The marks are pushed." Line 2467  The marks are pushed."
2467          (here (point)))          (here (point)))
2468      (goto-char (point-max))      (goto-char (point-max))
2469      (if (re-search-backward idlwave-doclib-start nil t)      (if (re-search-backward idlwave-doclib-start nil t)
2470          (progn          (progn
2471            (setq beg (progn (beginning-of-line) (point)))            (setq beg (progn (beginning-of-line) (point)))
2472            (if (re-search-forward idlwave-doclib-end nil t)            (if (re-search-forward idlwave-doclib-end nil t)
2473                (progn                (progn
# Line 2495  actual statement." Line 2501  actual statement."
2501     ((eq major-mode 'idlwave-shell-mode)     ((eq major-mode 'idlwave-shell-mode)
2502      (if (re-search-backward idlwave-shell-prompt-pattern nil t)      (if (re-search-backward idlwave-shell-prompt-pattern nil t)
2503          (goto-char (match-end 0))))          (goto-char (match-end 0))))
2504     (t     (t  
2505      (if (save-excursion (forward-line -1) (idlwave-is-continuation-line))      (if (save-excursion (forward-line -1) (idlwave-is-continuation-line))
2506          (idlwave-previous-statement)          (idlwave-previous-statement)
2507        (beginning-of-line)))))        (beginning-of-line)))))
# Line 2572  If not in a statement just moves to end Line 2578  If not in a statement just moves to end
2578    (let ((save-point (point)))    (let ((save-point (point)))
2579      (when (re-search-forward ".*&" lim t)      (when (re-search-forward ".*&" lim t)
2580        (goto-char (match-end 0))        (goto-char (match-end 0))
2581        (if (idlwave-quoted)        (if (idlwave-quoted)
2582            (goto-char save-point)            (goto-char save-point)
2583          (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point))))          (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point))))
2584      (point)))      (point)))
# Line 2589  If there is no label point is not moved Line 2595  If there is no label point is not moved
2595    ;; - not in parenthesis (like a[0:3])    ;; - not in parenthesis (like a[0:3])
2596    ;; - not followed by another ":" in explicit class, ala a->b::c    ;; - not followed by another ":" in explicit class, ala a->b::c
2597    ;; 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
2598    ;; parser.    ;; parser.
2599    (let* ((start (point))    (let* ((start (point))
2600           (eos (save-excursion (idlwave-end-of-statement) (point)))           (eos (save-excursion (idlwave-end-of-statement) (point)))
2601           (end (idlwave-find-key ":" 1 'nomark eos)))           (end (idlwave-find-key ":" 1 'nomark eos)))
# Line 2666  equal sign will be surrounded by BEFORE Line 2672  equal sign will be surrounded by BEFORE
2672  `idlwave-pad-keyword' is t then keyword assignment is treated just  `idlwave-pad-keyword' is t then keyword assignment is treated just
2673  like assignment statements.  When nil, spaces are removed for keyword  like assignment statements.  When nil, spaces are removed for keyword
2674  assignment.  Any other value keeps the current space around the `='.  assignment.  Any other value keeps the current space around the `='.
2675  Limits in for loops are treated as keyword assignment.  Limits in for loops are treated as keyword assignment.  
2676    
2677  Starting with IDL 6.0, a number of op= assignments are available.  Starting with IDL 6.0, a number of op= assignments are available.
2678  Since ambiguities of the form:  Since ambiguities of the form:
# Line 2681  operators, such as ##=, ^=, etc., will b Line 2687  operators, such as ##=, ^=, etc., will b
2687    
2688  See `idlwave-surround'."  See `idlwave-surround'."
2689    (if idlwave-surround-by-blank    (if idlwave-surround-by-blank
2690        (let        (let
2691            ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=")            ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=")
2692             (an-ops             (an-ops
2693              "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=")              "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=")
2694             (len 1))             (len 1))
2695            
2696          (save-excursion          (save-excursion
2697            (let ((case-fold-search t))            (let ((case-fold-search t))
2698              (backward-char)              (backward-char)
2699              (if (or              (if (or
2700                   (re-search-backward non-an-ops nil t)                   (re-search-backward non-an-ops nil t)
2701                   ;; Why doesn't ##? work for both?                   ;; Why doesn't ##? work for both?
2702                   (re-search-backward "\\(#\\)\\=" nil t))                   (re-search-backward "\\(#\\)\\=" nil t))
2703                  (setq len (1+ (length (match-string 1))))                  (setq len (1+ (length (match-string 1))))
2704                (when (re-search-backward an-ops nil t)                (when (re-search-backward an-ops nil t)
2705                  (setq begin nil) ; won't modify begin                  ;(setq begin nil) ; won't modify begin
2706                  (setq len (1+ (length (match-string 1))))))))                  (setq len (1+ (length (match-string 1))))))))
2707            
2708          (if (eq t idlwave-pad-keyword)          (if (eq t idlwave-pad-keyword)  
2709              ;; Everything gets padded equally              ;; Everything gets padded equally
2710              (idlwave-surround before after nil len)              (idlwave-surround before after nil len)
2711            ;; Treating keywords/for variables specially...            ;; Treating keywords/for variables specially...
# Line 2710  See `idlwave-surround'." Line 2716  See `idlwave-surround'."
2716                          (skip-chars-backward "= \t")                          (skip-chars-backward "= \t")
2717                          (nth 2 (idlwave-where)))))                          (nth 2 (idlwave-where)))))
2718              (cond ((or (memq what '(function-keyword procedure-keyword))              (cond ((or (memq what '(function-keyword procedure-keyword))
2719                         (memq (caar st) '(for pdef)))                         (memq (caar st) '(for pdef)))
2720                     (cond                     (cond
2721                      ((null idlwave-pad-keyword)                      ((null idlwave-pad-keyword)
2722                       (idlwave-surround 0 0)                       (idlwave-surround 0 0)
2723                       ) ; remove space                       ) ; remove space
2724                      (t))) ; leave any spaces alone                      (t))) ; leave any spaces alone
2725                    (t (idlwave-surround before after nil len))))))))                    (t (idlwave-surround before after nil len))))))))
2726                  
2727    
2728  (defun idlwave-indent-and-action (&optional arg)  (defun idlwave-indent-and-action (&optional arg)
2729    "Call `idlwave-indent-line' and do expand actions.    "Call `idlwave-indent-line' and do expand actions.
2730  With prefix ARG non-nil, indent the entire sub-statement."  With prefix ARG non-nil, indent the entire sub-statement."
2731    (interactive "p")    (interactive "p")
2732    (save-excursion    (save-excursion
2733      (if (and idlwave-expand-generic-end      (if (and idlwave-expand-generic-end
2734               (re-search-backward "\\<\\(end\\)\\s-*\\="               (re-search-backward "\\<\\(end\\)\\s-*\\="
2735                                   (max 0 (- (point) 10)) t)                                   (max 0 (- (point) 10)) t)
2736               (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)"))               (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)"))
2737          (progn (goto-char (match-end 1))          (progn (goto-char (match-end 1))
# Line 2735  With prefix ARG non-nil, indent the enti Line 2741  With prefix ARG non-nil, indent the enti
2741    (when (and (not arg) current-prefix-arg)    (when (and (not arg) current-prefix-arg)
2742      (setq arg current-prefix-arg)      (setq arg current-prefix-arg)
2743      (setq current-prefix-arg nil))      (setq current-prefix-arg nil))
2744    (if arg    (if arg
2745        (idlwave-indent-statement)        (idlwave-indent-statement)
2746      (idlwave-indent-line t)))      (idlwave-indent-line t)))
2747    
# Line 2868  Inserts spaces before markers at point." Line 2874  Inserts spaces before markers at point."
2874                  (save-excursion                  (save-excursion
2875                    (cond                    (cond
2876                     ;; Beginning of file                     ;; Beginning of file
2877                     ((prog1                     ((prog1
2878                          (idlwave-previous-statement)                          (idlwave-previous-statement)
2879                        (setq beg-prev-pos (point)))                        (setq beg-prev-pos (point)))
2880                      0)                      0)
# Line 2878  Inserts spaces before markers at point." Line 2884  Inserts spaces before markers at point."
2884                         idlwave-main-block-indent))                         idlwave-main-block-indent))
2885                     ;; Begin block                     ;; Begin block
2886                     ((idlwave-look-at idlwave-begin-block-reg t)                     ((idlwave-look-at idlwave-begin-block-reg t)
2887                      (+ (idlwave-min-current-statement-indent)                      (+ (idlwave-min-current-statement-indent)
2888                         idlwave-block-indent))                         idlwave-block-indent))
2889                     ;; End Block                     ;; End Block
2890                     ((idlwave-look-at idlwave-end-block-reg t)                     ((idlwave-look-at idlwave-end-block-reg t)
# Line 2889  Inserts spaces before markers at point." Line 2895  Inserts spaces before markers at point."
2895                        (idlwave-min-current-statement-indent)))                        (idlwave-min-current-statement-indent)))
2896                        ;;                      idlwave-end-offset                        ;;                      idlwave-end-offset
2897                        ;;                      idlwave-block-indent))                        ;;                      idlwave-block-indent))
2898                      
2899                     ;; Default to current indent                     ;; Default to current indent
2900                     ((idlwave-current-statement-indent))))))                     ((idlwave-current-statement-indent))))))
2901            ;; adjust the indentation based on the current statement            ;; adjust the indentation based on the current statement
# Line 2905  Inserts spaces before markers at point." Line 2911  Inserts spaces before markers at point."
2911    
2912  (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp)  (defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp)
2913    "Calculate the continuation indent inside a paren group.    "Calculate the continuation indent inside a paren group.
2914  Returns a cons-cell with (open . indent), where open is the  Returns a cons-cell with (open . indent), where open is the
2915  location of the open paren"  location of the open paren"
2916    (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg))))    (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg))))
2917      ;; Found an innermost open paren.      ;; Found an innermost open paren.
# Line 2946  groupings, are treated separately." Line 2952  groupings, are treated separately."
2952             (end-reg (progn (beginning-of-line) (point)))             (end-reg (progn (beginning-of-line) (point)))
2953             (beg-last-statement (save-excursion (idlwave-previous-statement)             (beg-last-statement (save-excursion (idlwave-previous-statement)
2954                                                 (point)))                                                 (point)))
2955             (beg-reg (progn (idlwave-start-of-substatement 'pre)             (beg-reg (progn (idlwave-start-of-substatement 'pre)
2956                             (if (eq (line-beginning-position) end-reg)                             (if (eq (line-beginning-position) end-reg)
2957                                 (goto-char beg-last-statement)                                 (goto-char beg-last-statement)
2958                               (point))))                               (point))))
2959             (basic-indent (+ (idlwave-min-current-statement-indent end-reg)             (basic-indent (+ (idlwave-min-current-statement-indent end-reg)
2960                              idlwave-continuation-indent))                              idlwave-continuation-indent))
2961             fancy-nonparen-indent fancy-paren-indent)             fancy-nonparen-indent fancy-paren-indent)
2962        (cond        (cond
2963         ;; Align then with its matching if, etc.         ;; Align then with its matching if, etc.
2964         ((let ((matchers '(("\\<if\\>" . "[ \t]*then")         ((let ((matchers '(("\\<if\\>" . "[ \t]*then")
2965                            ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else")                            ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else")
2966                            ("\\<\\(for\\|while\\)\\>" . "[ \t]*do")                            ("\\<\\(for\\|while\\)\\>" . "[ \t]*do")
2967                            ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" .                            ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" .
2968                             "[ \t]*until")                             "[ \t]*until")
2969                            ("\\<case\\>" . "[ \t]*of")))                            ("\\<case\\>" . "[ \t]*of")))
2970                match cont-re)                match cont-re)
2971            (goto-char end-reg)            (goto-char end-reg)
2972            (and            (and
2973             (setq cont-re             (setq cont-re
2974                   (catch 'exit                   (catch 'exit
2975                     (while (setq match (car matchers))                     (while (setq match (car matchers))
# Line 2972  groupings, are treated separately." Line 2978  groupings, are treated separately."
2978                       (setq matchers (cdr matchers)))))                       (setq matchers (cdr matchers)))))
2979             (idlwave-find-key cont-re -1 'nomark beg-last-statement)))             (idlwave-find-key cont-re -1 'nomark beg-last-statement)))
2980          (if (looking-at "end") ;; that one's special          (if (looking-at "end") ;; that one's special
2981              (- (idlwave-current-indent)              (- (idlwave-current-indent)
2982                 (+ idlwave-block-indent idlwave-end-offset))                 (+ idlwave-block-indent idlwave-end-offset))
2983            (idlwave-current-indent)))            (idlwave-current-indent)))
2984    
# Line 2998  groupings, are treated separately." Line 3004  groupings, are treated separately."
3004                (let* ((end-reg end-reg)                (let* ((end-reg end-reg)
3005                      (close-exp (progn                      (close-exp (progn
3006                                   (goto-char end-reg)                                   (goto-char end-reg)
3007                                   (skip-chars-forward " \t")                                   (skip-chars-forward " \t")
3008                                   (looking-at "\\s)")))                                   (looking-at "\\s)")))
3009                      indent-cons)                      indent-cons)
3010                  (catch 'loop                  (catch 'loop
# Line 3032  groupings, are treated separately." Line 3038  groupings, are treated separately."
3038                     (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$"))                     (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$"))
3039                         nil                         nil
3040                       (current-column)))                       (current-column)))
3041                      
3042                    ;; Continued assignment (with =):                    ;; Continued assignment (with =):
3043                    ((catch 'assign ;                    ((catch 'assign ;
3044                       (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*")                       (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*")
3045                         (goto-char (match-end 0))                         (goto-char (match-end 0))
3046                         (if (null (idlwave-what-function beg-reg))                         (if (null (idlwave-what-function beg-reg))
3047                             (throw 'assign t))))                             (throw 'assign t))))
3048                     (unless (or                     (unless (or
3049                              (idlwave-in-quote)                              (idlwave-in-quote)
# Line 3099  possibility of unbalanced blocks." Line 3105  possibility of unbalanced blocks."
3105    (let* ((here (point))    (let* ((here (point))
3106           (case-fold-search t)           (case-fold-search t)
3107           (limit (if (>= dir 0) (point-max) (point-min)))           (limit (if (>= dir 0) (point-max) (point-min)))
3108           (block-limit (if (>= dir 0)           (block-limit (if (>= dir 0)
3109                            idlwave-begin-block-reg                            idlwave-begin-block-reg
3110                          idlwave-end-block-reg))                          idlwave-end-block-reg))
3111           found           found
# Line 3110  possibility of unbalanced blocks." Line 3116  possibility of unbalanced blocks."
3116                                 (idlwave-find-key                                 (idlwave-find-key
3117                                  idlwave-begin-unit-reg dir t limit)                                  idlwave-begin-unit-reg dir t limit)
3118                               (end-of-line)                               (end-of-line)
3119                               (idlwave-find-key                               (idlwave-find-key
3120                                idlwave-end-unit-reg dir t limit)))                                idlwave-end-unit-reg dir t limit)))
3121                           limit)))                           limit)))
3122      (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 3135  possibility of unbalanced blocks." Line 3141  possibility of unbalanced blocks."
3141                    (or (null end-reg) (< (point) end-reg)))                    (or (null end-reg) (< (point) end-reg)))
3142          (unless comm-or-empty (setq min (min min (idlwave-current-indent)))))          (unless comm-or-empty (setq min (min min (idlwave-current-indent)))))
3143        (if (or comm-or-empty (and end-reg (>= (point) end-reg)))        (if (or comm-or-empty (and end-reg (>= (point) end-reg)))
3144            min            min
3145          (min min (idlwave-current-indent))))))          (min min (idlwave-current-indent))))))
3146    
3147  (defun idlwave-current-statement-indent (&optional last-line)  (defun idlwave-current-statement-indent (&optional last-line)
# Line 3161  Skips any whitespace. Returns 0 if the e Line 3167  Skips any whitespace. Returns 0 if the e
3167  Blank or comment-only lines following regular continuation lines (with  Blank or comment-only lines following regular continuation lines (with
3168  `$') count as continuations too."  `$') count as continuations too."
3169    (save-excursion    (save-excursion
3170      (or      (or
3171       (idlwave-look-at "\\<\\$")       (idlwave-look-at "\\<\\$")
3172       (catch 'loop       (catch 'loop
3173         (while (and (looking-at "^[ \t]*\\(;.*\\)?$")         (while (and (looking-at "^[ \t]*\\(;.*\\)?$")
3174                     (eq (forward-line -1) 0))                     (eq (forward-line -1) 0))
3175           (if (idlwave-look-at "\\<\\$") (throw 'loop t)))))))           (if (idlwave-look-at "\\<\\$") (throw 'loop t)))))))
3176    
# Line 3262  ignored." Line 3268  ignored."
3268                                            (beginning-of-line) (point))                                            (beginning-of-line) (point))
3269                                          (point))))                                          (point))))
3270                 "[^;]"))                 "[^;]"))
3271            
3272          ;; Mark the beginning and end of the paragraph          ;; Mark the beginning and end of the paragraph
3273          (goto-char bcl)          (goto-char bcl)
3274          (while (and (looking-at fill-prefix-reg)          (while (and (looking-at fill-prefix-reg)
# Line 3326  ignored." Line 3332  ignored."
3332                        (insert (make-string diff ?\ ))))                        (insert (make-string diff ?\ ))))
3333                  (forward-line -1))                  (forward-line -1))
3334                )                )
3335              
3336            ;; No hang. Instead find minimum indentation of paragraph            ;; No hang. Instead find minimum indentation of paragraph
3337            ;; after first line.            ;; after first line.
3338            ;; For the following while statement, since START is at the            ;; For the following while statement, since START is at the
# Line 3358  ignored." Line 3364  ignored."
3364                    t)                    t)
3365                   (current-column))                   (current-column))
3366                 indent))                 indent))
3367            
3368          ;; try to keep point at its original place          ;; try to keep point at its original place
3369          (goto-char here)          (goto-char here)
3370    
# Line 3407  If not found returns nil." Line 3413  If not found returns nil."
3413            (current-column)))))            (current-column)))))
3414    
3415  (defun idlwave-auto-fill ()  (defun idlwave-auto-fill ()
3416    "Called to break lines in auto fill mode.    "Called to break lines in auto fill mode.  
3417  Only fills non-comment lines if `idlwave-fill-comment-line-only' is  Only fills non-comment lines if `idlwave-fill-comment-line-only' is
3418  non-nil.  Places a continuation character at the end of the line if  non-nil.  Places a continuation character at the end of the line if
3419  not in a comment.  Splits strings with IDL concatenation operator `+'  not in a comment.  Splits strings with IDL concatenation operator `+'
# Line 3558  is non-nil." Line 3564  is non-nil."
3564    (insert (current-time-string))    (insert (current-time-string))
3565    (insert ", " (user-full-name))    (insert ", " (user-full-name))
3566    (if (boundp 'user-mail-address)    (if (boundp 'user-mail-address)
3567        (insert " <" user-mail-address ">")        (insert " <" user-mail-address ">")
3568      (insert " <" (user-login-name) "@" (system-name) ">"))      (insert " <" (user-login-name) "@" (system-name) ">"))
3569    ;; Remove extra spaces from line    ;; Remove extra spaces from line
3570    (idlwave-fill-paragraph)    (idlwave-fill-paragraph)
# Line 3584  location on mark ring so that the user c Line 3590  location on mark ring so that the user c
3590               (setq end (match-end 0)))               (setq end (match-end 0)))
3591          (progn          (progn
3592            (goto-char beg)            (goto-char beg)
3593            (if (re-search-forward            (if (re-search-forward
3594                 (concat idlwave-doc-modifications-keyword ":")                 (concat idlwave-doc-modifications-keyword ":")
3595                 end t)                 end t)
3596                (end-of-line)                (end-of-line)
# Line 3682  constants - a double quote followed by a Line 3688  constants - a double quote followed by a
3688       (not (idlwave-in-quote))       (not (idlwave-in-quote))
3689       (save-excursion       (save-excursion
3690         (forward-char)         (forward-char)
3691         (re-search-backward (concat "\\(" idlwave-idl-keywords         (re-search-backward (concat "\\(" idlwave-idl-keywords
3692                                     "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t)))))                                     "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t)))))
3693    
3694    
# Line 3728  unless the optional second argument NOIN Line 3734  unless the optional second argument NOIN
3734            (indent-region beg end nil))            (indent-region beg end nil))
3735        (if (stringp prompt)        (if (stringp prompt)
3736            (message prompt)))))            (message prompt)))))
3737      
3738  (defun idlwave-rw-case (string)  (defun idlwave-rw-case (string)
3739    "Make STRING have the case required by `idlwave-reserved-word-upcase'."    "Make STRING have the case required by `idlwave-reserved-word-upcase'."
3740    (if idlwave-reserved-word-upcase    (if idlwave-reserved-word-upcase
# Line 3746  unless the optional second argument NOIN Line 3752  unless the optional second argument NOIN
3752  (defun idlwave-case ()  (defun idlwave-case ()
3753    "Build skeleton IDL case statement."    "Build skeleton IDL case statement."
3754    (interactive)    (interactive)
3755    (idlwave-template    (idlwave-template
3756     (idlwave-rw-case "case")     (idlwave-rw-case "case")
3757     (idlwave-rw-case " of\n\nendcase")     (idlwave-rw-case " of\n\nendcase")
3758     "Selector expression"))     "Selector expression"))
# Line 3754  unless the optional second argument NOIN Line 3760  unless the optional second argument NOIN
3760  (defun idlwave-switch ()  (defun idlwave-switch ()
3761    "Build skeleton IDL switch statement."    "Build skeleton IDL switch statement."
3762    (interactive)    (interactive)
3763    (idlwave-template    (idlwave-template
3764     (idlwave-rw-case "switch")     (idlwave-rw-case "switch")
3765     (idlwave-rw-case " of\n\nendswitch")     (idlwave-rw-case " of\n\nendswitch")
3766     "Selector expression"))     "Selector expression"))
# Line 3762  unless the optional second argument NOIN Line 3768  unless the optional second argument NOIN
3768  (defun idlwave-for ()  (defun idlwave-for ()
3769    "Build skeleton for loop statment."    "Build skeleton for loop statment."
3770    (interactive)    (interactive)
3771    (idlwave-template    (idlwave-template
3772     (idlwave-rw-case "for")     (idlwave-rw-case "for")
3773     (idlwave-rw-case " do begin\n\nendfor")     (idlwave-rw-case " do begin\n\nendfor")
3774     "Loop expression"))     "Loop expression"))
# Line 3777  unless the optional second argument NOIN Line 3783  unless the optional second argument NOIN
3783    
3784  (defun idlwave-procedure ()  (defun idlwave-procedure ()
3785    (interactive)    (interactive)
3786    (idlwave-template    (idlwave-template
3787     (idlwave-rw-case "pro")     (idlwave-rw-case "pro")
3788     (idlwave-rw-case "\n\nreturn\nend")     (idlwave-rw-case "\n\nreturn\nend")
3789     "Procedure name"))     "Procedure name"))
3790    
3791  (defun idlwave-function ()  (defun idlwave-function ()
3792    (interactive)    (interactive)
3793    (idlwave-template    (idlwave-template
3794     (idlwave-rw-case "function")     (idlwave-rw-case "function")
3795     (idlwave-rw-case "\n\nreturn\nend")     (idlwave-rw-case "\n\nreturn\nend")
3796     "Function name"))     "Function name"))
# Line 3798  unless the optional second argument NOIN Line 3804  unless the optional second argument NOIN
3804    
3805  (defun idlwave-while ()  (defun idlwave-while ()
3806    (interactive)    (interactive)
3807    (idlwave-template    (idlwave-template
3808     (idlwave-rw-case "while")     (idlwave-rw-case "while")
3809     (idlwave-rw-case " do begin\n\nendwhile")     (idlwave-rw-case " do begin\n\nendwhile")
3810     "Entry condition"))     "Entry condition"))
# Line 3877  Buffer containing unsaved changes requir Line 3883  Buffer containing unsaved changes requir
3883  (defun idlwave-count-outlawed-buffers (tag)  (defun idlwave-count-outlawed-buffers (tag)
3884    "How many outlawed buffers have tag TAG?"    "How many outlawed buffers have tag TAG?"
3885    (length (delq nil    (length (delq nil
3886                  (mapcar                  (mapcar
3887                   (lambda (x) (eq (cdr x) tag))                   (lambda (x) (eq (cdr x) tag))
3888                   idlwave-outlawed-buffers))))                   idlwave-outlawed-buffers))))
3889    
3890  (defun idlwave-do-kill-autoloaded-buffers (&rest reasons)  (defun idlwave-do-kill-autoloaded-buffers (&rest reasons)
# Line 3892  Buffer containing unsaved changes requir Line 3898  Buffer containing unsaved changes requir
3898                     (memq (cdr entry) reasons))                     (memq (cdr entry) reasons))
3899                 (kill-buffer (car entry))                 (kill-buffer (car entry))
3900                 (incf cnt)                 (incf cnt)
3901                 (setq idlwave-outlawed-buffers                 (setq idlwave-outlawed-buffers
3902                       (delq entry idlwave-outlawed-buffers)))                       (delq entry idlwave-outlawed-buffers)))
3903          (setq idlwave-outlawed-buffers          (setq idlwave-outlawed-buffers
3904                (delq entry idlwave-outlawed-buffers))))                (delq entry idlwave-outlawed-buffers))))
3905      (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s"))))      (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s"))))
3906    
# Line 3906  Intended for `after-save-hook'." Line 3912  Intended for `after-save-hook'."
3912           (entry (assq buf idlwave-outlawed-buffers)))           (entry (assq buf idlwave-outlawed-buffers)))
3913      ;; Revoke license      ;; Revoke license
3914      (if entry      (if entry
3915          (setq idlwave-outlawed-buffers          (setq idlwave-outlawed-buffers
3916                (delq entry idlwave-outlawed-buffers)))                (delq entry idlwave-outlawed-buffers)))
3917      ;; Remove this function from the hook.      ;; Remove this function from the hook.
3918      (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local)))      (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local)))
# Line 3925  Intended for `after-save-hook'." Line 3931  Intended for `after-save-hook'."
3931  (defun idlwave-expand-lib-file-name (file)  (defun idlwave-expand-lib-file-name (file)
3932    ;; 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
3933    ;; This is for, e.g., finding source with no user catalog    ;; This is for, e.g., finding source with no user catalog
3934    (cond    (cond
3935     ((null file) nil)     ((null file) nil)
3936     ((file-name-absolute-p file) file)     ((file-name-absolute-p file) file)
3937     (t (idlwave-locate-lib-file file))))     (t (idlwave-locate-lib-file file))))
# Line 3940  you specify /." Line 3946  you specify /."
3946    (interactive)    (interactive)
3947    (let (directory directories cmd append status numdirs dir getsubdirs    (let (directory directories cmd append status numdirs dir getsubdirs
3948                    buffer save_buffer files numfiles item errbuf)                    buffer save_buffer files numfiles item errbuf)
3949        
3950      ;;      ;;
3951      ;; Read list of directories      ;; Read list of directories
3952      (setq directory (read-string "Tag Directories: " "."))      (setq directory (read-string "Tag Directories: " "."))
# Line 3992  you specify /." Line 3998  you specify /."
3998                      (message (concat "Tagging " item "..."))                      (message (concat "Tagging " item "..."))
3999                      (setq errbuf (get-buffer-create "*idltags-error*"))                      (setq errbuf (get-buffer-create "*idltags-error*"))
4000                      (setq status (+ status                      (setq status (+ status
4001                                      (if (eq 0 (call-process                                      (if (eq 0 (call-process
4002                                                 "sh" nil errbuf nil "-c"                                                 "sh" nil errbuf nil "-c"
4003                                                 (concat cmd append item)))                                                 (concat cmd append item)))
4004                                          0                                          0
# Line 4006  you specify /." Line 4012  you specify /."
4012                    (setq numfiles (1+ numfiles))                    (setq numfiles (1+ numfiles))
4013                    (setq item (nth numfiles files))                    (setq item (nth numfiles files))
4014                    )))                    )))
4015                
4016              (setq numdirs (1+ numdirs))              (setq numdirs (1+ numdirs))
4017              (setq dir (nth numdirs directories)))              (setq dir (nth numdirs directories)))
4018          (progn          (progn
4019            (setq numdirs (1+ numdirs))            (setq numdirs (1+ numdirs))
4020            (setq dir (nth numdirs directories)))))            (setq dir (nth numdirs directories)))))
4021        
4022      (setq errbuf (get-buffer-create "*idltags-error*"))      (setq errbuf (get-buffer-create "*idltags-error*"))
4023      (if (= status 0)      (if (= status 0)
4024          (kill-buffer errbuf))          (kill-buffer errbuf))
# Line 4088  blank lines." Line 4094  blank lines."
4094    ;; Make sure the hash functions are accessible.    ;; Make sure the hash functions are accessible.
4095    (if (or (not (fboundp 'gethash))    (if (or (not (fboundp 'gethash))
4096            (not (fboundp 'puthash)))            (not (fboundp 'puthash)))
4097        (progn        (progn
4098          (require 'cl)          (require 'cl)
4099          (or (fboundp 'puthash)          (or (fboundp 'puthash)
4100              (defalias 'puthash 'cl-puthash))))              (defalias 'puthash 'cl-puthash))))
# Line 4107  blank lines." Line 4113  blank lines."
4113        ;; Reset the system & library hash        ;; Reset the system & library hash
4114        (loop for entry in entries        (loop for entry in entries
4115          for var = (car entry) for size = (nth 1 entry)          for var = (car entry) for size = (nth 1 entry)
4116          do (setcdr (symbol-value var)          do (setcdr (symbol-value var)
4117                     (make-hash-table ':size size ':test 'equal)))                     (make-hash-table ':size size ':test 'equal)))
4118        (setq idlwave-sint-dirs nil        (setq idlwave-sint-dirs nil
4119              idlwave-sint-libnames nil))              idlwave-sint-libnames nil))
# Line 4117  blank lines." Line 4123  blank lines."
4123        ;; Reset the buffer & shell hash        ;; Reset the buffer & shell hash
4124        (loop for entry in entries        (loop for entry in entries
4125          for var = (car entry) for size = (nth 1 entry)          for var = (car entry) for size = (nth 1 entry)
4126          do (setcar (symbol-value var)          do (setcar (symbol-value var)
4127                     (make-hash-table ':size size ':test 'equal))))))                     (make-hash-table ':size size ':test 'equal))))))
4128    
4129  (defun idlwave-sintern-routine-or-method (name &optional class set)  (defun idlwave-sintern-routine-or-method (name &optional class set)
# Line 4204  If DEFAULT-DIR is passed, it is used as Line 4210  If DEFAULT-DIR is passed, it is used as
4210              (setq class (idlwave-sintern-class class set))              (setq class (idlwave-sintern-class class set))
4211              (setq name (idlwave-sintern-method name set)))              (setq name (idlwave-sintern-method name set)))
4212          (setq name (idlwave-sintern-routine name set)))          (setq name (idlwave-sintern-routine name set)))
4213          
4214        ;; The source        ;; The source
4215        (let ((source-type (car source))        (let ((source-type (car source))
4216              (source-file  (nth 1 source))              (source-file  (nth 1 source))
4217              (source-dir  (if default-dir              (source-dir  (if default-dir  
4218                               (file-name-as-directory default-dir)                               (file-name-as-directory default-dir)
4219                             (nth 2 source)))                             (nth 2 source)))
4220              (source-lib (nth 3 source)))              (source-lib (nth 3 source)))
# Line 4217  If DEFAULT-DIR is passed, it is used as Line 4223  If DEFAULT-DIR is passed, it is used as
4223          (if (stringp source-lib)          (if (stringp source-lib)
4224              (setq source-lib (idlwave-sintern-libname source-lib set)))              (setq source-lib (idlwave-sintern-libname source-lib set)))
4225          (setq source (list source-type source-file source-dir source-lib)))          (setq source (list source-type source-file source-dir source-lib)))
4226          
4227        ;; The keywords        ;; The keywords
4228        (setq kwds (mapcar (lambda (x)        (setq kwds (mapcar (lambda (x)
4229                             (idlwave-sintern-keyword-list x set))                             (idlwave-sintern-keyword-list x set))
# Line 4267  This defines the function `idlwave-sinte Line 4273  This defines the function `idlwave-sinte
4273  (defvar idlwave-user-catalog-routines nil  (defvar idlwave-user-catalog-routines nil
4274    "Holds the procedure routine-info from the user scan.")    "Holds the procedure routine-info from the user scan.")
4275  (defvar idlwave-library-catalog-routines nil  (defvar idlwave-library-catalog-routines nil
4276    "Holds the procedure routine-info from the library catalog files.")    "Holds the procedure routine-info from the .idlwave_catalog library files.")
4277    (defvar idlwave-library-catalog-libname nil
4278      "Name of library catalog loaded from .idlwave_catalog files.")
4279  (defvar idlwave-path-alist nil  (defvar idlwave-path-alist nil
4280    "Alist with !PATH directories and zero or more flags if the dir has    "Alist with !PATH directories and zero or more flags if the dir has
4281  been scanned in a user catalog ('user) or discovered in a library  been scanned in a user catalog ('user) or discovered in a library
# Line 4355  will re-read the catalog." Line 4363  will re-read the catalog."
4363                       "-l" (expand-file-name "~/.emacs")                       "-l" (expand-file-name "~/.emacs")
4364                       "-l" "idlwave"                       "-l" "idlwave"
4365                       "-f" "idlwave-rescan-catalog-directories"))                       "-f" "idlwave-rescan-catalog-directories"))
4366           (process (apply 'start-process "idlcat"           (process (apply 'start-process "idlcat"
4367                           nil emacs args)))                           nil emacs args)))
4368      (setq idlwave-catalog-process process)      (setq idlwave-catalog-process process)
4369      (set-process-sentinel      (set-process-sentinel
4370       process       process
4371       (lambda (pro why)       (lambda (pro why)
4372         (when (string-match "finished" why)         (when (string-match "finished" why)
# Line 4384  will re-read the catalog." Line 4392  will re-read the catalog."
4392    
4393    
4394  (defvar idlwave-load-rinfo-idle-timer)  (defvar idlwave-load-rinfo-idle-timer)
4395    (defvar idlwave-shell-path-query)
4396    
4397  (defun idlwave-update-routine-info (&optional arg no-concatenate)  (defun idlwave-update-routine-info (&optional arg no-concatenate)
4398    "Update the internal routine-info lists.    "Update the internal routine-info lists.
4399  These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info])  These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info])
# Line 4431  information updated immediately, leave N Line 4441  information updated immediately, leave N
4441             ;; The override-idle means, even if the idle timer has done some             ;; The override-idle means, even if the idle timer has done some
4442             ;; preparing work, load and renormalize everything anyway.             ;; preparing work, load and renormalize everything anyway.
4443             (override-idle (or arg idlwave-buffer-case-takes-precedence)))             (override-idle (or arg idlwave-buffer-case-takes-precedence)))
4444          
4445        (setq idlwave-buffer-routines nil        (setq idlwave-buffer-routines nil
4446              idlwave-compiled-routines nil              idlwave-compiled-routines nil
4447              idlwave-unresolved-routines nil)              idlwave-unresolved-routines nil)
# Line 4442  information updated immediately, leave N Line 4452  information updated immediately, leave N
4452          (idlwave-reset-sintern (cond (load t)          (idlwave-reset-sintern (cond (load t)
4453                                       ((null idlwave-system-routines) t)                                       ((null idlwave-system-routines) t)
4454                                       (t 'bufsh))))                                       (t 'bufsh))))
4455          
4456        (if idlwave-buffer-case-takes-precedence        (if idlwave-buffer-case-takes-precedence
4457            ;; We can safely scan the buffer stuff first            ;; We can safely scan the buffer stuff first
4458            (progn            (progn
# Line 4457  information updated immediately, leave N Line 4467  information updated immediately, leave N
4467                                      (idlwave-shell-is-running)))                                      (idlwave-shell-is-running)))
4468               (ask-shell (and shell-is-running               (ask-shell (and shell-is-running
4469                               idlwave-query-shell-for-routine-info)))                               idlwave-query-shell-for-routine-info)))
4470          
4471          ;; Load the library catalogs again, first re-scanning the path          ;; Load the library catalogs again, first re-scanning the path
4472          (when arg          (when arg
4473            (if shell-is-running            (if shell-is-running
4474                (idlwave-shell-send-command idlwave-shell-path-query                (idlwave-shell-send-command idlwave-shell-path-query
4475                                            '(progn                                            '(progn
# Line 4479  information updated immediately, leave N Line 4489  information updated immediately, leave N
4489              ;;    Therefore, we do a concatenation now, even though              ;;    Therefore, we do a concatenation now, even though
4490              ;;    the shell might do it again.              ;;    the shell might do it again.
4491              (idlwave-concatenate-rinfo-lists nil 'run-hooks))              (idlwave-concatenate-rinfo-lists nil 'run-hooks))
4492          
4493          (when ask-shell          (when ask-shell
4494            ;; Ask the shell about the routines it knows of.            ;; Ask the shell about the routines it knows of.
4495            (message "Querying the shell")            (message "Querying the shell")
# Line 4508  information updated immediately, leave N Line 4518  information updated immediately, leave N
4518                     nil 'idlwave-load-rinfo-next-step)))                     nil 'idlwave-load-rinfo-next-step)))
4519          (error nil))))          (error nil))))
4520    
4521    (defvar idlwave-library-routines nil "Obsolete variable.")
4522    
4523  (defun idlwave-load-rinfo-next-step ()  (defun idlwave-load-rinfo-next-step ()
4524    (let ((inhibit-quit t)    (let ((inhibit-quit t)
4525          (arr idlwave-load-rinfo-steps-done))          (arr idlwave-load-rinfo-steps-done))
# Line 4541  information updated immediately, leave N Line 4553  information updated immediately, leave N
4553                    (progn                    (progn
4554                      (setq idlwave-library-routines nil)                      (setq idlwave-library-routines nil)
4555                      (ding)                      (ding)
4556                      (message "Outdated user catalog: %s... recreate"                      (message "Outdated user catalog: %s... recreate"
4557                               idlwave-user-catalog-file))                               idlwave-user-catalog-file))
4558                  (message "Loading user catalog in idle time...done"))                  (message "Loading user catalog in idle time...done"))
4559                (aset arr 2 t)                (aset arr 2 t)
# Line 4549  information updated immediately, leave N Line 4561  information updated immediately, leave N
4561            (when (not (aref arr 3))            (when (not (aref arr 3))
4562              (when idlwave-user-catalog-routines              (when idlwave-user-catalog-routines
4563                (message "Normalizing user catalog routines in idle time...")                (message "Normalizing user catalog routines in idle time...")
4564                (setq idlwave-user-catalog-routines                (setq idlwave-user-catalog-routines
4565                      (idlwave-sintern-rinfo-list                      (idlwave-sintern-rinfo-list
4566                       idlwave-user-catalog-routines 'sys))                       idlwave-user-catalog-routines 'sys))
4567                (message                (message
4568                 "Normalizing user catalog routines in idle time...done"))                 "Normalizing user catalog routines in idle time...done"))
4569              (aset arr 3 t)              (aset arr 3 t)
4570              (throw 'exit t))              (throw 'exit t))
4571            (when (not (aref arr 4))            (when (not (aref arr 4))
4572              (idlwave-scan-library-catalogs              (idlwave-scan-library-catalogs
4573               "Loading and normalizing library catalogs in idle time...")               "Loading and normalizing library catalogs in idle time...")
4574              (aset arr 4 t)              (aset arr 4 t)
4575              (throw 'exit t))              (throw 'exit t))
# Line 4598  information updated immediately, leave N Line 4610  information updated immediately, leave N
4610      (setq idlwave-true-path-alist nil)      (setq idlwave-true-path-alist nil)
4611      (when (or force (not (aref idlwave-load-rinfo-steps-done 3)))      (when (or force (not (aref idlwave-load-rinfo-steps-done 3)))
4612        (message "Normalizing user catalog routines...")        (message "Normalizing user catalog routines...")
4613        (setq idlwave-user-catalog-routines        (setq idlwave-user-catalog-routines
4614              (idlwave-sintern-rinfo-list              (idlwave-sintern-rinfo-list
4615               idlwave-user-catalog-routines 'sys))               idlwave-user-catalog-routines 'sys))
4616        (message "Normalizing user catalog routines...done")))        (message "Normalizing user catalog routines...done")))
4617    (when (or force (not (aref idlwave-load-rinfo-steps-done 4)))    (when (or force (not (aref idlwave-load-rinfo-steps-done 4)))
# Line 4610  information updated immediately, leave N Line 4622  information updated immediately, leave N
4622    
4623  (defun idlwave-update-buffer-routine-info ()  (defun idlwave-update-buffer-routine-info ()
4624    (let (res)    (let (res)
4625      (cond      (cond
4626       ((eq idlwave-scan-all-buffers-for-routine-info t)       ((eq idlwave-scan-all-buffers-for-routine-info t)
4627        ;; Scan all buffers, current buffer last        ;; Scan all buffers, current buffer last
4628        (message "Scanning all buffers...")        (message "Scanning all buffers...")
4629        (setq res (idlwave-get-routine-info-from-buffers        (setq res (idlwave-get-routine-info-from-buffers
4630                   (reverse (buffer-list)))))                   (reverse (buffer-list)))))
4631       ((null idlwave-scan-all-buffers-for-routine-info)       ((null idlwave-scan-all-buffers-for-routine-info)
4632        ;; Don't scan any buffers        ;; Don't scan any buffers
# Line 4627  information updated immediately, leave N Line 4639  information updated immediately, leave N
4639              (setq res (idlwave-get-routine-info-from-buffers              (setq res (idlwave-get-routine-info-from-buffers
4640                         (list (current-buffer))))))))                         (list (current-buffer))))))))
4641      ;; Put the result into the correct variable      ;; Put the result into the correct variable
4642      (setq idlwave-buffer-routines      (setq idlwave-buffer-routines
4643            (idlwave-sintern-rinfo-list res 'set))))            (idlwave-sintern-rinfo-list res 'set))))
4644    
4645  (defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook)  (defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook)
4646    "Put the different sources for routine information together."    "Put the different sources for routine information together."
4647    ;; The sequence here is important because earlier definitions shadow    ;; The sequence here is important because earlier definitions shadow
4648    ;; later ones.  We assume that if things in the buffers are newer    ;; later ones.  We assume that if things in the buffers are newer
4649    ;; then in the shell of the system, they are meant to be different.    ;; then in the shell of the system, they are meant to be different.
4650    (setcdr idlwave-last-system-routine-info-cons-cell    (setcdr idlwave-last-system-routine-info-cons-cell
# Line 4644  information updated immediately, leave N Line 4656  information updated immediately, leave N
4656    
4657    ;; Give a message with information about the number of routines we have.    ;; Give a message with information about the number of routines we have.
4658    (unless quiet    (unless quiet
4659      (message      (message
4660       "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)"       "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)"
4661       (length idlwave-buffer-routines)       (length idlwave-buffer-routines)
4662       (length idlwave-compiled-routines)       (length idlwave-compiled-routines)
# Line 4662  information updated immediately, leave N Line 4674  information updated immediately, leave N
4674            (when (and (setq class (nth 2 x))            (when (and (setq class (nth 2 x))
4675                       (not (assq class idlwave-class-alist)))                       (not (assq class idlwave-class-alist)))
4676              (push (list class) idlwave-class-alist)))              (push (list class) idlwave-class-alist)))
4677          idlwave-class-alist)))          idlwave-class-alist)))      
4678    
4679  ;; Three functions for the hooks  ;; Three functions for the hooks
4680  (defun idlwave-save-buffer-update ()  (defun idlwave-save-buffer-update ()
# Line 4695  information updated immediately, leave N Line 4707  information updated immediately, leave N
4707    
4708  (defun idlwave-replace-buffer-routine-info (file new)  (defun idlwave-replace-buffer-routine-info (file new)
4709    "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."
4710    (let ((list idlwave-buffer-routines)    (let ((list idlwave-buffer-routines)
4711          found)          found)
4712      (while list      (while list
4713        ;; The following test uses eq to make sure it works correctly        ;; The following test uses eq to make sure it works correctly
# Line 4706  information updated immediately, leave N Line 4718  information updated immediately, leave N
4718              (setcar list nil)              (setcar list nil)
4719              (setq found t))              (setq found t))
4720          (if found          (if found
4721              ;; End of that section reached. Jump.              ;; End of that section reached. Jump.
4722              (setq list nil)))              (setq list nil)))
4723        (setq list (cdr list)))        (setq list (cdr list)))
4724      (setq idlwave-buffer-routines      (setq idlwave-buffer-routines
# Line 4738  information updated immediately, leave N Line 4750  information updated immediately, leave N
4750        (save-restriction        (save-restriction
4751          (widen)          (widen)
4752          (goto-char (point-min))          (goto-char (point-min))
4753          (while (re-search-forward          (while (re-search-forward
4754                  "^[ \t]*\\(pro\\|function\\)[ \t]" nil t)                  "^[ \t]*\\(pro\\|function\\)[ \t]" nil t)
4755            (setq string (buffer-substring-no-properties            (setq string (buffer-substring-no-properties
4756                          (match-beginning 0)                          (match-beginning 0)
4757                          (progn                          (progn
4758                            (idlwave-end-of-statement)                            (idlwave-end-of-statement)
4759                            (point))))                            (point))))
4760            (setq entry (idlwave-parse-definition string))            (setq entry (idlwave-parse-definition string))
# Line 4780  information updated immediately, leave N Line 4792  information updated immediately, leave N
4792          (push (match-string 1 string) args)))          (push (match-string 1 string) args)))
4793      ;; Normalize and sort.      ;; Normalize and sort.
4794      (setq args (nreverse args))      (setq args (nreverse args))
4795      (setq keywords (sort keywords (lambda (a b)      (setq keywords (sort keywords (lambda (a b)
4796                                      (string< (downcase a) (downcase b)))))                                      (string< (downcase a) (downcase b)))))
4797      ;; Make and return the entry      ;; Make and return the entry
4798      ;; We don't know which argument are optional, so this information      ;; We don't know which argument are optional, so this information
# Line 4790  information updated immediately, leave N Line 4802  information updated immediately, leave N
4802            class            class
4803            (cond ((not (boundp 'idlwave-scanning-lib))            (cond ((not (boundp 'idlwave-scanning-lib))
4804                   (list  'buffer (buffer-file-name)))                   (list  'buffer (buffer-file-name)))
4805  ;               ((string= (downcase  ;               ((string= (downcase
4806  ;                          (file-name-sans-extension  ;                          (file-name-sans-extension
4807  ;                           (file-name-nondirectory (buffer-file-name))))  ;                           (file-name-nondirectory (buffer-file-name))))
4808  ;                         (downcase name))  ;                         (downcase name))
# Line 4798  information updated immediately, leave N Line 4810  information updated immediately, leave N
4810  ;               (t (cons 'lib (file-name-nondirectory (buffer-file-name))))  ;               (t (cons 'lib (file-name-nondirectory (buffer-file-name))))
4811                  (t (list 'user (file-name-nondirectory (buffer-file-name))                  (t (list 'user (file-name-nondirectory (buffer-file-name))
4812                           idlwave-scanning-lib-dir "UserLib")))                           idlwave-scanning-lib-dir "UserLib")))
4813            (concat            (concat
4814             (if (string= type "function") "Result = " "")             (if (string= type "function") "Result = " "")
4815             (if class "Obj ->[%s::]" "")             (if class "Obj ->[%s::]" "")
4816             "%s"             "%s"
# Line 4816  information updated immediately, leave N Line 4828  information updated immediately, leave N
4828    
4829  (defun idlwave-sys-dir ()  (defun idlwave-sys-dir ()
4830    "Return the syslib directory, or a dummy that never matches."    "Return the syslib directory, or a dummy that never matches."
4831    (if (string= idlwave-system-directory "")    (cond
4832        "@@@@@@@@"     ((and idlwave-system-directory
4833      idlwave-system-directory))           (not (string= idlwave-system-directory "")))
4834        idlwave-system-directory)
4835       ((getenv "IDL_DIR"))
4836       (t "@@@@@@@@")))
4837    
4838    
4839    
 (defvar idlwave-shell-path-query)  
4840  (defun idlwave-create-user-catalog-file (&optional arg)  (defun idlwave-create-user-catalog-file (&optional arg)
4841    "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.
4842    
# Line 4842  time - so no widget will pop up." Line 4857  time - so no widget will pop up."
4857                 (> (length idlwave-user-catalog-file) 0)                 (> (length idlwave-user-catalog-file) 0)
4858                 (file-accessible-directory-p                 (file-accessible-directory-p
4859                  (file-name-directory idlwave-user-catalog-file))                  (file-name-directory idlwave-user-catalog-file))
4860                 (not (string= "" (file-name-nondirectory                 (not (string= "" (file-name-nondirectory
4861                                   idlwave-user-catalog-file))))                                   idlwave-user-catalog-file))))
4862      (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory"))      (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory"))
4863      
4864    (cond    (cond
4865      ;; Rescan the known directories      ;; Rescan the known directories
4866     ((and arg idlwave-path-alist     ((and arg idlwave-path-alist
# Line 4855  time - so no widget will pop up." Line 4870  time - so no widget will pop up."
4870     ;; Expand the directories from library-path and run the widget     ;; Expand the directories from library-path and run the widget
4871     (idlwave-library-path     (idlwave-library-path
4872      (idlwave-display-user-catalog-widget      (idlwave-display-user-catalog-widget
4873       (if idlwave-true-path-alist       (if idlwave-true-path-alist
4874           ;; Propagate any flags on the existing path-alist           ;; Propagate any flags on the existing path-alist
4875           (mapcar (lambda (x)           (mapcar (lambda (x)
4876                     (let ((path-entry (assoc (file-truename x)                     (let ((path-entry (assoc (file-truename x)
4877                                              idlwave-true-path-alist)))                                              idlwave-true-path-alist)))
4878                       (if path-entry                       (if path-entry
4879                           (cons x (cdr path-entry))                           (cons x (cdr path-entry))
4880                         (list x))))                         (list x))))
4881                   (idlwave-expand-path idlwave-library-path))                   (idlwave-expand-path idlwave-library-path))
4882         (mapcar 'list (idlwave-expand-path idlwave-library-path)))))         (mapcar 'list (idlwave-expand-path idlwave-library-path)))))
# Line 4886  time - so no widget will pop up." Line 4901  time - so no widget will pop up."
4901      (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load)      (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load)
4902      (idlwave-display-user-catalog-widget idlwave-path-alist)))      (idlwave-display-user-catalog-widget idlwave-path-alist)))
4903    
4904  (defconst idlwave-user-catalog-widget-help-string  (defconst idlwave-user-catalog-widget-help-string
4905    "This is the front-end to the creation of the IDLWAVE user catalog.    "This is the front-end to the creation of the IDLWAVE user catalog.
4906  Please select the directories on IDL's search path from which you  Please select the directories on IDL's search path from which you
4907  would like to extract routine information, to be stored in the file:  would like to extract routine information, to be stored in the file:
# Line 4921  directories and save the routine info. Line 4936  directories and save the routine info.
4936    (make-local-variable 'idlwave-widget)    (make-local-variable 'idlwave-widget)
4937    (widget-insert (format idlwave-user-catalog-widget-help-string    (widget-insert (format idlwave-user-catalog-widget-help-string
4938                           idlwave-user-catalog-file))                           idlwave-user-catalog-file))
4939      
4940    (widget-create 'push-button    (widget-create 'push-button
4941                   :notify 'idlwave-widget-scan-user-lib-files                   :notify 'idlwave-widget-scan-user-lib-files
4942                   "Scan & Save")                   "Scan & Save")
# Line 4931  directories and save the routine info. Line 4946  directories and save the routine info.
4946                   "Delete File")                   "Delete File")
4947    (widget-insert "  ")    (widget-insert "  ")
4948    (widget-create 'push-button    (widget-create 'push-button
4949                   :notify                   :notify
4950                   '(lambda (&rest ignore)                   '(lambda (&rest ignore)
4951                      (let ((path-list (widget-get idlwave-widget :path-dirs)))                      (let ((path-list (widget-get idlwave-widget :path-dirs)))
4952                        (mapcar (lambda (x)                        (mapcar (lambda (x)
# Line 4942  directories and save the routine info. Line 4957  directories and save the routine info.
4957                   "Select All Non-Lib")                   "Select All Non-Lib")
4958    (widget-insert "  ")    (widget-insert "  ")
4959    (widget-create 'push-button    (widget-create 'push-button
4960                   :notify                   :notify
4961                   '(lambda (&rest ignore)                   '(lambda (&rest ignore)
4962                      (let ((path-list (widget-get idlwave-widget :path-dirs)))                      (let ((path-list (widget-get idlwave-widget :path-dirs)))
4963                        (mapcar (lambda (x)                        (mapcar (lambda (x)
# Line 4958  directories and save the routine info. Line 4973  directories and save the routine info.
4973    (widget-insert "\n\n")    (widget-insert "\n\n")
4974    
4975    (widget-insert "Select Directories: \n")    (widget-insert "Select Directories: \n")
4976      
4977    (setq idlwave-widget    (setq idlwave-widget
4978          (apply 'widget-create          (apply 'widget-create
4979                 'checklist                 'checklist
4980                 :value  (delq nil (mapcar (lambda (x)                 :value  (delq nil (mapcar (lambda (x)
4981                                             (if (memq 'user (cdr x))                                             (if (memq 'user (cdr x))
4982                                                 (car x)))                                                 (car x)))
4983                                           dirs-list))                                           dirs-list))
4984                 :greedy t                 :greedy t
4985                 :tag "List of directories"                 :tag "List of directories"
4986                 (mapcar (lambda (x)                 (mapcar (lambda (x)
4987                           (list 'item                           (list 'item
4988                                 (if (memq 'lib (cdr x))                                 (if (memq 'lib (cdr x))
4989                                     (concat "[LIB] " (car x) )                                     (concat "[LIB] " (car x) )
4990                                   (car x)))) dirs-list)))                                   (car x)))) dirs-list)))
# Line 4979  directories and save the routine info. Line 4994  directories and save the routine info.
4994    (widget-setup)    (widget-setup)
4995    (goto-char (point-min))    (goto-char (point-min))
4996    (delete-other-windows))    (delete-other-windows))
4997      
4998  (defun idlwave-delete-user-catalog-file (&rest ignore)  (defun idlwave-delete-user-catalog-file (&rest ignore)
4999    (if (yes-or-no-p    (if (yes-or-no-p
5000         (format "Delete file %s " idlwave-user-catalog-file))         (format "Delete file %s " idlwave-user-catalog-file))
# Line 4995  directories and save the routine info. Line 5010  directories and save the routine info.
5010           (this-path-alist path-alist)           (this-path-alist path-alist)
5011           dir-entry)           dir-entry)
5012      (while (setq dir-entry (pop this-path-alist))      (while (setq dir-entry (pop this-path-alist))
5013        (if (member        (if (member
5014             (if (memq 'lib (cdr dir-entry))             (if (memq 'lib (cdr dir-entry))
5015                 (concat "[LIB] " (car dir-entry))                 (concat "[LIB] " (car dir-entry))
5016               (car dir-entry))               (car dir-entry))
# Line 5092  directories and save the routine info. Line 5107  directories and save the routine info.
5107      ;; Define the variable which knows the value of "!DIR"      ;; Define the variable which knows the value of "!DIR"
5108      (insert (format "\n(setq idlwave-system-directory \"%s\")\n"      (insert (format "\n(setq idlwave-system-directory \"%s\")\n"
5109                      idlwave-system-directory))                      idlwave-system-directory))
5110      
5111      ;; Define the variable which contains a list of all scanned directories      ;; Define the variable which contains a list of all scanned directories
5112      (insert "\n(setq idlwave-path-alist\n    '(")      (insert "\n(setq idlwave-path-alist\n    '(")
5113      (let ((standard-output (current-buffer)))      (let ((standard-output (current-buffer)))
# Line 5132  directories and save the routine info. Line 5147  directories and save the routine info.
5147        (when (file-directory-p dir)        (when (file-directory-p dir)
5148          (setq files (nreverse (directory-files dir t "[^.]")))          (setq files (nreverse (directory-files dir t "[^.]")))
5149          (while (setq file (pop files))          (while (setq file (pop files))
5150            (if (file-directory-p file)            (if (file-directory-p file)
5151                (push (file-name-as-directory file) path)))                (push (file-name-as-directory file) path)))
5152          (push dir path1)))          (push dir path1)))
5153      path1))      path1))
# Line 5140  directories and save the routine info. Line 5155  directories and save the routine info.
5155    
5156  ;;----- Scanning the library catalogs ------------------  ;;----- Scanning the library catalogs ------------------
5157    
5158    
5159    
5160    
5161  (defun idlwave-scan-library-catalogs (&optional message-base no-load)  (defun idlwave-scan-library-catalogs (&optional message-base no-load)
5162    "Scan for library catalog files (.idlwave_catalog) and ingest.    "Scan for library catalog files (.idlwave_catalog) and ingest.  
5163    
5164  All directories on `idlwave-path-alist' (or `idlwave-library-path'  All directories on `idlwave-path-alist' (or `idlwave-library-path'
5165  instead, if present) are searched.  Print MESSAGE-BASE along with the  instead, if present) are searched.  Print MESSAGE-BASE along with the
# Line 5149  libraries being loaded, if passed, and s Line 5167  libraries being loaded, if passed, and s
5167  NO-LOAD is non-nil.  The variable `idlwave-use-library-catalogs' can  NO-LOAD is non-nil.  The variable `idlwave-use-library-catalogs' can
5168  be set to nil to disable library catalog scanning."  be set to nil to disable library catalog scanning."
5169    (when idlwave-use-library-catalogs    (when idlwave-use-library-catalogs
5170      (let ((dirs      (let ((dirs
5171             (if idlwave-library-path             (if idlwave-library-path
5172                 (idlwave-expand-path idlwave-library-path)                 (idlwave-expand-path idlwave-library-path)
5173               (mapcar 'car idlwave-path-alist)))               (mapcar 'car idlwave-path-alist)))
# Line 5158  be set to nil to disable library catalog Line 5176  be set to nil to disable library catalog
5176        (if message-base (message message-base))        (if message-base (message message-base))
5177        (while (setq dir (pop dirs))        (while (setq dir (pop dirs))
5178          (catch 'continue          (catch 'continue
5179            (when (file-readable-p            (when (file-readable-p
5180                   (setq catalog (expand-file-name ".idlwave_catalog" dir)))                   (setq catalog (expand-file-name ".idlwave_catalog" dir)))
5181              (unless no-load              (unless no-load
5182                (setq idlwave-library-catalog-routines nil)                (setq idlwave-library-catalog-routines nil)
# Line 5166  be set to nil to disable library catalog Line 5184  be set to nil to disable library catalog
5184                (condition-case nil                (condition-case nil
5185                    (load catalog t t t)                    (load catalog t t t)
5186                  (error (throw 'continue t)))                  (error (throw 'continue t)))
5187                (when (and                (when (and
5188                       message-base                       message-base
5189                       (not (string= idlwave-library-catalog-libname                       (not (string= idlwave-library-catalog-libname
5190                                     old-libname)))                                     old-libname)))
5191                  (message (concat message-base                  (message (concat message-base
5192                                   idlwave-library-catalog-libname))                                   idlwave-library-catalog-libname))
5193                  (setq old-libname idlwave-library-catalog-libname))                  (setq old-libname idlwave-library-catalog-libname))
5194                (when idlwave-library-catalog-routines                (when idlwave-library-catalog-routines
5195                  (setq all-routines                  (setq all-routines
5196                        (append                        (append
5197                         (idlwave-sintern-rinfo-list                         (idlwave-sintern-rinfo-list
5198                          idlwave-library-catalog-routines 'sys dir)                          idlwave-library-catalog-routines 'sys dir)
5199                         all-routines))))                         all-routines))))
5200                
5201              ;;  Add a 'lib flag if on path-alist              ;;  Add a 'lib flag if on path-alist
5202              (when (and idlwave-path-alist              (when (and idlwave-path-alist
5203                         (setq dir-entry (assoc dir idlwave-path-alist)))                         (setq dir-entry (assoc dir idlwave-path-alist)))
# Line 5190  be set to nil to disable library catalog Line 5208  be set to nil to disable library catalog
5208  ;;----- Communicating with the Shell -------------------  ;;----- Communicating with the Shell -------------------
5209    
5210  ;; 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
5211  ;; defined routines.  ;; defined routines.
5212  (defconst idlwave-routine-info.pro  (defconst idlwave-routine-info.pro
5213    "    "
5214  ;; START OF IDLWAVE SUPPORT ROUTINES  ;; START OF IDLWAVE SUPPORT ROUTINES
5215  pro idlwave_print_info_entry,name,func=func,separator=sep  pro idlwave_print_info_entry,name,func=func,separator=sep
5216    ;; See if it's an object method    ;; See if it's an object method
5217    if name eq '' then return    if name eq '' then return
5218    func    = keyword_set(func)    func    = keyword_set(func)
5219    methsep = strpos(name,'::')    methsep = strpos(name,'::')
5220    meth    = methsep ne -1    meth    = methsep ne -1
5221      
5222    ;; Get routine info    ;; Get routine info
5223    pars   = routine_info(name,/parameters,functions=func)    pars   = routine_info(name,/parameters,functions=func)
5224    source = routine_info(name,/source,functions=func)    source = routine_info(name,/source,functions=func)
# Line 5208  pro idlwave_print_info_entry,name,func=f Line 5226  pro idlwave_print_info_entry,name,func=f
5226    nkw    = pars.num_kw_args    nkw    = pars.num_kw_args
5227    if nargs gt 0 then args = pars.args    if nargs gt 0 then args = pars.args
5228    if nkw   gt 0 then kwargs = pars.kw_args    if nkw   gt 0 then kwargs = pars.kw_args
5229      
5230    ;; Trim the class, and make the name    ;; Trim the class, and make the name
5231    if meth then begin    if meth then begin
5232        class = strmid(name,0,methsep)        class = strmid(name,0,methsep)
5233        name  = strmid(name,methsep+2,strlen(name)-1)        name  = strmid(name,methsep+2,strlen(name)-1)
5234        if nargs gt 0 then begin        if nargs gt 0 then begin
5235            ;; remove the self argument            ;; remove the self argument
5236            wh = where(args ne 'SELF',nargs)            wh = where(args ne 'SELF',nargs)
5237            if nargs gt 0 then args = args[wh]            if nargs gt 0 then args = args[wh]
# Line 5222  pro idlwave_print_info_entry,name,func=f Line 5240  pro idlwave_print_info_entry,name,func=f
5240        ;; No class, just a normal routine.        ;; No class, just a normal routine.
5241        class = \"\"        class = \"\"
5242    endelse    endelse
5243      
5244    ;; Calling sequence    ;; Calling sequence
5245    cs = \"\"    cs = \"\"
5246    if func then cs = 'Result = '    if func then cs = 'Result = '
# Line 5243  pro idlwave_print_info_entry,name,func=f Line 5261  pro idlwave_print_info_entry,name,func=f
5261            kwstring = kwstring + ' ' + kwargs[j]            kwstring = kwstring + ' ' + kwargs[j]
5262        endfor        endfor
5263    endif    endif
5264      
5265    ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func]    ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func]
5266      
5267    print,ret + ': ' + name + sep + class + sep + source[0].path  $    print,ret + ': ' + name + sep + class + sep + source[0].path  $
5268      + sep + cs + sep + kwstring      + sep + cs + sep + kwstring
5269  end  end
# Line 5285  pro idlwave_get_class_tags, class Line 5303  pro idlwave_get_class_tags, class
5303    if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single)    if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single)
5304  end  end
5305  ;; END OF IDLWAVE SUPPORT ROUTINES  ;; END OF IDLWAVE SUPPORT ROUTINES
5306  "  "
5307    "The idl programs to get info from the shell.")    "The idl programs to get info from the shell.")
5308    
5309  (defvar idlwave-idlwave_routine_info-compiled nil  (defvar idlwave-idlwave_routine_info-compiled nil
# Line 5308  end Line 5326  end
5326        (erase-buffer)        (erase-buffer)
5327        (insert idlwave-routine-info.pro)        (insert idlwave-routine-info.pro)
5328        (save-buffer 0))        (save-buffer 0))
5329      (idlwave-shell-send-command      (idlwave-shell-send-command
5330       (concat ".run " idlwave-shell-temp-pro-file)       (concat ".run " idlwave-shell-temp-pro-file)
5331       nil 'hide wait)       nil 'hide wait)
5332  ;    (message "SENDING SAVE") ; ????????????????????????  ;    (message "SENDING SAVE") ; ????????????????????????
5333      (idlwave-shell-send-command      (idlwave-shell-send-command
5334       (format "save,'idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES"       (format "save,'idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES"
5335               (idlwave-shell-temp-file 'rinfo))               (idlwave-shell-temp-file 'rinfo))
5336       nil 'hide wait))       nil 'hide wait))
5337    
# Line 5396  When we force a method or a method keywo Line 5414  When we force a method or a method keywo
5414           (completion-regexp-list           (completion-regexp-list
5415            (if (equal arg '(16))            (if (equal arg '(16))
5416                (list (read-string (concat "Completion Regexp: "))))))                (list (read-string (concat "Completion Regexp: "))))))
5417        
5418      (if (and module (string-match "::" module))      (if (and module (string-match "::" module))
5419          (setq class (substring module 0 (match-beginning 0))          (setq class (substring module 0 (match-beginning 0))
5420                module (substring module (match-end 0))))                module (substring module (match-end 0))))
# Line 5417  When we force a method or a method keywo Line 5435  When we force a method or a method keywo
5435       ;; Check for any special completion functions       ;; Check for any special completion functions
5436       ((and idlwave-complete-special       ((and idlwave-complete-special
5437             (idlwave-call-special idlwave-complete-special)))             (idlwave-call-special idlwave-complete-special)))
5438        
5439       ((null what)       ((null what)
5440        (error "Nothing to complete here"))        (error "Nothing to complete here"))
5441    
# Line 5434  When we force a method or a method keywo Line 5452  When we force a method or a method keywo
5452                                (idlwave-all-class-inherits class-selector)))                                (idlwave-all-class-inherits class-selector)))
5453               (isa (concat "procedure" (if class-selector "-method" "")))               (isa (concat "procedure" (if class-selector "-method" "")))
5454               (type-selector 'pro))               (type-selector 'pro))
5455          (setq idlwave-completion-help-info          (setq idlwave-completion-help-info
5456                (list 'routine nil type-selector class-selector nil super-classes))                (list 'routine nil type-selector class-selector nil super-classes))
5457          (idlwave-complete-in-buffer          (idlwave-complete-in-buffer
5458           'procedure (if class-selector 'method 'routine)           'procedure (if class-selector 'method 'routine)
# Line 5442  When we force a method or a method keywo Line 5460  When we force a method or a method keywo
5460           (format "Select a %s name%s"           (format "Select a %s name%s"
5461                   isa                   isa
5462                   (if class-selector                   (if class-selector
5463                       (format " (class is %s)"                       (format " (class is %s)"
5464                               (if (eq class-selector t)                               (if (eq class-selector t)
5465                                   "unknown" class-selector))                                   "unknown" class-selector))
5466                     ""))                     ""))
5467           isa           isa
# Line 5457  When we force a method or a method keywo Line 5475  When we force a method or a method keywo
5475                                (idlwave-all-class-inherits class-selector)))                                (idlwave-all-class-inherits class-selector)))
5476               (isa (concat "function" (if class-selector "-method" "")))               (isa (concat "function" (if class-selector "-method" "")))
5477               (type-selector 'fun))               (type-selector 'fun))
5478          (setq idlwave-completion-help-info          (setq idlwave-completion-help-info
5479                (list 'routine nil type-selector class-selector nil super-classes))                (list 'routine nil type-selector class-selector nil super-classes))
5480          (idlwave-complete-in-buffer          (idlwave-complete-in-buffer
5481           'function (if class-selector 'method 'routine)           'function (if class-selector 'method 'routine)
# Line 5465  When we force a method or a method keywo Line 5483  When we force a method or a method keywo
5483           (format "Select a %s name%s"           (format "Select a %s name%s"
5484                   isa                   isa
5485                   (if class-selector                   (if class-selector
5486                       (format " (class is %s)"                       (format " (class is %s)"
5487                               (if (eq class-selector t)                               (if (eq class-selector t)
5488                                   "unknown" class-selector))                                   "unknown" class-selector))
5489                     ""))                     ""))
# Line 5488  When we force a method or a method keywo Line 5506  When we force a method or a method keywo
5506               (isa (format "procedure%s-keyword" (if class "-method" "")))               (isa (format "procedure%s-keyword" (if class "-method" "")))
5507               (entry (idlwave-best-rinfo-assq               (entry (idlwave-best-rinfo-assq
5508                       name 'pro class (idlwave-routines)))                       name 'pro class (idlwave-routines)))
5509                 (system (if entry (eq (car (nth 3 entry)) 'system)))
5510               (list (idlwave-entry-keywords entry 'do-link)))               (list (idlwave-entry-keywords entry 'do-link)))
5511          (unless (or entry (eq class t))          (unless (or entry (eq class t))
5512            (error "Nothing known about procedure %s"            (error "Nothing known about procedure %s"
5513                   (idlwave-make-full-name class name)))                   (idlwave-make-full-name class name)))
5514          (setq list (idlwave-fix-keywords name 'pro class list super-classes))          (setq list (idlwave-fix-keywords name 'pro class list
5515                                             super-classes system))
5516          (unless list (error "No keywords available for procedure %s"          (unless list (error "No keywords available for procedure %s"
5517                              (idlwave-make-full-name class name)))                              (idlwave-make-full-name class name)))
5518          (setq idlwave-completion-help-info          (setq idlwave-completion-help-info
5519                (list 'keyword name type-selector class-selector entry super-classes))                (list 'keyword name type-selector class-selector entry super-classes))
5520          (idlwave-complete-in-buffer          (idlwave-complete-in-buffer
5521           'keyword 'keyword list nil           'keyword 'keyword list nil
5522           (format "Select keyword for procedure %s%s"           (format "Select keyword for procedure %s%s"
5523                   (idlwave-make-full-name class name)                   (idlwave-make-full-name class name)
5524                   (if (or (member '("_EXTRA") list)                   (if (or (member '("_EXTRA") list)
5525                           (member '("_REF_EXTRA") list))                           (member '("_REF_EXTRA") list))                  
5526                       " (note _EXTRA)" ""))                       " (note _EXTRA)" ""))
5527           isa           isa
5528           'idlwave-attach-keyword-classes)))           'idlwave-attach-keyword-classes)))
# Line 5519  When we force a method or a method keywo Line 5539  When we force a method or a method keywo
5539               (isa (format "function%s-keyword" (if class "-method" "")))               (isa (format "function%s-keyword" (if class "-method" "")))
5540               (entry (idlwave-best-rinfo-assq               (entry (idlwave-best-rinfo-assq
5541                       name 'fun class (idlwave-routines)))                       name 'fun class (idlwave-routines)))
5542                 (system (if entry (eq (car (nth 3 entry)) 'system)))
5543               (list (idlwave-entry-keywords entry 'do-link))               (list (idlwave-entry-keywords entry 'do-link))
5544               msg-name)               msg-name)
5545          (unless (or entry (eq class t))          (unless (or entry (eq class t))
5546            (error "Nothing known about function %s"            (error "Nothing known about function %s"
5547                   (idlwave-make-full-name class name)))                   (idlwave-make-full-name class name)))
5548          (setq list (idlwave-fix-keywords name 'fun class list super-classes))          (setq list (idlwave-fix-keywords name 'fun class list
5549                                             super-classes system))
5550          ;; OBJ_NEW: Messages mention the proper Init method          ;; OBJ_NEW: Messages mention the proper Init method
5551          (setq msg-name (if (and (null class)          (setq msg-name (if (and (null class)
5552                                  (string= (upcase name) "OBJ_NEW"))                                  (string= (upcase name) "OBJ_NEW"))
# Line 5532  When we force a method or a method keywo Line 5554  When we force a method or a method keywo
5554                                     "::Init (via OBJ_NEW)")                                     "::Init (via OBJ_NEW)")
5555                           (idlwave-make-full-name class name)))                           (idlwave-make-full-name class name)))
5556          (unless list (error "No keywords available for function %s"          (unless list (error "No keywords available for function %s"
5557                              msg-name))                              msg-name))
5558          (setq idlwave-completion-help-info          (setq idlwave-completion-help-info
5559                (list 'keyword name type-selector class-selector nil super-classes))                (list 'keyword name type-selector class-selector nil super-classes))
5560          (idlwave-complete-in-buffer          (idlwave-complete-in-buffer
5561           'keyword 'keyword list nil           'keyword 'keyword list nil
5562           (format "Select keyword for function %s%s" msg-name           (format "Select keyword for function %s%s" msg-name
5563                   (if (or (member '("_EXTRA") list)                   (if (or (member '("_EXTRA") list)
5564                           (member '("_REF_EXTRA") list))                           (member '("_REF_EXTRA") list))                  
5565                       " (note _EXTRA)" ""))                       " (note _EXTRA)" ""))
5566           isa           isa
5567           'idlwave-attach-keyword-classes)))           'idlwave-attach-keyword-classes)))
# Line 5577  other completions will be tried.") Line 5599  other completions will be tried.")
5599                        ("class")))                        ("class")))
5600           (module (idlwave-sintern-routine-or-method module class))           (module (idlwave-sintern-routine-or-method module class))
5601           (class (idlwave-sintern-class class))           (class (idlwave-sintern-class class))
5602           (what (cond           (what (cond
5603                  ((equal what 0)                  ((equal what 0)
5604                   (setq what                   (setq what
5605                         (intern (completing-read                         (intern (completing-read
5606                                  "Complete what? " what-list nil t))))                                  "Complete what? " what-list nil t))))
5607                  ((integerp what)                  ((integerp what)
5608                   (setq what (intern (car (nth (1- what) what-list)))))                   (setq what (intern (car (nth (1- what) what-list)))))
# Line 5602  other completions will be tried.") Line 5624  other completions will be tried.")
5624               (super-classes nil)               (super-classes nil)
5625               (type-selector 'pro)               (type-selector 'pro)
5626               (pro (or module               (pro (or module
5627                        (idlwave-completing-read                        (idlwave-completing-read
5628                         "Procedure: " (idlwave-routines) 'idlwave-selector))))                         "Procedure: " (idlwave-routines) 'idlwave-selector))))
5629          (setq pro (idlwave-sintern-routine pro))          (setq pro (idlwave-sintern-routine pro))
5630          (list nil-list nil-list 'procedure-keyword          (list nil-list nil-list 'procedure-keyword
# Line 5616  other completions will be tried.") Line 5638  other completions will be tried.")
5638               (super-classes nil)               (super-classes nil)
5639               (type-selector 'fun)               (type-selector 'fun)
5640               (func (or module               (func (or module
5641                         (idlwave-completing-read                         (idlwave-completing-read
5642                          "Function: " (idlwave-routines) 'idlwave-selector))))                          "Function: " (idlwave-routines) 'idlwave-selector))))
5643          (setq func (idlwave-sintern-routine func))          (setq func (idlwave-sintern-routine func))
5644          (list nil-list nil-list 'function-keyword          (list nil-list nil-list 'function-keyword
# Line 5656  other completions will be tried.") Line 5678  other completions will be tried.")
5678    
5679       ((eq what 'class)       ((eq what 'class)
5680        (list nil-list nil-list 'class nil-list nil))        (list nil-list nil-list 'class nil-list nil))
5681        
5682       (t (error "Invalid value for WHAT")))))       (t (error "Invalid value for WHAT")))))
5683    
5684  (defun idlwave-completing-read (&rest args)  (defun idlwave-completing-read (&rest args)
# Line 5679  other completions will be tried.") Line 5701  other completions will be tried.")
5701                      (stringp idlwave-shell-default-directory)                      (stringp idlwave-shell-default-directory)
5702                      (file-directory-p idlwave-shell-default-directory))                      (file-directory-p idlwave-shell-default-directory))
5703                 idlwave-shell-default-directory                 idlwave-shell-default-directory
5704               default-directory)))               default-directory)))          
5705      (comint-dynamic-complete-filename)))      (comint-dynamic-complete-filename)))
5706    
5707  (defun idlwave-make-full-name (class name)  (defun idlwave-make-full-name (class name)
# Line 5688  other completions will be tried.") Line 5710  other completions will be tried.")
5710    
5711  (defun idlwave-rinfo-assoc (name type class list)  (defun idlwave-rinfo-assoc (name type class list)
5712    "Like `idlwave-rinfo-assq', but sintern strings first."    "Like `idlwave-rinfo-assq', but sintern strings first."
5713    (idlwave-rinfo-assq    (idlwave-rinfo-assq
5714     (idlwave-sintern-routine-or-method name class)     (idlwave-sintern-routine-or-method name class)
5715     type (idlwave-sintern-class class) list))     type (idlwave-sintern-class class) list))
5716    
# Line 5712  other completions will be tried.") Line 5734  other completions will be tried.")
5734            (setq classes nil)))            (setq classes nil)))
5735      rtn))      rtn))
5736    
5737  (defun idlwave-best-rinfo-assq (name type class list &optional with-file  (defun idlwave-best-rinfo-assq (name type class list &optional with-file
5738                                       keep-system)                                       keep-system)
5739    "Like `idlwave-rinfo-assq', but get all twins and sort, then return first.    "Like `idlwave-rinfo-assq', but get all twins and sort, then return first.
5740  If WITH-FILE is passed, find the best rinfo entry with a file  If WITH-FILE is passed, find the best rinfo entry with a file
# Line 5737  syslib files." Line 5759  syslib files."
5759                                      twins)))))                                      twins)))))
5760      (car twins)))      (car twins)))
5761    
5762  (defun idlwave-best-rinfo-assoc (name type class list &optional with-file  (defun idlwave-best-rinfo-assoc (name type class list &optional with-file
5763                                       keep-system)                                       keep-system)
5764    "Like `idlwave-best-rinfo-assq', but sintern strings first."    "Like `idlwave-best-rinfo-assq', but sintern strings first."
5765    (idlwave-best-rinfo-assq    (idlwave-best-rinfo-assq
# Line 5828  INFO is as returned by idlwave-what-func Line 5850  INFO is as returned by idlwave-what-func
5850  Must accept two arguments: `apos' and `info'")  Must accept two arguments: `apos' and `info'")
5851    
5852  (defun idlwave-determine-class (info type)  (defun idlwave-determine-class (info type)
5853    ;; Determine the class of a routine call.    ;; Determine the class of a routine call.  
5854    ;; INFO is the `cw-list' structure as returned by idlwave-where.    ;; INFO is the `cw-list' structure as returned by idlwave-where.
5855    ;; The second element in this structure is the class.  When nil, we    ;; The second element in this structure is the class.  When nil, we
5856    ;; 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 5848  Must accept two arguments: `apos' and `i Line 5870  Must accept two arguments: `apos' and `i
5870                        (dassoc (cdr dassoc))                        (dassoc (cdr dassoc))
5871                        (t t)))                        (t t)))
5872           (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->")))           (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->")))
5873           (is-self           (is-self
5874            (and arrow            (and arrow
5875                 (save-excursion (goto-char apos)                 (save-excursion (goto-char apos)
5876                                 (forward-word -1)                                 (forward-word -1)
# Line 5869  Must accept two arguments: `apos' and `i Line 5891  Must accept two arguments: `apos' and `i
5891            (setq class (or (nth 2 (idlwave-current-routine)) class)))            (setq class (or (nth 2 (idlwave-current-routine)) class)))
5892    
5893        ;; Before prompting, try any special class determination routines        ;; Before prompting, try any special class determination routines
5894        (when (and (eq t class)        (when (and (eq t class)
5895                   idlwave-determine-class-special                   idlwave-determine-class-special
5896                   (not force-query))                   (not force-query))
5897          (setq special-class          (setq special-class
5898                (idlwave-call-special idlwave-determine-class-special apos))                (idlwave-call-special idlwave-determine-class-special apos))
5899          (if special-class          (if special-class
5900              (setq class (idlwave-sintern-class special-class)              (setq class (idlwave-sintern-class special-class)
5901                    store idlwave-store-inquired-class)))                    store idlwave-store-inquired-class)))
5902          
5903        ;; Prompt for a class, if we need to        ;; Prompt for a class, if we need to
5904        (when (and (eq class t)        (when (and (eq class t)
5905                   (or force-query query))                   (or force-query query))
5906          (setq class-alist          (setq class-alist
5907                (mapcar 'list (idlwave-all-method-classes (car info) type)))                (mapcar 'list (idlwave-all-method-classes (car info) type)))
5908          (setq class          (setq class
5909                (idlwave-sintern-class                (idlwave-sintern-class
# Line 5890  Must accept two arguments: `apos' and `i Line 5912  Must accept two arguments: `apos' and `i
5912                   (error "No classes available with method %s" (car info)))                   (error "No classes available with method %s" (car info)))
5913                  ((and (= (length class-alist) 1) (not force-query))                  ((and (= (length class-alist) 1) (not force-query))
5914                   (car (car class-alist)))                   (car (car class-alist)))
5915                  (t                  (t
5916                   (setq store idlwave-store-inquired-class)                   (setq store idlwave-store-inquired-class)
5917                   (idlwave-completing-read                   (idlwave-completing-read
5918                    (format "Class%s: " (if (stringp (car info))                    (format "Class%s: " (if (stringp (car info))
5919                                            (format " for %s method %s"                                            (format " for %s method %s"
5920                                                    type (car info))                                                    type (car info))
# Line 5904  Must accept two arguments: `apos' and `i Line 5926  Must accept two arguments: `apos' and `i
5926          ;; We have a real class here          ;; We have a real class here
5927          (when (and store arrow)          (when (and store arrow)
5928            (condition-case ()            (condition-case ()
5929                (add-text-properties                (add-text-properties
5930                 apos (+ apos 2)                 apos (+ apos 2)
5931                 `(idlwave-class ,class face ,idlwave-class-arrow-face                 `(idlwave-class ,class face ,idlwave-class-arrow-face
5932                                 rear-nonsticky t))                                 rear-nonsticky t))
5933              (error nil)))              (error nil)))
5934          (setf (nth 2 info) class))          (setf (nth 2 info) class))
# Line 5934  Must accept two arguments: `apos' and `i Line 5956  Must accept two arguments: `apos' and `i
5956    
5957    
5958  (defun idlwave-where ()  (defun idlwave-where ()
5959    "Find out where we are.    "Find out where we are.
5960  The return value is a list with the following stuff:  The return value is a list with the following stuff:
5961  \(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR)  \(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR)
5962    
5963  PRO-LIST       (PRO POINT CLASS ARROW)  PRO-LIST       (PRO POINT CLASS ARROW)
5964  FUNC-LIST      (FUNC POINT CLASS ARROW)  FUNC-LIST      (FUNC POINT CLASS ARROW)
5965  COMPLETE-WHAT  a symbol indicating what kind of completion makes sense here  COMPLETE-WHAT  a symbol indicating what kind of completion makes sense here
5966  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
5967                 be completed here.                 be completed here.
5968  LAST-CHAR      last relevant character before point (non-white non-comment,  LAST-CHAR      last relevant character before point (non-white non-comment,
5969                 not part of current identifier or leading slash).                 not part of current identifier or leading slash).
# Line 5953  POINT:  Where is this Line 5975  POINT:  Where is this
5975  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)
5976  ARROW:  Location of the arrow"  ARROW:  Location of the arrow"
5977    (idlwave-routines)    (idlwave-routines)
5978    (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point)))    (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point)))
5979           (bos (save-excursion (idlwave-start-of-substatement 'pre) (point)))           (bos (save-excursion (idlwave-start-of-substatement 'pre) (point)))
5980           (func-entry (idlwave-what-function bos))           (func-entry (idlwave-what-function bos))
5981           (func (car func-entry))           (func (car func-entry))
# Line 5975  ARROW:  Location of the arrow" Line 5997  ARROW:  Location of the arrow"
5997       ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'"       ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'"
5998                      match-string)                      match-string)
5999        (setq cw 'class))        (setq cw 'class))
6000       ((string-match       ((string-match
6001         "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'"         "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'"
6002         (if (> pro-point 0)         (if (> pro-point 0)
6003             (buffer-substring pro-point (point))             (buffer-substring pro-point (point))
6004           match-string))           match-string))
# Line 5987  ARROW:  Location of the arrow" Line 6009  ARROW:  Location of the arrow"
6009        nil)        nil)
6010       ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'"       ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'"
6011                      match-string)                      match-string)
6012        (setq cw 'class))        (setq cw 'class))                    
6013       ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'"       ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'"
6014                      match-string)                      match-string)
6015        (setq cw 'class))        (setq cw 'class))                    
6016       ((and func       ((and func
6017             (> func-point pro-point)             (> func-point pro-point)
6018             (= func-level 1)             (= func-level 1)
6019             (memq last-char '(?\( ?,)))             (memq last-char '(?\( ?,)))
# Line 6037  ARROW:  Location of the arrow" Line 6059  ARROW:  Location of the arrow"
6059    ;;    searches to this point.    ;;    searches to this point.
6060    
6061    (catch 'exit    (catch 'exit
6062      (let (pos      (let (pos
6063            func-point            func-point
6064            (cnt 0)            (cnt 0)
6065            func arrow-start class)            func arrow-start class)
# Line 6052  ARROW:  Location of the arrow" Line 6074  ARROW:  Location of the arrow"
6074               (setq pos (point))               (setq pos (point))
6075               (incf cnt)               (incf cnt)
6076               (when (and (= (following-char) ?\()               (when (and (= (following-char) ?\()
6077                          (re-search-backward                          (re-search-backward
6078                           "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\="                           "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\="
6079                           bound t))                           bound t))
6080                 (setq func (match-string 2)                 (setq func (match-string 2)
6081                       func-point (goto-char (match-beginning 2))                       func-point (goto-char (match-beginning 2))
6082                       pos func-point)                       pos func-point)
6083                 (if (re-search-backward                 (if (re-search-backward
6084                      "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t)                      "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t)
6085                     (setq arrow-start (copy-marker (match-beginning 0))                     (setq arrow-start (copy-marker (match-beginning 0))
6086                           class (or (match-string 2) t)))                           class (or (match-string 2) t)))
6087                 (throw                 (throw
6088                  'exit                  'exit
6089                  (list                  (list
6090                   (idlwave-sintern-routine-or-method func class)                   (idlwave-sintern-routine-or-method func class)
6091                   (idlwave-sintern-class class)                   (idlwave-sintern-class class)
# Line 6079  ARROW:  Location of the arrow" Line 6101  ARROW:  Location of the arrow"
6101    ;;    searches to this point.    ;;    searches to this point.
6102    (let ((pos (point)) pro-point    (let ((pos (point)) pro-point
6103          pro class arrow-start string)          pro class arrow-start string)
6104      (save-excursion      (save-excursion
6105        ;;(idlwave-beginning-of-statement)        ;;(idlwave-beginning-of-statement)
6106        (idlwave-start-of-substatement 'pre)        (idlwave-start-of-substatement 'pre)
6107        (setq string (buffer-substring (point) pos))        (setq string (buffer-substring (point) pos))
6108        (if (string-match        (if (string-match
6109             "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string)             "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string)
6110            (setq pro (match-string 1 string)            (setq pro (match-string 1 string)
6111                  pro-point (+ (point) (match-beginning 1)))                  pro-point (+ (point) (match-beginning 1)))
6112          (if (and (idlwave-skip-object)          (if (and (idlwave-skip-object)
6113                   (setq string (buffer-substring (point) pos))                   (setq string (buffer-substring (point) pos))
6114                   (string-match                   (string-match
6115                    "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)"                    "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)"
6116                    string))                    string))
6117              (setq pro (if (match-beginning 4)              (setq pro (if (match-beginning 4)
6118                            (match-string 4 string))                            (match-string 4 string))
# Line 6134  ARROW:  Location of the arrow" Line 6156  ARROW:  Location of the arrow"
6156                (throw 'exit nil))))                (throw 'exit nil))))
6157          (goto-char pos)          (goto-char pos)
6158        nil)))        nil)))
6159      
6160  (defun idlwave-last-valid-char ()  (defun idlwave-last-valid-char ()
6161    "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
6162  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 6155  This function is not general, can only b Line 6177  This function is not general, can only b
6177           ((memq (preceding-char) '(?\; ?\$)) (throw 'exit nil))           ((memq (preceding-char) '(?\; ?\$)) (throw 'exit nil))
6178           ((eq (preceding-char) ?\n)           ((eq (preceding-char) ?\n)
6179            (beginning-of-line 0)            (beginning-of-line 0)
6180            (if (looking-at "\\([^;\n]*\\)\\$[ \t]*\\(;[^\n]*\\)?\n")            (if (looking-at "\\([^\n]*\\)\\$[ \t]*\\(;[^\n]*\\)?\n")
6181                ;; continuation line                ;; continuation line
6182                (goto-char (match-end 1))                (goto-char (match-end 1))
6183              (throw 'exit nil)))              (throw 'exit nil)))
# Line 6224  accumulate information on matching compl Line 6246  accumulate information on matching compl
6246       ((or (eq completion t)       ((or (eq completion t)
6247            (and (= 1 (length (setq all-completions            (and (= 1 (length (setq all-completions
6248                                    (idlwave-uniquify                                    (idlwave-uniquify
6249                                     (all-completions part list                                     (all-completions part list
6250                                                      (or special-selector                                                      (or special-selector
6251                                                          selector))))))                                                          selector))))))
6252                 (equal dpart dcompletion)))                 (equal dpart dcompletion)))
6253        ;; This is already complete        ;; This is already complete
6254        (idlwave-after-successful-completion type slash beg)        (idlwave-after-successful-completion type slash beg)
6255        (message "%s is already the complete %s" part isa)        (message "%s is already the complete %s" part isa)
6256        nil)        nil)
6257       (t       (t        
6258        ;; We cannot add something - offer a list.        ;; We cannot add something - offer a list.
6259        (message "Making completion list...")        (message "Making completion list...")
6260          
6261        (unless idlwave-completion-help-links ; already set somewhere?        (unless idlwave-completion-help-links ; already set somewhere?
6262          (mapcar (lambda (x)  ; Pass link prop through to highlight-linked          (mapcar (lambda (x)  ; Pass link prop through to highlight-linked
6263                    (let ((link (get-text-property 0 'link (car x))))                    (let ((link (get-text-property 0 'link (car x))))
6264                      (if link                      (if link
6265                          (push (cons (car x) link)                          (push (cons (car x) link)
6266                                idlwave-completion-help-links))))                                idlwave-completion-help-links))))
6267                  list))                  list))
6268        (let* ((list all-completions)        (let* ((list all-completions)
# Line 6250  accumulate information on matching compl Line 6272  accumulate information on matching compl
6272  ;            (completion-fixup-function               ; Emacs  ;            (completion-fixup-function               ; Emacs
6273  ;             (lambda () (and (eq (preceding-char) ?>)  ;             (lambda () (and (eq (preceding-char) ?>)
6274  ;                             (re-search-backward " <" beg t)))))  ;                             (re-search-backward " <" beg t)))))
6275                
6276          (setq list (sort list (lambda (a b)          (setq list (sort list (lambda (a b)
6277                                  (string< (downcase a) (downcase b)))))                                  (string< (downcase a) (downcase b)))))
6278          (if prepare-display-function          (if prepare-display-function
# Line 6260  accumulate information on matching compl Line 6282  accumulate information on matching compl
6282                       idlwave-complete-empty-string-as-lower-case)                       idlwave-complete-empty-string-as-lower-case)
6283                   (not idlwave-completion-force-default-case))                   (not idlwave-completion-force-default-case))
6284              (setq list (mapcar (lambda (x)              (setq list (mapcar (lambda (x)
6285                                   (if (listp x)                                   (if (listp x)
6286                                       (setcar x (downcase (car x)))                                       (setcar x (downcase (car x)))
6287                                     (setq x (downcase x)))                                     (setq x (downcase x)))
6288                                   x)                                   x)
# Line 6280  accumulate information on matching compl Line 6302  accumulate information on matching compl
6302             (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\="             (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\="
6303                                 (- (point) 15) t)                                 (- (point) 15) t)
6304             (goto-char (point-min))             (goto-char (point-min))
6305             (re-search-forward             (re-search-forward
6306              "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t))))              "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t))))
6307        ;; Yank the full class specification        ;; Yank the full class specification
6308        (insert (match-string 2))        (insert (match-string 2))
6309      ;; Do the completion, using list gathered from `idlwave-routines'      ;; Do the completion, using list gathered from `idlwave-routines'
6310      (idlwave-complete-in-buffer      (idlwave-complete-in-buffer
6311       'class 'class (idlwave-class-alist) nil       'class 'class (idlwave-class-alist) nil
6312       "Select a class" "class"       "Select a class" "class"
6313       '(lambda (list)  ;; Push it to help-links if system help available       '(lambda (list)  ;; Push it to help-links if system help available
6314          (mapcar (lambda (x)          (mapcar (lambda (x)
6315                    (let* ((entry (idlwave-class-info x))                    (let* ((entry (idlwave-class-info x))
6316                           (link (nth 1 (assq 'link entry))))                           (link (nth 1 (assq 'link entry))))
6317                      (if link (push (cons x link)                      (if link (push (cons x link)
6318                                     idlwave-completion-help-links))                                     idlwave-completion-help-links))
6319                      x))                      x))
6320                  list)))))                  list)))))
# Line 6304  accumulate information on matching compl Line 6326  accumulate information on matching compl
6326    ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'.    ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'.
6327    (if (or (null show-classes)           ; don't want to see classes    (if (or (null show-classes)           ; don't want to see classes
6328            (null class-selector)         ; not a method call            (null class-selector)         ; not a method call
6329            (and            (and
6330             (stringp class-selector) ; the class is already known             (stringp class-selector) ; the class is already known
6331             (not super-classes)))    ; no possibilities for inheritance             (not super-classes)))    ; no possibilities for inheritance
6332        ;; In these cases, we do not have to do anything        ;; In these cases, we do not have to do anything
# Line 6319  accumulate information on matching compl Line 6341  accumulate information on matching compl
6341             (max (abs show-classes))             (max (abs show-classes))
6342             (lmax (if do-dots (apply 'max (mapcar 'length list))))             (lmax (if do-dots (apply 'max (mapcar 'length list))))
6343            classes nclasses class-info space)            classes nclasses class-info space)
6344        (mapcar        (mapcar
6345         (lambda (x)         (lambda (x)
6346           ;; get the classes           ;; get the classes
6347           (if (eq type 'class-tag)           (if (eq type 'class-tag)
6348               ;; Just one class for tags               ;; Just one class for tags
6349               (setq classes               (setq classes
6350                     (list                     (list
6351                      (idlwave-class-or-superclass-with-tag class-selector x)))                      (idlwave-class-or-superclass-with-tag class-selector x)))
6352             ;; Multiple classes for method or method-keyword             ;; Multiple classes for method or method-keyword
6353             (setq classes             (setq classes
# Line 6334  accumulate information on matching compl Line 6356  accumulate information on matching compl
6356                        method-selector x type-selector)                        method-selector x type-selector)
6357                     (idlwave-all-method-classes x type-selector)))                     (idlwave-all-method-classes x type-selector)))
6358             (if inherit             (if inherit
6359                 (setq classes                 (setq classes
6360                       (delq nil                       (delq nil
6361                             (mapcar (lambda (x) (if (memq x inherit) x nil))                             (mapcar (lambda (x) (if (memq x inherit) x nil))
6362                                     classes)))))                                     classes)))))
# Line 6371  accumulate information on matching compl Line 6393  accumulate information on matching compl
6393  (defun idlwave-attach-class-tag-classes (list)  (defun idlwave-attach-class-tag-classes (list)
6394    ;; Call idlwave-attach-classes with class structure tags    ;; Call idlwave-attach-classes with class structure tags
6395    (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes))    (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes))
6396                                            
6397    
6398  ;;----------------------------------------------------------------------  ;;----------------------------------------------------------------------
6399  ;;----------------------------------------------------------------------  ;;----------------------------------------------------------------------
# Line 6392  sort the list before displaying" Line 6414  sort the list before displaying"
6414            ((= 1 (length list))            ((= 1 (length list))
6415             (setq rtn (car list)))             (setq rtn (car list)))
6416            ((featurep 'xemacs)            ((featurep 'xemacs)
6417             (if sort (setq list (sort list (lambda (a b)             (if sort (setq list (sort list (lambda (a b)
6418                                              (string< (upcase a) (upcase b))))))                                              (string< (upcase a) (upcase b))))))
6419             (setq menu             (setq menu
6420                   (append (list title)                   (append (list title)
# Line 6403  sort the list before displaying" Line 6425  sort the list before displaying"
6425             (setq resp (get-popup-menu-response menu))             (setq resp (get-popup-menu-response menu))
6426             (funcall (event-function resp) (event-object resp)))             (funcall (event-function resp) (event-object resp)))
6427            (t            (t
6428             (if sort (setq list (sort list (lambda (a b)             (if sort (setq list (sort list (lambda (a b)
6429                                              (string< (upcase a) (upcase b))))))                                              (string< (upcase a) (upcase b))))))
6430             (setq menu (cons title             (setq menu (cons title
6431                              (list                              (list
# Line 6494  sort the list before displaying" Line 6516  sort the list before displaying"
6516      (setq idlwave-before-completion-wconf (current-window-configuration)))      (setq idlwave-before-completion-wconf (current-window-configuration)))
6517    
6518    (if (featurep 'xemacs)    (if (featurep 'xemacs)
6519        (idlwave-display-completion-list-xemacs        (idlwave-display-completion-list-xemacs
6520         list)         list)
6521      (idlwave-display-completion-list-emacs list))      (idlwave-display-completion-list-emacs list))
6522    
# Line 6575  If these don't exist, a letter in the st Line 6597  If these don't exist, a letter in the st
6597              (mapcar (lambda(x)              (mapcar (lambda(x)
6598                        (princ (nth 1 x))                        (princ (nth 1 x))
6599                        (princ "\n"))                        (princ "\n"))
6600                      keys-alist))                      keys-alist))            
6601            (setq char (read-char)))            (setq char (read-char)))
6602        (setq char (read-char)))        (setq char (read-char)))
6603      (message nil)      (message nil)
# Line 6695  If these don't exist, a letter in the st Line 6717  If these don't exist, a letter in the st
6717  (defun idlwave-make-modified-completion-map-emacs (old-map)  (defun idlwave-make-modified-completion-map-emacs (old-map)
6718    "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."    "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."
6719    (let ((new-map (copy-keymap old-map)))    (let ((new-map (copy-keymap old-map)))
6720      (substitute-key-definition      (substitute-key-definition
6721       'choose-completion 'idlwave-choose-completion new-map)       'choose-completion 'idlwave-choose-completion new-map)
6722      (substitute-key-definition      (substitute-key-definition
6723       'mouse-choose-completion 'idlwave-mouse-choose-completion new-map)       'mouse-choose-completion 'idlwave-mouse-choose-completion new-map)
# Line 6721  If these don't exist, a letter in the st Line 6743  If these don't exist, a letter in the st
6743  ;;  ;;
6744  ;; - Go again over the documentation how to write a completion  ;; - Go again over the documentation how to write a completion
6745  ;;   plugin.  It is in self.el, but currently still very bad.  ;;   plugin.  It is in self.el, but currently still very bad.
6746  ;;   This could be in a separate file in the distribution, or  ;;   This could be in a separate file in the distribution, or
6747  ;;   in an appendix for the manual.  ;;   in an appendix for the manual.  
6748    
6749  (defvar idlwave-struct-skip  (defvar idlwave-struct-skip
6750    "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*"    "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*"
# Line 6761  Point is expected just before the openin Line 6783  Point is expected just before the openin
6783           (beg (car borders))           (beg (car borders))
6784           (end (cdr borders))           (end (cdr borders))
6785           (case-fold-search t))           (case-fold-search t))
6786      (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:")      (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:")
6787                         end t)))                         end t)))
6788    
6789  (defun idlwave-struct-inherits ()  (defun idlwave-struct-inherits ()
# Line 6776  Point is expected just before the openin Line 6798  Point is expected just before the openin
6798        (goto-char beg)        (goto-char beg)
6799        (save-restriction        (save-restriction
6800          (narrow-to-region beg end)          (narrow-to-region beg end)
6801          (while (re-search-forward          (while (re-search-forward
6802                  (concat "[{,]"  ;leading comma/brace                  (concat "[{,]"  ;leading comma/brace
6803                          idlwave-struct-skip ; 4 groups                          idlwave-struct-skip ; 4 groups
6804                          "inherits"    ; The INHERITS tag                          "inherits"    ; The INHERITS tag
# Line 6826  backward." Line 6848  backward."
6848                    (concat "\\<" (regexp-quote (downcase var)) "\\>" ws)                    (concat "\\<" (regexp-quote (downcase var)) "\\>" ws)
6849                  "\\(\\)")                  "\\(\\)")
6850                "=" ws "\\({\\)"                "=" ws "\\({\\)"
6851                (if name                (if name
6852                    (if (stringp name)                    (if (stringp name)
6853                        (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]")                        (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]")
6854                      ;; Just a generic name                      ;; Just a generic name
6855                      (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ","))                      (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ","))
6856                  ""))))                  ""))))
# Line 6839  backward." Line 6861  backward."
6861            (goto-char (match-beginning 3))            (goto-char (match-beginning 3))
6862            (match-string-no-properties 5)))))            (match-string-no-properties 5)))))
6863    
6864  (defvar idlwave-class-info nil)  (defvar idlwave-class-info nil)
6865  (defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo  (defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo
6866  (defvar idlwave-class-reset nil) ; to reset buffer-local classes  (defvar idlwave-class-reset nil) ; to reset buffer-local classes
6867    
# Line 6852  backward." Line 6874  backward."
6874    (let (list entry)    (let (list entry)
6875      (if idlwave-class-info      (if idlwave-class-info
6876          (if idlwave-class-reset          (if idlwave-class-reset
6877              (setq              (setq          
6878               idlwave-class-reset nil               idlwave-class-reset nil
6879               idlwave-class-info ; Remove any visited in a buffer               idlwave-class-info ; Remove any visited in a buffer
6880               (delq nil (mapcar               (delq nil (mapcar
6881                          (lambda (x)                          (lambda (x)
6882                            (let ((filebuf                            (let ((filebuf
6883                                   (idlwave-class-file-or-buffer                                   (idlwave-class-file-or-buffer
6884                                    (or (cdr (assq 'found-in x)) (car x)))))                                    (or (cdr (assq 'found-in x)) (car x)))))
6885                              (if (cdr filebuf)                              (if (cdr filebuf)
6886                                  nil                                  nil
# Line 6896  class/struct definition" Line 6918  class/struct definition"
6918            (progn            (progn
6919              ;; For everything there              ;; For everything there
6920              (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point)))              (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point)))
6921              (while (setq name              (while (setq name
6922                           (idlwave-find-structure-definition nil t end-lim))                           (idlwave-find-structure-definition nil t end-lim))
6923                (funcall all-hook name)))                (funcall all-hook name)))
6924          (idlwave-find-structure-definition nil (or alt-class class))))))          (idlwave-find-structure-definition nil (or alt-class class))))))
# Line 6934  class/struct definition" Line 6956  class/struct definition"
6956            (insert-file-contents file))            (insert-file-contents file))
6957          (save-excursion          (save-excursion
6958            (goto-char 1)            (goto-char 1)
6959            (idlwave-find-class-definition class            (idlwave-find-class-definition class
6960             ;; Scan all of the structures found there             ;; Scan all of the structures found there
6961             (lambda (name)             (lambda (name)
6962               (let* ((this-class (idlwave-sintern-class name))               (let* ((this-class (idlwave-sintern-class name))
6963                      (entry                      (entry
6964                       (list this-class                       (list this-class
6965                             (cons 'tags (idlwave-struct-tags))                             (cons 'tags (idlwave-struct-tags))
6966                             (cons 'inherits (idlwave-struct-inherits)))))                             (cons 'inherits (idlwave-struct-inherits)))))
# Line 6963  class/struct definition" Line 6985  class/struct definition"
6985    (condition-case err    (condition-case err
6986        (apply 'append (mapcar 'idlwave-class-tags        (apply 'append (mapcar 'idlwave-class-tags
6987                               (cons class (idlwave-all-class-inherits class))))                               (cons class (idlwave-all-class-inherits class))))
6988      (error      (error          
6989       (idlwave-class-tag-reset)       (idlwave-class-tag-reset)
6990       (error "%s" (error-message-string err)))))       (error "%s" (error-message-string err)))))
6991    
# Line 7000  The list is cached in `idlwave-class-inf Line 7022  The list is cached in `idlwave-class-inf
7022            all-inherits))))))            all-inherits))))))
7023    
7024  (defun idlwave-entry-keywords (entry &optional record-link)  (defun idlwave-entry-keywords (entry &optional record-link)
7025    "Return the flat entry keywords alist from routine-info entry.    "Return the flat entry keywords alist from routine-info entry.  
7026  If RECORD-LINK is non-nil, the keyword text is copied and a text  If RECORD-LINK is non-nil, the keyword text is copied and a text
7027  property indicating the link is added."  property indicating the link is added."
7028    (let (kwds)    (let (kwds)
7029      (mapcar      (mapcar
7030       (lambda (key-list)       (lambda (key-list)
7031         (let ((file (car key-list)))         (let ((file (car key-list)))
7032           (mapcar (lambda (key-cons)           (mapcar (lambda (key-cons)
7033                     (let ((key (car key-cons))                     (let ((key (car key-cons))
7034                           (link (cdr key-cons)))                           (link (cdr key-cons)))
7035                       (when (and record-link file)                       (when (and record-link file)
7036                           (setq key (copy-sequence key))                           (setq key (copy-sequence key))
7037                           (put-text-property                           (put-text-property
7038                            0 (length key)                            0 (length key)
7039                            'link                            'link
7040                            (concat                            (concat
7041                             file                             file
7042                             (if link                             (if link
7043                                 (concat idlwave-html-link-sep                                 (concat idlwave-html-link-sep
7044                                         (number-to-string link))))                                         (number-to-string link))))
7045                            key))                            key))
# Line 7030  property indicating the link is added." Line 7052  property indicating the link is added."
7052    "Find keyword KEYWORD in entry ENTRY, and return (with link) if set"    "Find keyword KEYWORD in entry ENTRY, and return (with link) if set"
7053    (catch 'exit    (catch 'exit
7054      (mapc      (mapc
7055       (lambda (key-list)       (lambda (key-list)
7056         (let ((file (car key-list))         (let ((file (car key-list))
7057               (kwd (assoc keyword (cdr key-list))))               (kwd (assoc keyword (cdr key-list))))
7058           (when kwd           (when kwd
7059             (setq kwd (cons (car kwd)             (setq kwd (cons (car kwd)
7060                             (if (and file (cdr kwd))                             (if (and file (cdr kwd))
7061                                 (concat file                                 (concat file
7062                                         idlwave-html-link-sep                                         idlwave-html-link-sep
7063                                         (number-to-string (cdr kwd)))                                         (number-to-string (cdr kwd)))
7064                               (cdr kwd))))                               (cdr kwd))))
# Line 7074  property indicating the link is added." Line 7096  property indicating the link is added."
7096            ;; Check if we need to update the "current" class            ;; Check if we need to update the "current" class
7097            (if (not (equal class-selector idlwave-current-tags-class))            (if (not (equal class-selector idlwave-current-tags-class))
7098                (idlwave-prepare-class-tag-completion class-selector))                (idlwave-prepare-class-tag-completion class-selector))
7099            (setq idlwave-completion-help-info            (setq idlwave-completion-help-info
7100                  (list 'idlwave-complete-class-structure-tag-help                  (list 'idlwave-complete-class-structure-tag-help
7101                        (idlwave-sintern-routine                        (idlwave-sintern-routine
7102                         (concat class-selector "__define"))                         (concat class-selector "__define"))
7103                        nil))                        nil))
7104            (let  ((idlwave-cpl-bold idlwave-current-native-class-tags))            (let  ((idlwave-cpl-bold idlwave-current-native-class-tags))
7105              (idlwave-complete-in-buffer              (idlwave-complete-in-buffer
7106               'class-tag 'class-tag               'class-tag 'class-tag
7107               idlwave-current-class-tags nil               idlwave-current-class-tags nil
7108               (format "Select a tag of class %s" class-selector)               (format "Select a tag of class %s" class-selector)
7109               "class tag"               "class tag"
# Line 7133  Gets set in `idlw-rinfo.el'.") Line 7155  Gets set in `idlw-rinfo.el'.")
7155               (skip-chars-backward "[a-zA-Z0-9_$]")               (skip-chars-backward "[a-zA-Z0-9_$]")
7156               (equal (char-before) ?!))               (equal (char-before) ?!))
7157             (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help))             (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help))
7158             (idlwave-complete-in-buffer 'sysvar 'sysvar             (idlwave-complete-in-buffer 'sysvar 'sysvar
7159                                         idlwave-system-variables-alist nil                                         idlwave-system-variables-alist nil
7160                                         "Select a system variable"                                         "Select a system variable"
7161                                         "system variable")                                         "system variable")
# Line 7152  Gets set in `idlw-rinfo.el'.") Line 7174  Gets set in `idlw-rinfo.el'.")
7174               (or tags (error "System variable !%s is not a structure" var))               (or tags (error "System variable !%s is not a structure" var))
7175               (setq idlwave-completion-help-info               (setq idlwave-completion-help-info
7176                     (list 'idlwave-complete-sysvar-tag-help var))                     (list 'idlwave-complete-sysvar-tag-help var))
7177               (idlwave-complete-in-buffer 'sysvartag 'sysvartag               (idlwave-complete-in-buffer 'sysvartag 'sysvartag
7178                                           tags nil                                           tags nil
7179                                           "Select a system variable tag"                                           "Select a system variable tag"
7180                                           "system variable tag")                                           "system variable tag")
7181               t)) ; return t to skip other completions               t)) ; return t to skip other completions
7182            (t nil))))            (t nil))))
7183    
7184    (defvar link) ;dynamic
7185  (defun idlwave-complete-sysvar-help (mode word)  (defun idlwave-complete-sysvar-help (mode word)
7186    (let ((word (or (nth 1 idlwave-completion-help-info) word))    (let ((word (or (nth 1 idlwave-completion-help-info) word))
7187          (entry (assoc word idlwave-system-variables-alist)))          (entry (assoc word idlwave-system-variables-alist)))
# Line 7179  Gets set in `idlw-rinfo.el'.") Line 7202  Gets set in `idlw-rinfo.el'.")
7202       ((eq mode 'test) ; we can at least link the main       ((eq mode 'test) ; we can at least link the main
7203        (and (stringp word) entry main))        (and (stringp word) entry main))
7204       ((eq mode 'set)       ((eq mode 'set)
7205        (if entry        (if entry
7206            (setq link            (setq link
7207                  (if (setq target (cdr (assoc word tags)))                  (if (setq target (cdr (assoc word tags)))
7208                    (idlwave-substitute-link-target main target)                    (idlwave-substitute-link-target main target)
7209                  main)))) ;; setting dynamic!!!                  main)))) ;; setting dynamic!!!
# Line 7198  Gets set in `idlw-rinfo.el'.") Line 7221  Gets set in `idlw-rinfo.el'.")
7221    
7222  ;; Fake help in the source buffer for class structure tags.  ;; Fake help in the source buffer for class structure tags.
7223  ;; KWD AND NAME ARE GLOBAL-VARIABLES HERE.  ;; KWD AND NAME ARE GLOBAL-VARIABLES HERE.
7224  (defvar name)  (defvar name)
7225  (defvar kwd)  (defvar kwd)
7226  (defvar idlwave-help-do-class-struct-tag nil)  (defvar idlwave-help-do-class-struct-tag nil)
7227  (defun idlwave-complete-class-structure-tag-help (mode word)  (defun idlwave-complete-class-structure-tag-help (mode word)
# Line 7207  Gets set in `idlw-rinfo.el'.") Line 7230  Gets set in `idlw-rinfo.el'.")
7230      nil)      nil)
7231     ((eq mode 'set)     ((eq mode 'set)
7232      (let (class-with found-in)      (let (class-with found-in)
7233        (when (setq class-with        (when (setq class-with
7234                  (idlwave-class-or-superclass-with-tag                  (idlwave-class-or-superclass-with-tag
7235                   idlwave-current-tags-class                   idlwave-current-tags-class
7236                   word))                   word))
7237          (if (assq (idlwave-sintern-class class-with)          (if (assq (idlwave-sintern-class class-with)
7238                    idlwave-system-class-info)                    idlwave-system-class-info)
7239              (error "No help available for system class tags"))              (error "No help available for system class tags"))
7240          (if (setq found-in (idlwave-class-found-in class-with))          (if (setq found-in (idlwave-class-found-in class-with))
# Line 7224  Gets set in `idlw-rinfo.el'.") Line 7247  Gets set in `idlw-rinfo.el'.")
7247  (defun idlwave-class-or-superclass-with-tag (class tag)  (defun idlwave-class-or-superclass-with-tag (class tag)
7248    "Find and return the CLASS or one of its superclass with the    "Find and return the CLASS or one of its superclass with the
7249  associated TAG, if any."  associated TAG, if any."
7250    (let ((sclasses (cons class (cdr (assq 'all-inherits    (let ((sclasses (cons class (cdr (assq 'all-inherits
7251                                           (idlwave-class-info class)))))                                           (idlwave-class-info class)))))
7252          cl)          cl)
7253     (catch 'exit     (catch 'exit
# Line 7233  associated TAG, if any." Line 7256  associated TAG, if any."
7256         (let ((tags (idlwave-class-tags cl)))         (let ((tags (idlwave-class-tags cl)))
7257           (while tags           (while tags
7258             (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))
7259               (throw 'exit cl))               (throw 'exit cl))        
7260             (setq tags (cdr tags))))))))             (setq tags (cdr tags))))))))
7261    
7262    
# Line 7256  associated TAG, if any." Line 7279  associated TAG, if any."
7279        (setcar entry (idlwave-sintern-sysvar (car entry) 'set))        (setcar entry (idlwave-sintern-sysvar (car entry) 'set))
7280        (setq tags (assq 'tags entry))        (setq tags (assq 'tags entry))
7281        (if tags        (if tags
7282            (setcdr tags            (setcdr tags
7283                    (mapcar (lambda (x)                    (mapcar (lambda (x)
7284                              (cons (idlwave-sintern-sysvartag (car x) 'set)                              (cons (idlwave-sintern-sysvartag (car x) 'set)
7285                                    (cdr x)))                                    (cdr x)))
7286                            (cdr tags)))))))                            (cdr tags)))))))
# Line 7274  associated TAG, if any." Line 7297  associated TAG, if any."
7297                           text start)                           text start)
7298        (setq start (match-end 0)        (setq start (match-end 0)
7299              var (match-string 1 text)              var (match-string 1 text)
7300              tags (if (match-end 3)              tags (if (match-end 3)
7301                       (idlwave-split-string (match-string 3 text))))                       (idlwave-split-string (match-string 3 text))))
7302        ;; Maintain old links, if present        ;; Maintain old links, if present
7303        (setq old-entry (assq (idlwave-sintern-sysvar var) old))        (setq old-entry (assq (idlwave-sintern-sysvar var) old))
7304        (setq link (assq 'link old-entry))        (setq link (assq 'link old-entry))
7305        (setq idlwave-system-variables-alist        (setq idlwave-system-variables-alist
7306              (cons (list var              (cons (list var
7307                          (cons                          (cons
7308                           'tags                           'tags
7309                           (mapcar (lambda (x)                           (mapcar (lambda (x)
7310                                     (cons x                                     (cons x
7311                                           (cdr (assq                                           (cdr (assq
7312                                                 (idlwave-sintern-sysvartag x)                                                 (idlwave-sintern-sysvartag x)
7313                                                 (cdr (assq 'tags old-entry))))))                                                 (cdr (assq 'tags old-entry))))))
7314                                   tags)) link)                                   tags)) link)
7315                    idlwave-system-variables-alist)))                    idlwave-system-variables-alist)))
# Line 7308  associated TAG, if any." Line 7331  associated TAG, if any."
7331    
7332  (defun idlwave-uniquify (list)  (defun idlwave-uniquify (list)
7333    (let ((ht (make-hash-table :size (length list) :test 'equal)))    (let ((ht (make-hash-table :size (length list) :test 'equal)))
7334      (delq nil      (delq nil
7335            (mapcar (lambda (x)            (mapcar (lambda (x)
7336                      (unless (gethash x ht)                      (unless (gethash x ht)
7337                        (puthash x t ht)                        (puthash x t ht)
7338                        x))                        x))
7339                    list))))                    list))))
# Line 7338  Restore the pre-completion window config Line 7361  Restore the pre-completion window config
7361        nil)))        nil)))
7362    
7363    ;; Restore the pre-completion window configuration if this is safe.    ;; Restore the pre-completion window configuration if this is safe.
7364      
7365    (if (or (eq verify 'force)                                    ; force    (if (or (eq verify 'force)                                    ; force
7366            (and            (and
7367             (get-buffer-window "*Completions*")                  ; visible             (get-buffer-window "*Completions*")                  ; visible
7368             (idlwave-local-value 'idlwave-completion-p             (idlwave-local-value 'idlwave-completion-p
7369                                  "*Completions*")                ; cib-buffer                                  "*Completions*")                ; cib-buffer
7370             (eq (marker-buffer idlwave-completion-mark)             (eq (marker-buffer idlwave-completion-mark)
7371                 (current-buffer))                                ; buffer OK                 (current-buffer))                                ; buffer OK
# Line 7440  With ARG, enforce query for the class of Line 7463  With ARG, enforce query for the class of
7463      (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)"      (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)"
7464                        resolve)                        resolve)
7465          (setq type (match-string 1 resolve)          (setq type (match-string 1 resolve)
7466                class (if (match-beginning 2)                class (if (match-beginning 2)
7467                          (match-string 3 resolve)                          (match-string 3 resolve)
7468                        nil)                        nil)
7469                name (match-string 4 resolve)))                name (match-string 4 resolve)))
# Line 7449  With ARG, enforce query for the class of Line 7472  With ARG, enforce query for the class of
7472    
7473      (cond      (cond
7474       ((null class)       ((null class)
7475        (idlwave-shell-send-command        (idlwave-shell-send-command
7476         (format "resolve_routine,'%s'%s" (downcase name) kwd)         (format "resolve_routine,'%s'%s" (downcase name) kwd)
7477         'idlwave-update-routine-info         'idlwave-update-routine-info
7478         nil t))         nil t))
7479       (t       (t
7480        (idlwave-shell-send-command        (idlwave-shell-send-command
7481         (format "resolve_routine,'%s__define'%s" (downcase class) kwd)         (format "resolve_routine,'%s__define'%s" (downcase class) kwd)
7482         (list 'idlwave-shell-send-command         (list 'idlwave-shell-send-command
7483               (format "resolve_routine,'%s__%s'%s"               (format "resolve_routine,'%s__%s'%s"
7484                       (downcase class) (downcase name) kwd)                       (downcase class) (downcase name) kwd)
7485               '(idlwave-update-routine-info)               '(idlwave-update-routine-info)
7486               nil t))))))               nil t))))))
7487    
7488    (defun idlwave-find-module-this-file ()
7489      (interactive)
7490      (idlwave-find-module '(4)))
7491    
7492  (defun idlwave-find-module (&optional arg)  (defun idlwave-find-module (&optional arg)
7493    "Find the source code of an IDL module.    "Find the source code of an IDL module.
7494  Works for modules for which IDLWAVE has routine info available.  The  Works for modules for which IDLWAVE has routine info available.  The
# Line 7474  force class query for object methods." Line 7501  force class query for object methods."
7501           (this-buffer (equal arg '(4)))           (this-buffer (equal arg '(4)))
7502           (module (idlwave-fix-module-if-obj_new (idlwave-what-module)))           (module (idlwave-fix-module-if-obj_new (idlwave-what-module)))
7503           (default (if module           (default (if module
7504                        (concat (idlwave-make-full-name                        (concat (idlwave-make-full-name
7505                                 (nth 2 module) (car module))                                 (nth 2 module) (car module))
7506                                (if (eq (nth 1 module) 'pro) "<p>" "<f>"))                                (if (eq (nth 1 module) 'pro) "<p>" "<f>"))
7507                      "none"))                      "none"))
7508           (list           (list
7509            (idlwave-uniquify            (idlwave-uniquify
7510             (delq nil             (delq nil
7511                   (mapcar (lambda (x)                   (mapcar (lambda (x)
7512                             (if (eq 'system (car-safe (nth 3 x)))                             (if (eq 'system (car-safe (nth 3 x)))
7513                                 ;; Take out system routines with no source.                                 ;; Take out system routines with no source.
7514                                 nil                                 nil
7515                               (list                               (list
7516                                (concat (idlwave-make-full-name                                (concat (idlwave-make-full-name
7517                                         (nth 2 x) (car x))                                         (nth 2 x) (car x))
7518                                        (if (eq (nth 1 x) 'pro) "<p>" "<f>")))))                                        (if (eq (nth 1 x) 'pro) "<p>" "<f>")))))
7519                           (if this-buffer                           (if this-buffer
# Line 7515  force class query for object methods." Line 7542  force class query for object methods."
7542                       (t t)))                       (t t)))
7543      (idlwave-do-find-module name type class nil this-buffer)))      (idlwave-do-find-module name type class nil this-buffer)))
7544    
7545  (defun idlwave-do-find-module (name type class  (defun idlwave-do-find-module (name type class
7546                                      &optional force-source this-buffer)                                      &optional force-source this-buffer)
7547    (let ((name1 (idlwave-make-full-name class name))    (let ((name1 (idlwave-make-full-name class name))
7548          source buf1 entry          source buf1 entry
7549          (buf (current-buffer))          (buf (current-buffer))
7550          (pos (point))          (pos (point))
7551          file name2)          file name2)
# Line 7528  force class query for object methods." Line 7555  force class query for object methods."
7555            name2 (if (nth 2 entry)            name2 (if (nth 2 entry)
7556                      (idlwave-make-full-name (nth 2 entry) name)                      (idlwave-make-full-name (nth 2 entry) name)
7557                    name1))                    name1))
7558      (if source      (if source  
7559          (setq file (idlwave-routine-source-file source)))          (setq file (idlwave-routine-source-file source)))
7560      (unless file  ; Try to find it on the path.      (unless file  ; Try to find it on the path.
7561        (setq file        (setq file
7562              (idlwave-expand-lib-file-name              (idlwave-expand-lib-file-name
7563               (if class               (if class
7564                   (format "%s__define.pro" (downcase class))                   (format "%s__define.pro" (downcase class))
7565                 (format "%s.pro" (downcase name))))))                 (format "%s.pro" (downcase name))))))
# Line 7540  force class query for object methods." Line 7567  force class query for object methods."
7567       ((or (null name) (equal name ""))       ((or (null name) (equal name ""))
7568        (error "Abort"))        (error "Abort"))
7569       ((eq (car source) 'system)       ((eq (car source) 'system)
7570        (error "Source code for system routine %s is not available"        (error "Source code for system routine %s is not available"
7571               name2))               name2))
7572       ((or (not file) (not (file-regular-p file)))       ((or (not file) (not (file-regular-p file)))
7573        (error "Source code for routine %s is not available"        (error "Source code for routine %s is not available"
7574               name2))               name2))
7575       (t       (t
7576        (when (not this-buffer)        (when (not this-buffer)
7577          (setq buf1          (setq buf1
7578                (idlwave-find-file-noselect file 'find))                (idlwave-find-file-noselect file 'find))
7579          (pop-to-buffer buf1 t))          (pop-to-buffer buf1 t))
7580        (goto-char (point-max))        (goto-char (point-max))
# Line 7557  force class query for object methods." Line 7584  force class query for object methods."
7584                       (cond ((eq type 'fun) "function")                       (cond ((eq type 'fun) "function")
7585                             ((eq type 'pro) "pro")                             ((eq type 'pro) "pro")
7586                             (t "\\(pro\\|function\\)"))                             (t "\\(pro\\|function\\)"))
7587                       "\\>[ \t]+"                       "\\>[ \t]+"
7588                       (regexp-quote (downcase name2))                       (regexp-quote (downcase name2))
7589                       "[^a-zA-Z0-9_$]")                       "[^a-zA-Z0-9_$]")
7590               nil t)               nil t)
# Line 7594  Used by `idlwave-routine-info' and `idlw Line 7621  Used by `idlwave-routine-info' and `idlw
7621        (cond        (cond
7622         ((and (eq cw 'procedure)         ((and (eq cw 'procedure)
7623               (not (equal this-word "")))               (not (equal this-word "")))
7624          (setq this-word (idlwave-sintern-routine-or-method          (setq this-word (idlwave-sintern-routine-or-method
7625                           this-word (nth 2 (nth 3 where))))                           this-word (nth 2 (nth 3 where))))
7626          (list this-word 'pro          (list this-word 'pro
7627                (idlwave-determine-class                (idlwave-determine-class
7628                 (cons this-word (cdr (nth 3 where)))                 (cons this-word (cdr (nth 3 where)))
7629                 'pro)))                 'pro)))
7630         ((and (eq cw 'function)         ((and (eq cw 'function)
7631               (not (equal this-word ""))               (not (equal this-word ""))
7632               (or (eq next-char ?\()     ; exclude arrays, vars.               (or (eq next-char ?\()     ; exclude arrays, vars.
7633                   (looking-at "[a-zA-Z0-9_]*[ \t]*(")))                   (looking-at "[a-zA-Z0-9_]*[ \t]*(")))
7634          (setq this-word (idlwave-sintern-routine-or-method          (setq this-word (idlwave-sintern-routine-or-method
7635                           this-word (nth 2 (nth 3 where))))                           this-word (nth 2 (nth 3 where))))
7636          (list this-word 'fun          (list this-word 'fun
7637                (idlwave-determine-class                (idlwave-determine-class
# Line 7641  Used by `idlwave-routine-info' and `idlw Line 7668  Used by `idlwave-routine-info' and `idlw
7668        class)))        class)))
7669    
7670  (defun idlwave-fix-module-if-obj_new (module)  (defun idlwave-fix-module-if-obj_new (module)
7671    "Check if MODULE points to obj_new.    "Check if MODULE points to obj_new.  
7672  If yes, and if the cursor is in the keyword region, change to the  If yes, and if the cursor is in the keyword region, change to the
7673  appropriate Init method."  appropriate Init method."
7674    (let* ((name (car module))    (let* ((name (car module))
# Line 7662  appropriate Init method." Line 7689  appropriate Init method."
7689                               (idlwave-sintern-class class)))))                               (idlwave-sintern-class class)))))
7690      module))      module))
7691    
7692  (defun idlwave-fix-keywords (name type class keywords &optional super-classes)  (defun idlwave-fix-keywords (name type class keywords
7693                                      &optional super-classes system)
7694    "Update a list of keywords.    "Update a list of keywords.
7695  Translate OBJ_NEW, adding all super-class keywords, or all keywords  Translate OBJ_NEW, adding all super-class keywords, or all keywords
7696  from all classes if class equals t."  from all classes if class equals t.  If SYSTEM is non-nil, don't
7697    demand _EXTRA in the keyword list."
7698    (let ((case-fold-search t))    (let ((case-fold-search t))
7699    
7700      ;; 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 7681  from all classes if class equals t." Line 7710  from all classes if class equals t."
7710                               string)                               string)
7711                 (setq class (idlwave-sintern-class (match-string 1 string)))                 (setq class (idlwave-sintern-class (match-string 1 string)))
7712                 (setq idlwave-current-obj_new-class class)                 (setq idlwave-current-obj_new-class class)
7713                 (setq keywords                 (setq keywords
7714                       (append keywords                       (append keywords
7715                               (idlwave-entry-keywords                               (idlwave-entry-keywords
7716                                (idlwave-rinfo-assq                                (idlwave-rinfo-assq
7717                                 (idlwave-sintern-method "INIT")                                 (idlwave-sintern-method "INIT")
7718                                 'fun                                 'fun
7719                                 class                                 class
7720                                 (idlwave-routines)) 'do-link))))))                                 (idlwave-routines)) 'do-link))))))
7721        
7722      ;; If the class is `t', combine all keywords of all methods NAME      ;; If the class is `t', combine all keywords of all methods NAME
7723      (when (eq class t)      (when (eq class t)
7724        (mapc (lambda (entry)        (mapc (lambda (entry)
7725                (and                (and
7726                 (nth 2 entry)             ; non-nil class                 (nth 2 entry)             ; non-nil class
7727                 (eq (nth 1 entry) type)   ; correct type                 (eq (nth 1 entry) type)   ; correct type
7728                 (setq keywords                 (setq keywords
7729                       (append keywords                       (append keywords
7730                               (idlwave-entry-keywords entry 'do-link)))))                               (idlwave-entry-keywords entry 'do-link)))))
7731              (idlwave-all-assq name (idlwave-routines)))              (idlwave-all-assq name (idlwave-routines)))
7732        (setq keywords (idlwave-uniquify keywords)))        (setq keywords (idlwave-uniquify keywords)))
7733        
7734      ;; If we have inheritance, add all keywords from superclasses, if      ;; If we have inheritance, add all keywords from superclasses, if
7735      ;; the user indicated that method in `idlwave-keyword-class-inheritance'      ;; the user indicated that method in `idlwave-keyword-class-inheritance'
7736      (when (and      (when (and
7737             super-classes             super-classes
7738             idlwave-keyword-class-inheritance             idlwave-keyword-class-inheritance
7739             (stringp class)             (stringp class)
7740             (or (assq (idlwave-sintern-keyword "_extra") keywords)             (or
7741                 (assq (idlwave-sintern-keyword "_ref_extra") keywords))              system
7742                (assq (idlwave-sintern-keyword "_extra") keywords)
7743                (assq (idlwave-sintern-keyword "_ref_extra") keywords))
7744             ;; Check if one of the keyword-class regexps matches the name             ;; Check if one of the keyword-class regexps matches the name
7745             (let ((regexps idlwave-keyword-class-inheritance) re)             (let ((regexps idlwave-keyword-class-inheritance) re)
7746               (catch 'exit               (catch 'exit
# Line 7724  from all classes if class equals t." Line 7755  from all classes if class equals t."
7755                   (mapcar (lambda (k) (add-to-list 'keywords k))                   (mapcar (lambda (k) (add-to-list 'keywords k))
7756                           (idlwave-entry-keywords entry 'do-link))))                           (idlwave-entry-keywords entry 'do-link))))
7757        (setq keywords (idlwave-uniquify keywords)))        (setq keywords (idlwave-uniquify keywords)))
7758        
7759      ;; Return the final list      ;; Return the final list
7760      keywords))      keywords))
7761    
# Line 7749  If we do not know about MODULE, just ret Line 7780  If we do not know about MODULE, just ret
7780                      (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist)))                      (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist)))
7781           (completion-ignore-case t)           (completion-ignore-case t)
7782           candidates)           candidates)
7783      (cond ((assq kwd kwd-alist)      (cond ((assq kwd kwd-alist)
7784             kwd)             kwd)
7785            ((setq candidates (all-completions kwd kwd-alist))            ((setq candidates (all-completions kwd kwd-alist))
7786             (if (= (length candidates) 1)             (if (= (length candidates) 1)
7787                 (car candidates)                 (car candidates)
7788               candidates))               candidates))
7789            ((and entry extra)            ((and entry extra)
7790             ;; Inheritance may cause this keyword to be correct             ;; Inheritance may cause this keyword to be correct
7791             keyword)             keyword)
7792            (entry            (entry
7793             ;; We do know the function, which does not have the keyword.             ;; We do know the function, which does not have the keyword.
# Line 7768  If we do not know about MODULE, just ret Line 7799  If we do not know about MODULE, just ret
7799    
7800  (defvar idlwave-rinfo-mouse-map (make-sparse-keymap))  (defvar idlwave-rinfo-mouse-map (make-sparse-keymap))
7801  (defvar idlwave-rinfo-map (make-sparse-keymap))  (defvar idlwave-rinfo-map (make-sparse-keymap))
7802  (define-key idlwave-rinfo-mouse-map  (define-key idlwave-rinfo-mouse-map
7803    (if (featurep 'xemacs) [button2] [mouse-2])    (if (featurep 'xemacs) [button2] [mouse-2])
7804    'idlwave-mouse-active-rinfo)    'idlwave-mouse-active-rinfo)
7805  (define-key idlwave-rinfo-mouse-map  (define-key idlwave-rinfo-mouse-map
7806    (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])    (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
7807    'idlwave-mouse-active-rinfo-shift)    'idlwave-mouse-active-rinfo-shift)
7808  (define-key idlwave-rinfo-mouse-map  (define-key idlwave-rinfo-mouse-map
7809    (if (featurep 'xemacs) [button3] [mouse-3])    (if (featurep 'xemacs) [button3] [mouse-3])
7810    'idlwave-mouse-active-rinfo-right)    'idlwave-mouse-active-rinfo-right)
7811  (define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space)  (define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space)
# Line 7800  If we do not know about MODULE, just ret Line 7831  If we do not know about MODULE, just ret
7831    (let* ((initial-class (or initial-class class))    (let* ((initial-class (or initial-class class))
7832           (entry (or (idlwave-best-rinfo-assq name type class           (entry (or (idlwave-best-rinfo-assq name type class
7833                                               (idlwave-routines))                                               (idlwave-routines))
7834                      (idlwave-rinfo-assq name type class                      (idlwave-rinfo-assq name type class
7835                                          idlwave-unresolved-routines)))                                          idlwave-unresolved-routines)))
7836           (name (or (car entry) name))           (name (or (car entry) name))
7837           (class (or (nth 2 entry) class))           (class (or (nth 2 entry) class))
# Line 7825  If we do not know about MODULE, just ret Line 7856  If we do not know about MODULE, just ret
7856           (km-prop (if (featurep 'xemacs) 'keymap 'local-map))           (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
7857           (face 'idlwave-help-link-face)           (face 'idlwave-help-link-face)
7858           beg props win cnt total)           beg props win cnt total)
7859      ;; Fix keywords, but don't add chained super-classes, since these      ;; Fix keywords, but don't add chained super-classes, since these
7860      ;; are shown separately for that super-class      ;; are shown separately for that super-class
7861      (setq keywords (idlwave-fix-keywords name type class keywords))      (setq keywords (idlwave-fix-keywords name type class keywords))
7862      (cond      (cond
# Line 7867  If we do not know about MODULE, just ret Line 7898  If we do not know about MODULE, just ret
7898                            km-prop idlwave-rinfo-mouse-map                            km-prop idlwave-rinfo-mouse-map
7899                            'help-echo help-echo-use                            'help-echo help-echo-use
7900                            'data (cons 'usage data)))                            'data (cons 'usage data)))
7901          (if html-file (setq props (append (list 'face face 'link html-file)          (if html-file (setq props (append (list 'face face 'link html-file)
7902                                            props)))                                            props)))
7903          (insert "Usage:    ")          (insert "Usage:    ")
7904          (setq beg (point))          (setq beg (point))
# Line 7876  If we do not know about MODULE, just ret Line 7907  If we do not know about MODULE, just ret
7907                    (format calling-seq name name name name))                    (format calling-seq name name name name))
7908                  "\n")                  "\n")
7909          (add-text-properties beg (point) props)          (add-text-properties beg (point) props)
7910            
7911          (insert "Keywords:")          (insert "Keywords:")
7912          (if (null keywords)          (if (null keywords)
7913              (insert " No keywords accepted.")              (insert " No keywords accepted.")
7914            (setq col 9)            (setq col 9)
7915            (mapcar            (mapcar
7916             (lambda (x)             (lambda (x)
7917               (if (>= (+ col 1 (length (car x)))               (if (>= (+ col 1 (length (car x)))
7918                       (window-width))                       (window-width))
7919                   (progn                   (progn
7920                     (insert "\n         ")                     (insert "\n         ")
# Line 7901  If we do not know about MODULE, just ret Line 7932  If we do not know about MODULE, just ret
7932               (add-text-properties beg (point) props)               (add-text-properties beg (point) props)
7933               (setq col (+ col 1 (length (car x)))))               (setq col (+ col 1 (length (car x)))))
7934             keywords))             keywords))
7935            
7936          (setq cnt 1 total (length all))          (setq cnt 1 total (length all))
7937          ;; Here entry is (key file (list of type-conses))          ;; Here entry is (key file (list of type-conses))
7938          (while (setq entry (pop all))          (while (setq entry (pop all))
# Line 7914  If we do not know about MODULE, just ret Line 7945  If we do not know about MODULE, just ret
7945                                            (cdr (car (nth 2 entry))))                                            (cdr (car (nth 2 entry))))
7946                              'data (cons 'source data)))                              'data (cons 'source data)))
7947            (idlwave-insert-source-location            (idlwave-insert-source-location
7948             (format "\n%-8s  %s"             (format "\n%-8s  %s"
7949                     (if (equal cnt 1)                     (if (equal cnt 1)
7950                         (if (> total 1) "Sources:" "Source:")                         (if (> total 1) "Sources:" "Source:")
7951                       "")                       "")
# Line 7923  If we do not know about MODULE, just ret Line 7954  If we do not know about MODULE, just ret
7954            (incf cnt)            (incf cnt)
7955            (when (and all (> cnt idlwave-rinfo-max-source-lines))            (when (and all (> cnt idlwave-rinfo-max-source-lines))
7956              ;; No more source lines, please              ;; No more source lines, please
7957              (insert (format              (insert (format
7958                       "\n          Source information truncated to %d entries."                       "\n          Source information truncated to %d entries."
7959                       idlwave-rinfo-max-source-lines))                       idlwave-rinfo-max-source-lines))
7960              (setq all nil)))              (setq all nil)))
# Line 7937  If we do not know about MODULE, just ret Line 7968  If we do not know about MODULE, just ret
7968                (unwind-protect                (unwind-protect
7969                    (progn                    (progn
7970                      (select-window win)                      (select-window win)
7971                      (enlarge-window (- (/ (frame-height) 2)                      (enlarge-window (- (/ (frame-height) 2)
7972                                         (window-height)))                                         (window-height)))
7973                      (shrink-window-if-larger-than-buffer))                      (shrink-window-if-larger-than-buffer))
7974                  (select-window ww)))))))))                  (select-window ww)))))))))
# Line 7974  it." Line 8005  it."
8005       ((and (not file) shell-flag)       ((and (not file) shell-flag)
8006        (insert "Unresolved"))        (insert "Unresolved"))
8007    
8008       ((null file)       ((null file)              
8009        (insert "ERROR"))        (insert "ERROR"))
8010        
8011       ((idlwave-syslib-p file)       ((idlwave-syslib-p file)
8012        (if (string-match "obsolete" (file-name-directory file))        (if (string-match "obsolete" (file-name-directory file))
8013            (insert "Obsolete  ")            (insert "Obsolete  ")
# Line 7990  it." Line 8021  it."
8021       ;; Old special syntax: a matching regexp       ;; Old special syntax: a matching regexp
8022       ((setq special (idlwave-special-lib-test file))       ((setq special (idlwave-special-lib-test file))
8023        (insert (format "%-10s" special)))        (insert (format "%-10s" special)))
8024        
8025       ;; Catch-all with file       ;; Catch-all with file
8026       ((idlwave-lib-p file)      (insert "Library   "))       ((idlwave-lib-p file)      (insert "Library   "))
8027    
# Line 8005  it." Line 8036  it."
8036                 (if shell-flag "S" "-")                 (if shell-flag "S" "-")
8037                 (if buffer-flag "B" "-")                 (if buffer-flag "B" "-")
8038                 "] ")))                 "] ")))
8039      (when (> ndupl 1)      (when (> ndupl 1)
8040        (setq beg (point))        (setq beg (point))
8041        (insert (format "(%dx) " ndupl))        (insert (format "(%dx) " ndupl))
8042        (add-text-properties beg (point) (list 'face 'bold)))        (add-text-properties beg (point) (list 'face 'bold)))
# Line 8029  Return the name of the special lib if th Line 8060  Return the name of the special lib if th
8060                    alist nil)))                    alist nil)))
8061        rtn)        rtn)
8062       (t nil))))       (t nil))))
8063      
8064  (defun idlwave-mouse-active-rinfo-right (ev)  (defun idlwave-mouse-active-rinfo-right (ev)
8065    (interactive "e")    (interactive "e")
8066    (idlwave-mouse-active-rinfo ev 'right))    (idlwave-mouse-active-rinfo ev 'right))
# Line 8048  Optional args RIGHT and SHIFT indicate, Line 8079  Optional args RIGHT and SHIFT indicate,
8079  was pressed."  was pressed."
8080    (interactive "e")    (interactive "e")
8081    (if ev (mouse-set-point ev))    (if ev (mouse-set-point ev))
8082    (let (data id name type class buf bufwin source word initial-class)    (let (data id name type class buf bufwin source link keyword
8083                 word initial-class)
8084      (setq data (get-text-property (point) 'data)      (setq data (get-text-property (point) 'data)
8085            source (get-text-property (point) 'source)            source (get-text-property (point) 'source)
8086            keyword (get-text-property (point) 'keyword)            keyword (get-text-property (point) 'keyword)
# Line 8062  was pressed." Line 8094  was pressed."
8094    
8095      (cond ((eq id 'class) ; Switch class being displayed      (cond ((eq id 'class) ; Switch class being displayed
8096             (if (window-live-p bufwin) (select-window bufwin))             (if (window-live-p bufwin) (select-window bufwin))
8097             (idlwave-display-calling-sequence             (idlwave-display-calling-sequence
8098              (idlwave-sintern-method name)              (idlwave-sintern-method name)
8099              type (idlwave-sintern-class word)              type (idlwave-sintern-class word)
8100              initial-class))              initial-class))
8101            ((eq id 'usage) ; Online help on this routine            ((eq id 'usage) ; Online help on this routine
8102             (idlwave-online-help link name type class))             (idlwave-online-help link name type class))
# Line 8105  was pressed." Line 8137  was pressed."
8137        (setq bwin (get-buffer-window buffer)))        (setq bwin (get-buffer-window buffer)))
8138      (if (eq (preceding-char) ?/)      (if (eq (preceding-char) ?/)
8139          (insert keyword)          (insert keyword)
8140        (unless (save-excursion        (unless (save-excursion
8141                  (re-search-backward                  (re-search-backward
8142                   "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\="                   "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\="
8143                   (min (- (point) 100) (point-min)) t))                   (min (- (point) 100) (point-min)) t))
8144          (insert ", "))          (insert ", "))
8145        (if shift (insert "/"))        (if shift (insert "/"))
# Line 8159  the load path in order to find a definit Line 8191  the load path in order to find a definit
8191  command can be used to detect possible name clashes during this process."  command can be used to detect possible name clashes during this process."
8192    (idlwave-routines)  ; Make sure everything is loaded.    (idlwave-routines)  ; Make sure everything is loaded.
8193    (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines)    (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines)
8194      (or (y-or-n-p      (or (y-or-n-p
8195           "You don't have any user or library catalogs.  Continue anyway? ")           "You don't have any user or library catalogs.  Continue anyway? ")
8196          (error "Abort")))          (error "Abort")))
8197    (let* ((routines (append idlwave-system-routines    (let* ((routines (append idlwave-system-routines
# Line 8172  command can be used to detect possible n Line 8204  command can be used to detect possible n
8204           (keymap (make-sparse-keymap))           (keymap (make-sparse-keymap))
8205           (props (list 'mouse-face 'highlight           (props (list 'mouse-face 'highlight
8206                        km-prop keymap                        km-prop keymap
8207                        'help-echo "Mouse2: Find source"))                        'help-echo "Mouse2: Find source"))      
8208           (nroutines (length (or special-routines routines)))           (nroutines (length (or special-routines routines)))
8209           (step (/ nroutines 99))           (step (/ nroutines 99))
8210           (n 0)           (n 0)
# Line 8196  command can be used to detect possible n Line 8228  command can be used to detect possible n
8228      (message "Sorting routines...done")      (message "Sorting routines...done")
8229    
8230      (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)])      (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)])
8231        (lambda (ev)        (lambda (ev)
8232          (interactive "e")          (interactive "e")
8233          (mouse-set-point ev)          (mouse-set-point ev)
8234          (apply 'idlwave-do-find-module          (apply 'idlwave-do-find-module
8235                 (get-text-property (point) 'find-args))))                 (get-text-property (point) 'find-args))))
8236      (define-key keymap [(return)]      (define-key keymap [(return)]
8237        (lambda ()        (lambda ()
8238          (interactive)          (interactive)
8239          (apply 'idlwave-do-find-module          (apply 'idlwave-do-find-module
8240                 (get-text-property (point) 'find-args))))                 (get-text-property (point) 'find-args))))
# Line 8230  command can be used to detect possible n Line 8262  command can be used to detect possible n
8262                    (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1))                    (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1))
8263            (incf cnt)            (incf cnt)
8264            (insert (format "\n%s%s"            (insert (format "\n%s%s"
8265                            (idlwave-make-full-name (nth 2 routine)                            (idlwave-make-full-name (nth 2 routine)
8266                                                    (car routine))                                                    (car routine))
8267                            (if (eq (nth 1 routine) 'fun) "()" "")))                            (if (eq (nth 1 routine) 'fun) "()" "")))
8268            (while (setq twin (pop dtwins))            (while (setq twin (pop dtwins))
8269              (setq props1 (append (list 'find-args              (setq props1 (append (list 'find-args
8270                                         (list (nth 0 routine)                                         (list (nth 0 routine)
8271                                               (nth 1 routine)                                               (nth 1 routine)
8272                                               (nth 2 routine)))                                               (nth 2 routine)))
8273                                   props))                                   props))
8274              (idlwave-insert-source-location "\n   - " twin props1))))              (idlwave-insert-source-location "\n   - " twin props1))))
# Line 8259  command can be used to detect possible n Line 8291  command can be used to detect possible n
8291               (or (not (stringp sfile))               (or (not (stringp sfile))
8292                   (not (string-match "\\S-" sfile))))                   (not (string-match "\\S-" sfile))))
8293          (setq stype 'unresolved))          (setq stype 'unresolved))
8294      (princ (format "      %-10s %s\n"      (princ (format "      %-10s %s\n"
8295                     stype                     stype
8296                     (if sfile sfile "No source code available")))))                     (if sfile sfile "No source code available")))))
8297    
# Line 8278  ENTRY will also be returned, as the firs Line 8310  ENTRY will also be returned, as the firs
8310                 (eq type (nth 1 candidate))                 (eq type (nth 1 candidate))
8311                 (eq class (nth 2 candidate)))                 (eq class (nth 2 candidate)))
8312            (push candidate twins)))            (push candidate twins)))
8313      (if (setq candidate (idlwave-rinfo-assq name type class      (if (setq candidate (idlwave-rinfo-assq name type class
8314                                              idlwave-unresolved-routines))                                              idlwave-unresolved-routines))
8315          (push candidate twins))          (push candidate twins))
8316      (cons entry (nreverse twins))))      (cons entry (nreverse twins))))
8317    
8318  (defun idlwave-study-twins (entries)  (defun idlwave-study-twins (entries)
8319    "Return dangerous twins of first entry in ENTRIES.    "Return dangerous twins of first entry in ENTRIES.  
8320  Dangerous twins are routines with same name, but in different files on  Dangerous twins are routines with same name, but in different files on
8321  the load path.  If a file is in the system library and has an entry in  the load path.  If a file is in the system library and has an entry in
8322  the `idlwave-system-routines' list, we omit the latter as  the `idlwave-system-routines' list, we omit the latter as
8323  non-dangerous because many IDL routines are implemented as library  non-dangerous because many IDL routines are implemented as library
8324  routines, and may have been scanned."  routines, and may have been scanned."
8325    (let* ((entry (car entries))    (let* ((entry (car entries))
8326           (name (car entry))      ;           (name (car entry))      ;
8327           (type (nth 1 entry))    ; Must be bound for           (type (nth 1 entry))    ; Must be bound for
8328           (class (nth 2 entry))   ;  idlwave-routine-twin-compare           (class (nth 2 entry))   ;  idlwave-routine-twin-compare
8329           (cnt 0)           (cnt 0)
# Line 8309  routines, and may have been scanned." Line 8341  routines, and may have been scanned."
8341                        (t 'unresolved)))                        (t 'unresolved)))
8342    
8343        ;; Check for an entry in the system library        ;; Check for an entry in the system library
8344        (if (and file        (if (and file
8345                 (not syslibp)                 (not syslibp)
8346                 (idlwave-syslib-p file))                 (idlwave-syslib-p file))
8347            (setq syslibp t))            (setq syslibp t))
8348          
8349        ;; If there's more than one matching entry for the same file, just        ;; If there's more than one matching entry for the same file, just
8350        ;; append the type-cons to the type list.        ;; append the type-cons to the type list.
8351        (if (setq entry (assoc key alist))        (if (setq entry (assoc key alist))
8352            (push type-cons (nth 2 entry))            (push type-cons (nth 2 entry))
8353          (push (list key file (list type-cons)) alist)))          (push (list key file (list type-cons)) alist)))
8354        
8355      (setq alist (nreverse alist))      (setq alist (nreverse alist))
8356        
8357      (when syslibp      (when syslibp
8358        ;; File is in system *library* - remove any 'system entry        ;; File is in system *library* - remove any 'system entry
8359        (setq alist (delq (assq 'system alist) alist)))        (setq alist (delq (assq 'system alist) alist)))
8360        
8361      ;; If 'system remains and we've scanned the syslib, it's a builtin      ;; If 'system remains and we've scanned the syslib, it's a builtin
8362      ;; (rather than a !DIR/lib/.pro file bundled as source).      ;; (rather than a !DIR/lib/.pro file bundled as source).
8363      (when (and (idlwave-syslib-scanned-p)      (when (and (idlwave-syslib-scanned-p)
# Line 8333  routines, and may have been scanned." Line 8365  routines, and may have been scanned."
8365        (setcar entry 'builtin))        (setcar entry 'builtin))
8366      (sort alist 'idlwave-routine-twin-compare)))      (sort alist 'idlwave-routine-twin-compare)))
8367    
 (defvar name)  
8368  (defvar type)  (defvar type)
8369  (defvar class)  (defvar class)
8370  (defvar idlwave-sort-prefer-buffer-info t  (defvar idlwave-sort-prefer-buffer-info t
# Line 8362  compares twins on the basis of their fil Line 8393  compares twins on the basis of their fil
8393       ((not (eq type (nth 1 b)))       ((not (eq type (nth 1 b)))
8394        ;; Type decides        ;; Type decides
8395        (< (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)))
8396       (t       (t
8397        ;; A and B are twins - so the decision is more complicated.        ;; A and B are twins - so the decision is more complicated.
8398        ;; Call twin-compare with the proper arguments.        ;; Call twin-compare with the proper arguments.
8399        (idlwave-routine-entry-compare-twins a b)))))        (idlwave-routine-entry-compare-twins a b)))))
# Line 8414  This expects NAME TYPE CLASS to be bound Line 8445  This expects NAME TYPE CLASS to be bound
8445           (tpath-alist (idlwave-true-path-alist))           (tpath-alist (idlwave-true-path-alist))
8446           (apathp (and (stringp akey)           (apathp (and (stringp akey)
8447                        (assoc (file-name-directory akey) tpath-alist)))                        (assoc (file-name-directory akey) tpath-alist)))
8448           (bpathp (and (stringp bkey)           (bpathp (and (stringp bkey)
8449                        (assoc (file-name-directory bkey) tpath-alist)))                        (assoc (file-name-directory bkey) tpath-alist)))
8450           ;; How early on search path?  High number means early since we           ;; How early on search path?  High number means early since we
8451           ;; measure the tail of the path list           ;; measure the tail of the path list
# Line 8450  This expects NAME TYPE CLASS to be bound Line 8481  This expects NAME TYPE CLASS to be bound
8481       (t                                nil))))  ; Default       (t                                nil))))  ; Default
8482    
8483  (defun idlwave-routine-source-file (source)  (defun idlwave-routine-source-file (source)
8484    (if (nth 2 source)    (if (nth 2 source)
8485        (expand-file-name (nth 1 source) (nth 2 source))        (expand-file-name (nth 1 source) (nth 2 source))
8486      (nth 1 source)))      (nth 1 source)))
8487    
# Line 8540  Assumes that point is at the beginning o Line 8571  Assumes that point is at the beginning o
8571    (forward-sexp 2)    (forward-sexp 2)
8572    (forward-sexp -1)    (forward-sexp -1)
8573    (let ((begin (point)))    (let ((begin (point)))
8574      (re-search-forward      (re-search-forward
8575       "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?")       "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?")
8576      (if (fboundp 'buffer-substring-no-properties)      (if (fboundp 'buffer-substring-no-properties)
8577          (buffer-substring-no-properties begin (point))          (buffer-substring-no-properties begin (point))
# Line 8580  Assumes that point is at the beginning o Line 8611  Assumes that point is at the beginning o
8611    (start-process "idldeclient" nil    (start-process "idldeclient" nil
8612                   idlwave-shell-explicit-file-name "-c" "-e"                   idlwave-shell-explicit-file-name "-c" "-e"
8613                   (buffer-file-name) "&"))                   (buffer-file-name) "&"))
8614                    
8615  (defun idlwave-launch-idlhelp ()  (defun idlwave-launch-idlhelp ()
8616    "Start the IDLhelp application."    "Start the IDLhelp application."
8617    (interactive)    (interactive)
8618    (start-process "idlhelp" nil idlwave-help-application))    (start-process "idlhelp" nil idlwave-help-application))
8619    
8620  ;; Menus - using easymenu.el  ;; Menus - using easymenu.el
8621  (defvar idlwave-mode-menu-def  (defvar idlwave-mode-menu-def
8622    `("IDLWAVE"    `("IDLWAVE"
# Line 8672  Assumes that point is at the beginning o Line 8703  Assumes that point is at the beginning o
8703      ("Customize"      ("Customize"
8704       ["Browse IDLWAVE Group" idlwave-customize t]       ["Browse IDLWAVE Group" idlwave-customize t]
8705       "--"       "--"
8706       ["Build Full Customize Menu" idlwave-create-customize-menu       ["Build Full Customize Menu" idlwave-create-customize-menu
8707        (fboundp 'customize-menu-create)])        (fboundp 'customize-menu-create)])
8708      ("Documentation"      ("Documentation"
8709       ["Describe Mode" describe-mode t]       ["Describe Mode" describe-mode t]
# Line 8689  Assumes that point is at the beginning o Line 8720  Assumes that point is at the beginning o
8720    '("Debug"    '("Debug"
8721      ["Start IDL shell" idlwave-shell t]      ["Start IDL shell" idlwave-shell t]
8722      ["Save and .RUN buffer" idlwave-shell-save-and-run      ["Save and .RUN buffer" idlwave-shell-save-and-run
8723       (and (boundp 'idlwave-shell-automatic-start)       (and (boundp 'idlwave-shell-automatic-start)
8724            idlwave-shell-automatic-start)]))            idlwave-shell-automatic-start)]))
8725    
8726  (if (or (featurep 'easymenu) (load "easymenu" t))  (if (or (featurep 'easymenu) (load "easymenu" t))
8727      (progn      (progn
8728        (easy-menu-define idlwave-mode-menu idlwave-mode-map        (easy-menu-define idlwave-mode-menu idlwave-mode-map
8729                          "IDL and WAVE CL editing menu"                          "IDL and WAVE CL editing menu"
8730                          idlwave-mode-menu-def)                          idlwave-mode-menu-def)
8731        (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map        (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
8732                          "IDL and WAVE CL editing menu"                          "IDL and WAVE CL editing menu"
8733                          idlwave-mode-debug-menu-def)))                          idlwave-mode-debug-menu-def)))
8734    
8735  (defun idlwave-customize ()  (defun idlwave-customize ()
8736    "Call the customize function with idlwave as argument."    "Call the customize function with idlwave as argument."
8737    (interactive)    (interactive)
8738    ;; 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
8739    ;; as well.    ;; as well.
8740    (or (featurep 'idlw-shell)    (or (featurep 'idlw-shell)
8741        (load "idlw-shell" t))        (load "idlw-shell" t))
# Line 8715  Assumes that point is at the beginning o Line 8746  Assumes that point is at the beginning o
8746    (interactive)    (interactive)
8747    (if (fboundp 'customize-menu-create)    (if (fboundp 'customize-menu-create)
8748        (progn        (progn
8749          ;; 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
8750          ;; as well.          ;; as well.
8751          (or (featurep 'idlw-shell)          (or (featurep 'idlw-shell)
8752              (load "idlw-shell" t))              (load "idlw-shell" t))
8753          (easy-menu-change          (easy-menu-change
8754           '("IDLWAVE") "Customize"           '("IDLWAVE") "Customize"
8755           `(["Browse IDLWAVE group" idlwave-customize t]           `(["Browse IDLWAVE group" idlwave-customize t]
8756             "--"             "--"
# Line 8767  This function was written since `list-ab Line 8798  This function was written since `list-ab
8798    (let ((table (symbol-value 'idlwave-mode-abbrev-table))    (let ((table (symbol-value 'idlwave-mode-abbrev-table))
8799          abbrevs          abbrevs
8800          str rpl func fmt (len-str 0) (len-rpl 0))          str rpl func fmt (len-str 0) (len-rpl 0))
8801      (mapatoms      (mapatoms
8802       (lambda (sym)       (lambda (sym)
8803         (if (symbol-value sym)         (if (symbol-value sym)
8804             (progn             (progn
# Line 8793  This function was written since `list-ab Line 8824  This function was written since `list-ab
8824      (with-output-to-temp-buffer "*Help*"      (with-output-to-temp-buffer "*Help*"
8825        (if arg        (if arg
8826            (progn            (progn
8827              (princ "Abbreviations and Actions in IDLWAVE-Mode\n")              (princ "Abbreviations and Actions in IDLWAVE-Mode\n")
8828              (princ "=========================================\n\n")              (princ "=========================================\n\n")
8829              (princ (format fmt "KEY" "REPLACE" "HOOK"))              (princ (format fmt "KEY" "REPLACE" "HOOK"))
8830              (princ (format fmt "---" "-------" "----")))              (princ (format fmt "---" "-------" "----")))

Legend:
Removed from v.3.43  
changed lines
  Added in v.3.44

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