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. |
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 |
;; |
;; |
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 |
;; |
;; |
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 |
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 |
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)) |
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") |
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 |
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. |
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. |
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 |
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 |
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 |
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 |
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. |
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." |
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]' |
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. |
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" |
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 |
))) |
))) |
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)))) |
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]*;" |
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.") |
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 |
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 |
|
|
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." |
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) |
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) |
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) |
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) |
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 |
|
|
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)) |
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 |
|
|
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 |
;; |
;; |
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 |
|
|
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 |
|
|
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) |
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) |
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. |
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 |
|
|
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." |
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)) |
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)) |
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) |
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) |
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 |
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."))) |
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.")))) |
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 |
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))))) |
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))) |
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))) |
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: |
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... |
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)) |
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 |
|
|
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) |
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) |
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 |
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. |
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)) |
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 |
|
|
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 |
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) |
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 |
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 |
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) |
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 |
|
|
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) |
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 |
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 |
|
|
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 `+' |
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) |
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) |
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 |
|
|
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 |
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")) |
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")) |
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")) |
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")) |
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")) |
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) |
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 |
|
|
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))) |
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)))) |
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: " ".")) |
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 |
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)) |
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)))) |
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)) |
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) |
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))) |
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)) |
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 |
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) |
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]) |
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) |
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 |
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 |
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") |
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)) |
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) |
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)) |
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))) |
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 |
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 |
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) |
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 () |
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 |
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 |
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)) |
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 |
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)) |
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" |
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 |
|
|
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 |
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))))) |
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: |
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") |
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) |
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) |
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))) |
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)) |
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)) |
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))) |
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)) |
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 |
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))) |
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) |
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))) |
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) |
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] |
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 = ' |
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 |
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 |
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 |
|
|
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)))) |
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 |
|
|
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) |
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 |
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) |
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 |
"")) |
"")) |
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))) |
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")) |
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))) |
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))))) |
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 |
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 |
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) |
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) |
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 |
|
|
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 |
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 |
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 |
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) |
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 |
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)) |
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)) |
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). |
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)) |
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)) |
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 '(?\( ?,))) |
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) |
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) |
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)) |
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 |
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))) |
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) |
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 |
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) |
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))))) |
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 |
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 |
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))))) |
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 |
;;---------------------------------------------------------------------- |
;;---------------------------------------------------------------------- |
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) |
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 |
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 |
|
|
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) |
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) |
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]*" |
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 () |
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 |
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 |
"")))) |
"")))) |
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 |
|
|
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 |
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)))))) |
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))))) |
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 |
|
|
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)) |
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)))) |
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" |
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") |
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))) |
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!!! |
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) |
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)) |
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 |
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 |
|
|
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))))))) |
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))) |
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)))) |
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 |
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))) |
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 |
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 |
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) |
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)))))) |
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)) |
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) |
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 |
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)) |
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 |
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 |
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 |
|
|
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. |
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) |
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)) |
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 |
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)) |
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 ") |
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)) |
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 |
"") |
"") |
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))) |
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))))))))) |
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 ") |
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 |
|
|
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))) |
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)) |
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) |
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)) |
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 "/")) |
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 |
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) |
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)))) |
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)))) |
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 |
|
|
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) |
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) |
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 |
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))))) |
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 |
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 |
|
|
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)) |
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" |
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] |
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)) |
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 |
"--" |
"--" |
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 |
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 "---" "-------" "----"))) |